#lang plait
(define-type FLANG
  [Num  (val : Number)]
  [Add  (l : FLANG) (r : FLANG)]
  [Sub  (l : FLANG) (r : FLANG)]
  [Mul  (l : FLANG) (r : FLANG)]
  [Div  (l : FLANG) (r : FLANG)]
  [Id   (name : Symbol)]
  [Let1 (id : Symbol) (named-expr : FLANG) (bound-body : FLANG)]
  [Lam  (param : Symbol) (body : FLANG)]
  [Call (fun : FLANG) (val : FLANG)]) ; first type!
(define-type ENV
  [EmptyEnv]
  [Extend (name : Symbol) (val : VAL) (rest : ENV)])

(define-type VAL
  [NumV (n : Number)]
  [FunV (arg : Symbol) (body : FLANG) (env : ENV)])
(module+ test
  (test/exn (lookup 'x (EmptyEnv)) "no binding")
  (test/exn (lookup 'y (Extend 'x (NumV 1) (EmptyEnv))) "no binding")
  (test (lookup 'y (Extend 'y (NumV 1) (EmptyEnv))) (NumV 1)))
;; gets a Racket numeric binary operator, 
;; uses it within a NumV wrapper
(define (arith-op op val1 val2)
  (local 
      [(define (NumV->number v)
         (type-case VAL v
           [(NumV n) n]
           [else (error 'arith-op 
                        (string-append "expects a number, got: " (to-string v)))]))]
    (NumV (op (NumV->number val1) 
	    (NumV->number val2)))))

(define (lookup name env)
  (type-case ENV env
    [(EmptyEnv) (error 'lookup (string-append "no binding for " (to-string name)))]
    [(Extend id val rest-env)
     (if (eq? id name) 
	 val 
	 (lookup name rest-env))]))
(module+ test
  (test (interp (Let1 'x (Num 1) (Lam 'y (Id 'x))) (EmptyEnv)) (FunV 'y (Id 'x) (Extend 'x (NumV 1) (EmptyEnv)))))

;; evaluates FLANGs by reducing them to VALs
  (define (interp expr env)
    (type-case FLANG expr
[(Num n) (NumV n)]
[(Add l r) (arith-op + (interp l env) (interp r env))]
[(Sub l r) (arith-op - (interp l env) (interp r env))]
[(Mul l r) (arith-op * (interp l env) (interp r env))]
[(Div l r) (arith-op / (interp l env) (interp r env))]
[(Let1 bound-id named-expr bound-body)
 (interp bound-body
       (Extend bound-id (interp named-expr env) env))]
[(Id name) (lookup name env)] ; ⋮
      [(Lam bound-id bound-body)
       (FunV bound-id bound-body env)]
      [(Call fun-expr arg-expr)
       (let ([fval (interp fun-expr env)])
         (type-case VAL fval
           [(FunV bound-id bound-body f-env)
            (interp
             bound-body
             (Extend
              bound-id
              (interp arg-expr env) f-env))]
           [else
            (error 'eval "not a function")]))]))