UNB/ CS/ David Bremner/ teaching/ cs4613/ practices/ practice01/ dyn-exp.rkt
#lang plait
(define-type Exp
  [numE (n : Number)]
  [plusE (left : Exp) (right : Exp)]
  [timesE (left : Exp) (right : Exp)]
  [lamE (var : Symbol) (body : Exp)]
  [appE (fun : Exp) (arg : Exp)]
  [varE (name : Symbol)]
  [let1E (var : Symbol)
         (value : Exp)
         (body : Exp)])

(define-type Value
  [numV (the-number : Number)]
  [boolV (the-boolean : Boolean)]
  [funV (var : Symbol) (body : Exp)])

(define (num-op op expr1 expr2)
  (local [(define (unwrap v)
            (type-case Value v
              [(numV n) n]
              [else (error 'num-op "NaN")]))]
    (numV (op (unwrap expr1)
              (unwrap expr2)))))

(define-type-alias Env (Hashof Symbol Value))
(define mt-env (hash empty)) ;; "empty environment"
(define (extend old-env new-name value)
  (hash-set old-env new-name value))

(define (lookup (s : Symbol) (n : Env))
  (type-case (Optionof Value) (hash-ref n s)
    [(none) (error s "not bound")]
    [(some v) v]))

(interp : (Exp Env -> Value))
(define (interp e nv)
  (type-case Exp e
    [(numE n) (numV n)]
    [(varE s) (lookup s nv)]
    [(plusE l r) (num-op + (interp l nv) (interp r nv))]
    [(timesE l r) (num-op * (interp l nv) (interp r nv))]
    [(lamE v b) (funV v b)]
    [(appE f a)
     (let ([fv (interp f nv)]
           [av (interp a nv)])
       (type-case Value fv
         [(funV v b)
          (interp b (extend nv v av))]
         [else (error 'app "not a function")]))]
    [(let1E var val body)
     (let ([new-env (extend nv
                            var
                            (interp val nv))])
       (interp body new-env))]))

(trace interp)
(interp 
 (let1E 'x (numE 1)
        (let1E
         'f (let1E 'x (numE 2) (lamE 'y (plusE (varE 'x) (varE 'y))))
         (let1E 'x (numE 3) (appE (varE 'f) (numE 4))))) mt-env)