#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)