; LC interpreter that uses lists of pairs to represent environments and ; structs to represent closures ; AST ::= Var | Const | Proc | App | Add ; Var ::= (make-var symbol) ; Const ::= (make-const integer) ; Proc ::= (make-proc Var AST) ; App ::= (make-app AST AST) ; Add ::= (make-add AST AST) ; Val ::= Const | Closure ; Closure ::= (make-closure Proc Env) ; Env ::= (list-of Pair) ; Pair ::= (make-pair symbol Val) (require-library "core.ss") (define-struct var (name)) (define-struct const (number)) (define-struct proc (param body)) (define-struct app (rator rand)) (define-struct add (left right)) (define-struct pair (name val)) (define-struct closure (body env)) ;; AST Env -> Val ; (Eval M env) evaluates M in the environment env (define Eval (lambda (M env) (cond ((var? M) (lookup (var-name M) env)) ((const? M) M) ((proc? M) (make-closure M env)) ((add? M) (add (Eval (add-left M) env) (Eval (add-right M) env))) (else (Apply (Eval (app-rator M) env) (Eval (app-rand M) env)))))) ;; Closure Val -> Val ;; (Apply c v) applies the closure c to the value v (define Apply (lambda (fn arg) (Eval (proc-body (closure-body fn)) (extend (closure-env fn) (proc-param (closure-body fn)) arg)))) ;; Const Const -> Const ;; (add c1 c2) adds c1 and c2 (define (add c1 c2) (make-const (+ (const-number c1) (const-number c2)))) ;; symbol Env -> Val ;; (lookup name env) finds the value associated with symbol name in Env (define lookup (lambda (name env) ; env is a list of name,value pairs (if (null? env) (error "variable ~a is unbound" name) (if (eq? name (pair-name (first env))) (pair-val (first env)) (lookup name (rest env)))))) ;; Env symbol Val -> Env ;; (extend env sym val) adds the binding (sym := val) to the environment env (define (extend env name val) (cons (make-pair name val) env)) ; Empty-Env is the empty Env (define Empty-Env null) ;; twice-proc = map f to map x to f(f(x)) (define twice-proc (make-proc 'f (make-proc 'x (make-app (make-var 'f) (make-app (make-var 'f) (make-var 'x)))))) ;; double-proc = map x to x+x (define double-proc (make-proc 'x (make-add (make-var 'x) (make-var 'x)))) ;; p1 = (twice-proc double-proc) 4 (define p1 (make-app (make-app twice-proc double-proc) (make-const 4))) ;; p2 = (map f to ((twice-proc (map x to x + f)) 5) 10) (define p2 (make-app (make-proc 'f (make-app (make-app twice-proc (make-proc 'x (make-add (make-var 'x) (make-var 'f)))) (make-const 5))) (make-const 10))) ;; ugly = (map two to (map two to two(10))(map x to two))(2) (define ugly (make-app (make-proc 'two (make-app (make-proc 'two (make-app (make-var 'two) (make-const 10))) (make-proc 'x (make-var 'two)))) (make-const 2))) ;; double = (map x to x+x)(10) (define double (make-app double-proc (make-const 10)))