120 lines
3.7 KiB
Racket
120 lines
3.7 KiB
Racket
#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)]
|
|
; Wordy double extend, as first setting up the f-env with the value it is dynamically scoped with.
|
|
; Then, extending that environment with the function that is being used on the value.
|
|
[(callWith with-id with-expr 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 (extend f-env with-id (interp with-expr env)) bound-id (interp arg-expr env)))]
|
|
[else (error 'interp "non-function")]))]
|
|
[(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"))
|