#lang plait
(define-type Exp
[numE (val : Number)]
[plusE (l : Exp) (r : Exp)]
[varE (name : Symbol)]
[let1E (id : Symbol) (named-expr : Exp) (bound-body : Exp)]
[lamE (param : Symbol) (body : Exp)]
[callWith (id : Symbol) (bound-expr : Exp) (fun : Exp) (val : Exp)]
[appE (fun : Exp) (val : Exp)])
(define-type Value
[numV (n : Number)]
[lamV (arg : Symbol) (body : Exp) (env : Env)])
(define-type-alias Env (Hashof Symbol Value))
(define mt-env (hash empty)) ;; "empty environment"
(define (lookup (s : Symbol) (n : Env))
(type-case (Optionof Value) (hash-ref n s)
[(none) (error s "not bound")]
[(some v) v]))
(define (extend old-env new-name value)
(hash-set old-env new-name value))
(define (interp expr env)
(type-case Exp expr
[(numE n) (numV n)]
[(plusE l r)
(numV (+ (numV-n (interp l env)) (numV-n (interp r env))))]
[(let1E bound-id named-expr bound-body)
(interp bound-body (extend env bound-id (interp named-expr env)))]
[(varE name) (lookup name env)]
[(lamE bound-id bound-body) (lamV bound-id bound-body env)]
[(callWith with-id with-expr fun-expr arg-expr) ....]
[(appE fun-expr arg-expr)
(let ([fval (interp fun-expr env)])
(type-case Value fval
[(lamV bound-id bound-body f-env)
(interp bound-body
(extend f-env bound-id (interp arg-expr env)))]
[else (error 'interp
(string-append "`call' expects a function, got: "
(to-string fval)))]))]))
(module+ test
(print-only-errors #t)
(define (example body)
(let1E 'x (numE 3)
(let1E 'f (lamE 'y (plusE (varE 'x) (varE 'y)))
body)))
(test (interp (example (appE (varE 'f) (numE 4))) mt-env)
(numV 7))
(test (interp
(example (callWith 'x (numE 5) (varE 'f) (numE 4))) mt-env)
(numV 9))
(test (interp
(example
(let1E 'f (lamE 'x (varE 'x))
(callWith 'x (numE 5) (varE 'f) (numE 4))))
mt-env)
(numV 4))
(test (interp
(example
(let1E 'f (lamE 'y (varE 'x))
(callWith 'x (numE 5) (varE 'f) (numE 4))))
mt-env)
(numV 5))
(test
(interp (callWith 'y (numE 7) (lamE 'x (plusE (varE 'x) (varE 'y))) (numE 3))
mt-env)
(numV 10))
(test/exn
(interp (callWith 'x (numE 7) (lamE 'x (plusE (varE 'x) (varE 'y))) (numE 3))
mt-env)
"not bound")
(test
(interp
(callWith 'x (numE 7) (lamE 'x (plusE (varE 'x) (varE 'x))) (numE 3))
mt-env)
(numV 6))
(test
(interp
(let1E 'z (numE 7)
(callWith 'y (varE 'z) (lamE 'x (plusE (varE 'x) (varE 'y))) (numE 3)))
mt-env)
(numV 10))
(test
(interp
(let1E 'f (lamE 'x (plusE (varE 'x) (varE 'y)))
(callWith 'y (numE 7) (varE 'f) (numE 3)))
mt-env)
(numV 10))
(test
(interp
(let1E 'f (lamE 'x (plusE (varE 'x) (varE 'y)))
(let1E 'z (numE 7) (callWith 'y (varE 'z) (varE 'f) (numE 3))))
mt-env)
(numV 10))
(test/exn (interp (appE (varE 'g) (numE 4)) mt-env) "not bound")
(test/exn (interp (example (appE (numE 4) (varE 'f))) mt-env) "function")
(test/exn (interp (example (callWith 'x (numE 5) (numE 4) (varE 'f))) mt-env) "function"))