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