(module interp (lib "eopl.ss" "eopl") (require "drscheme-init.scm") (require "lang.scm") (require "data-structures.scm") (require "environments.scm") (provide value-of-program value-of) ;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;; ;; value-of-program : program -> expval (define value-of-program (lambda (pgm) (cases program pgm (a-program (body) (value-of body (init-env)))))) ;; value-of : expression * environment -> expval (define value-of (lambda (exp env) (cases expression exp (lit-exp (num) (num-val num)) (var-exp (id) (apply-env env id)) (diff-exp (exp1 exp2) (let ((val1 (expval->num (value-of exp1 env))) (val2 (expval->num (value-of exp2 env)))) (num-val (- val1 val2)))) (zero?-exp (exp1) (let ((val1 (expval->num (value-of exp1 env)))) (if (zero? val1) (bool-val #t) (bool-val #f)))) (if-exp (exp0 exp1 exp2) (if (expval->bool (value-of exp0 env)) (value-of exp1 env) (value-of exp2 env))) (let-exp (id rhs body) (let ((val (value-of rhs env))) (value-of body (extend-env id val env)))) (proc-exp (bvar body) (proc-val (procedure bvar body env))) (app-exp (rator rand) (let ((proc (expval->proc (value-of rator env))) (arg (value-of rand env))) (apply-procedure proc arg))) (letrec-exp (proc-name bvar proc-body letrec-body) (value-of letrec-body (extend-env-recursively proc-name bvar proc-body env))) ))) ;; apply-procedure : procedure * expval -> expval (define apply-procedure (lambda (proc1 arg) (cases proc proc1 (procedure (bvar body saved-env) (value-of body (extend-env bvar arg saved-env)))))) )