(define-datatype parsed-expression? (application (rator parsed-expression?) (rands (list-of-type parsed-expression?))) (variable (sym symbol?)) (symbolic-data value) (function (formals (list-of-type symbol?)) (body parsed-expression?)) (begin (exprs (list-of-type parsed-expression?))) (if (test parsed-expression?) (true parsed-expression?) (false parsed-expression?)) (define (sym symbol?) (value parsed-expression?)) (letrec (vars (list-of-type symbol?)) (vals (list-of-type parsed-expression?)) (body parsed-expression?)) (set (sym symbol?) (value parsed-expression?))) (define (parsed-expression->datum exp) (cases exp (application (rator rands) (cons (parsed-expression->datum rator) (map parsed-expression->datum rands))) (variable (sym) sym) (symbolic-data (value) `(quote ,value)) (function (formals body) `(lambda ,formals ,(parsed-expression->datum body))) (begin (exprs) `(begin ,@(map parsed-expression->datum exprs))) (if (test true false) `(if ,(parsed-expression->datum test) ,(parsed-expression->datum true) ,(parsed-expression->datum false))) (define (sym value) `(define ,sym ,value)) (letrec (vars vals body) `(letrec ,(map list vars (map parsed-expression->datum vals)) ,(parsed-expression->datum body))) (set (sym value) `(set! ,sym ,(parsed-expression->datum value))))) (define parsed-exp-eval (let () (define (search-env sym env local-k global-k) (cond ((assq sym env) => local-k) (else (global-k)))) (define (extend-env/definitions v vars valexps env) (let* ((newenv (append (map (lambda (var) (cons var 'undefined-in-letrec)) vars) env)) (vals (map (lambda (exp) (v exp newenv)) valexps))) (do ((newenv newenv (cdr newenv)) (vals vals (cdr vals))) ((null? vals)) (set-cdr! (car newenv) (car vals))) newenv)) (lambda (exp) (let v ((exp exp) (env '())) (cases exp (application (rator rands) (apply (v rator env) (map (lambda (x) (v x env)) rands))) (variable (sym) (search-env sym env cdr (lambda () (eval sym)))) (symbolic-data (value) value) (function (formals body) (lambda actuals (v body (fold alist-cons env formals actuals)))) (begin (exprs) (let inner ((exprs exprs)) (cond ((null? exprs)) ((null? (cdr exprs)) (v (car exprs) env)) (else (v (car exprs) env) (inner (cdr exprs)))))) (if (test true false) (if (v test env) (v true env) (v false env))) (define (sym value) (error "Define in illegal position" sym (parsed-expression->datum value))) (letrec (vars vals body) (v body (extend-env/definitions v vars vals env))) (set (sym value) (search-env sym env (lambda (cell) (set-cdr! cell (v value env))) (lambda () (error "May not set global in parsed-exp-eval" sym (parsed-expression->datum value))))))))))