#lang plait
(define-type Exp
  [numE (n : Number)]
  [plusE (lhs : Exp) (rhs : Exp)]
  [minusE (lhs : Exp) (rhs : Exp)]
  [varE (name : Symbol)]
  [lamE (param : Symbol) (body : Exp)]
  [appE (fun-expr : Exp) (arg-expr : Exp)]
  [errorE (msg : String)] ;; New
  [if0E (test : Exp) (then : Exp) (else : Exp)])
(define-type Value
  [numV (n : Number)]
  [errorV (msg : String)]
  [funV (param : Symbol)
            (body : Exp)
            (env : Env)])
(define-type Env
  [emptyEnv]
  [Extend (name : Symbol)
        (value : Value)
        (rest : Env)])
(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))]))
(define (parse-error sx)
  (error 'parse (string-append "parse error: " (to-string sx))))

(define (sx-ref sx n) (list-ref (s-exp->list sx) n))
(define (parse sx)
  (local
      [(define (px i) (parse (sx-ref sx i)))]
    (cond
      [(s-exp-number? sx) (numE (s-exp->number sx))]
      [(s-exp-symbol? sx) (varE (s-exp->symbol sx))]
      [(s-exp-match? `(let1 SYMBOL ANY ANY) sx)
       (let* ([id (s-exp->symbol (sx-ref sx 1))]
              [named (px 2)]
              [body (px 3)])
         (appE (lamE id body) named))]
      [(s-exp-match? `(lam (SYMBOL) ANY) sx)
       (let* ([args (sx-ref sx 1)]
              [varE (s-exp->symbol (sx-ref args 0))]
              [body (px 2)])
         (lamE varE body))]
      [(s-exp-match? `(error STRING) sx) (errorE (s-exp->string (sx-ref sx 1)))]
      [(s-exp-match? `(error ANY) sx) (parse-error sx)]
      [(s-exp-match? `(ANY ANY) sx)
       (appE (px 0) (px 1))]
      [(s-exp-list? sx)
       (case (s-exp->symbol (sx-ref sx 0))
         [(+) (plusE (px 1) (px 2))]
         [(-) (minusE (px 1) (px 2))]
         [(if0) (if0E (px 1) (px 2) (px 3))]
         [else (parse-error sx)])]
      [else (parse-error sx)])))

(define (run sx) (interp (parse sx) (emptyEnv)))
(module+ test
  (test (interp (numE 10)
                (emptyEnv))
        (numV 10))
  (test (interp (plusE (numE 10) (numE 7))
                (emptyEnv))
        (numV 17))
  (test (interp (minusE (numE 10) (numE 7))
                (emptyEnv))
        (numV 3))
  (test (interp (appE (lamE 'x (plusE (varE 'x) (numE 12)))
                      (plusE (numE 1) (numE 17)))
                (emptyEnv))
        (numV 30))
  (test (interp (varE 'x)
                (Extend 'x (numV 10) (emptyEnv)))
        (numV 10))

  (test (interp (appE (lamE 'x (plusE (varE 'x) (numE 12)))
                      (plusE (numE 1) (numE 17)))
                (emptyEnv))
        (numV 30))

  (test/exn (interp (varE 'x) (emptyEnv))
            "no binding"))

(module+ test
  (test/exn
   (run `{{lam {x} {+ x y}} 0})
   "no binding")

  (test
   (run
    `{{lam {x}
           {{lam {f} {f 2}}
            {lam {y} {+ x y}}}}
      0})
   (numV 2))


  (test (run `{{lam {x}
                    {{lam {f}
                          {+ {f 1}
                             {{lam {x} {f 2}} 3}}}
                     {lam {y} {+ x y}}}}
               0})
        (numV 3))


  (test (run `{let1 x 1 x}) (numV 1))
  (test (run
         `{let1 mkrec
                {lam {body-proc}
                     {{lam {fX} {fX fX}}
                      {lam {fX} {body-proc
                                 {lam {x} {{fX fX} x}}}}}}
                {let1 fib
                       {mkrec
                        {lam {fib}
                             {lam {n}
                                  {if0 n 1
                                       {if0 {- n 1} 1
                                            {+ {fib {- n 1}}
                                               {fib {- n 2}}}}}}}}
                      {fib 4}}})
        (numV 5))
  )
(define (numzero? x)
   (zero? (numV-n x)))
(define (arith-op op val1 val2)
  (local
      [(define (numV->number v)
         (type-case Value 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 (interp expr env)
  (type-case Exp expr
  [(numE n) (numV n)]
  [(plusE l r) (arith-op + (interp l env) (interp r env))]
  [(minusE l r) (arith-op - (interp l env) (interp r env))]
  [(varE name) (lookup name env)]
  [(if0E test-expr then-expr else-expr)
   (if (numzero? (interp test-expr env))
       (interp then-expr env)
       (interp else-expr env))] ; @$\vdots$@
    [(errorE msg) (errorV msg)]
    [(lamE bound-id bound-body)
     (funV bound-id bound-body env)]
    [(appE fun-expr arg-expr)
     (let ([fval (interp fun-expr env)])
       (type-case Value 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")]))]))

(test (run `{let1 f {lam {x} {+ x 1}} 
                    {+ {f 2} {error "abort!"}}})
      (errorV "abort!"))