(load "syntax.scm")
(load "meval.scm")
(define *meval-warn-define* #t)
(load "environment.scm")
(load "assert.scm")
(define (m-eval exp env)
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
((quoted? exp) (text-of-quotation exp))
((assignment? exp) (eval-assignment exp env))
((definition? exp) (eval-definition exp env))
((if? exp) (eval-if exp env))
((lambda? exp)
(make-procedure (lambda-parameters exp) (lambda-body exp) env))
((begin? exp) (eval-sequence (begin-actions exp) env))
((cond? exp) (m-eval (cond->if exp) env))
((let? exp) (m-eval (let->application exp) env))
((times-called? exp)
(eval-times-called exp env))
((application? exp)
(m-apply (m-eval (operator exp) env)
(list-of-values (operands exp) env)))
(else (error "Unknown expression type -- EVAL" exp))))
(define (times-called? exp)
(tagged-list? exp 'times-called))
(define times-called-proc-name second)
(define (eval-times-called exp env)
(procedure-call-count
(lookup-variable-value
(times-called-proc-name exp)
env)))
(define (make-procedure parameters body env)
(list 'procedure parameters body env 0))
(define (compound-procedure? exp)
(tagged-list? exp 'procedure))
(define (procedure-parameters p) (second p))
(define (procedure-body p) (third p))
(define (procedure-environment p) (fourth p))
(define (procedure-call-count p) (fifth p))
(define (procedure-call-count-inc! p)
(set-car! (cddddr p) (inc (car (cddddr p)))))
(define (m-apply procedure arguments)
(cond ((primitive-procedure? procedure)
(apply-primitive-procedure procedure arguments))
((compound-procedure? procedure)
(let ((return-value
(eval-sequence
(procedure-body procedure)
(extend-environment (procedure-parameters procedure)
arguments
(procedure-environment procedure)))))
(procedure-call-count-inc! procedure)
return-value))
(else (error "Unknown procedure type -- APPLY" procedure))))
(refresh-global-environment)
(m-eval '(define map (lambda (f l)
(if (null? l)
#f
(cons (f (car l)) (map f (cdr l))))))
the-global-environment)
(m-eval '(define (dbl x) (+ x x)) the-global-environment)
(assert= (m-eval '(times-called dbl) the-global-environment) 0)
(assert= (m-eval '(dbl (dbl 4)) the-global-environment) 16)
(assert= (m-eval '(times-called dbl) the-global-environment) 2)
(assert-equal (m-eval '(map dbl '(1 2 3 4)) the-global-environment) '(2 4 6 8))
(assert= (m-eval '(times-called dbl) the-global-environment) 6)