#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 (parse-error sx)
  (error 'parse-sx (string-append "parse error: " (to-string sx))))

(define (sx-ref sx n) (list-ref (s-exp->list sx) n))

(define (parse-sx sx)
  (cond
    [(s-exp-number? sx) (Num (s-exp->number sx))]
    [(s-exp-symbol? sx) (Id (s-exp->symbol sx))]
    [(s-exp-match? `(let1 (SYMBOL ANY) ANY) sx)
     (let* ([def (sx-ref sx 1)]
            [id (s-exp->symbol (sx-ref def 0))]
            [val (parse-sx (sx-ref def 1))]
            [expr (parse-sx (sx-ref sx 2))])
       (Let1 id val expr))]
    [(s-exp-match? `(lam SYMBOL ANY) sx)
     (let* ([id (s-exp->symbol (sx-ref sx 1))]
            [body (parse-sx (sx-ref sx 2))])
       (Lam id body))]
    [(s-exp-match? `(ANY ANY) sx)
     (Call (parse-sx (sx-ref sx 0))
           (parse-sx (sx-ref sx 1)))]
    [(s-exp-list? sx)
     (let* ([l (λ () (parse-sx (sx-ref sx 1)))]
            [r (λ () (parse-sx (sx-ref sx 2)))])
       (case (s-exp->symbol (sx-ref sx 0))
         [(+) (Add (l) (r))]
         [(-) (Sub (l) (r))]
         [(*) (Mul (l) (r))]
         [(/) (Div (l) (r))]
         [else (parse-error sx)]))]
    [else (parse-error sx)]))

(define-type ENV
  [EmptyEnv]
  [Extend (name : Symbol) (val : VAL) (rest : ENV)])

(define-type VAL
  [NumV (n : Number)]
  [FunV (arg : Symbol) (body : FLANG) (env : 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))]))
;; 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)))))

;; evaluates FLANG expressions by reducing them to values
(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
                      (string-append "`call' expects a function, got: "
                            (to-string fval)))]))]))

;; evaluate a FLANG program contained in an s-expression
(define (run s-exp)
  (let ([result (interp (parse-sx s-exp) (EmptyEnv))])
    (type-case VAL result
      [(NumV n) n]
      [else (error 'run "non-number")])))