; LC interpreter that uses lists of pair to represent environments and ; structs to represent closures ; AR ::= (make-var symbol) | (make-const integer) | (make-proc var AR) | ; (make-app (AR AR) (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)) (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)))))) (define Apply (lambda (fn arg) ; fn is a closure, arg is value (const or proc) (Eval (proc-body (closure-body fn)) (extend (closure-env fn) (var-name (proc-param (closure-body fn))) arg)))) (define (add c1 c2) ; c1,c2: const (make-const (+ (const-number c1) (const-number c2)))) (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)))))) (define (extend env name val) (cons (make-pair name val) env)) (define Empty-Env null) ;; twice-proc = map f to map x to f(f(x)) (define twice-proc (make-proc (make-var 'f) (make-proc (make-var '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 (make-var '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 (make-var 'f) (make-app (make-app twice-proc (make-proc (make-var '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 (make-var 'two) (make-app (make-proc (make-var 'two) (make-app (make-var 'two) (make-const 10))) (make-proc (make-var 'x) (make-var 'two)))) (make-const 2)))