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

(define-type VAL
  [NumV (n : Number)]
  [LamV (arg : Symbol) (body : IFLANG) (env : ENV)]
  [ILamV (arg : Symbol) (zero-body : IFLANG)  (non-zero-body : IFLANG) (env : ENV)])

(define (lookup name env)
  (type-case ENV env
    [(EmptyEnv) (error 'lookup "missing binding")]
    [(Extend id val rest-env)
     (if (eq? id name)
         val
         (lookup name rest-env))]))

(define (arith-op op val1 val2) (NumV (op (NumV-n val1) (NumV-n val2))))
;; evaluates IFLANG expressions by reducing them to values
(define (interp expr env)
  (type-case IFLANG expr
    [(Num n) (NumV n)]
    [(Add 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)]
    [(ILam bound-id zero-body non-zero-body) ....]
    [(Lam bound-id bound-body)
     (LamV bound-id bound-body env)]
    [(Call lam-expr arg-expr)
     (let ([fval (interp lam-expr env)])
       (type-case VAL fval
         [(LamV bound-id bound-body f-env)
          (interp bound-body
                (Extend bound-id (interp arg-expr env) f-env))]
         [else (error 'eval "expects function")]))]))
(define (run iflang)  (NumV-n (interp iflang (EmptyEnv))))

(print-only-errors #t)

(test (run
       (Let1 'x (Num 3)
        (Let1 'f (ILam 'y (Num -1) (Add (Id 'x) (Id 'y)))
         (Let1 'x (Num 5) (Call (Id 'f) (Num 4))))))
      7)

(test (run
       (Call (Let1 'x (Num 3) (ILam 'y (Num -1) (Add (Id 'x) (Id 'y)))) (Num 4)))
      7)

(test (run 
       (Call
        (Call
         (Lam 'x (Call (Id 'x) (Num 1)))
         (Lam 'x (ILam 'y (Num -1) (Add (Id 'x) (Id 'y)))))
        (Num 123)))
       124)

(test (run
       (Let1 'f (ILam 'x (Id 'x) (Div (Num 1) (Id 'x)))
        (Add (Call (Id 'f) (Num 3)) (Call (Id 'f) (Num 0)))))
      1/3)

(test (run
       (Let1 'x (Num 3)
        (Let1 'f  (ILam 'y (Id 'x) (Div (Id 'x) (Id 'y)))
         (Let1 'x (Num 5) (Add (Call (Id 'f) (Num 3)) (Call (Id 'f) (Num 0)))))))
      4)