3 (require "ex4_8.rkt" ;; for let and named let
6 ;; metacircular evaluator
8 (cond ((self-evaluating? exp) exp)
9 ((variable? exp) (lookup-variable-value exp env))
10 ((quoted? exp) (text-of-quotation exp))
11 ((assignment? exp) (eval-assignment exp env))
12 ((definition? exp) (eval-definition exp env))
13 ((if? exp) (eval-if exp env))
15 (make-procedure (lambda-parameters exp)
18 ((begin? exp) (eval-sequence (begin-actions exp) env))
19 ((cond? exp) (eval (cond->if exp) env))
20 ((let? exp) (eval (let->combination exp) env)) ;; from ex4.8
21 ((let*? exp) (eval (let*->nested-lets exp) env)) ;; from ex4_7
23 (apply (eval (operator exp) env)
24 (list-of-values (operands exp) env)))
26 (error "unknown expression type -- EVAL" exp))))
28 (define (apply procedure arguments)
29 (cond ((primitive-procedure? procedure)
30 (apply-primitive-procedure procedure arguments))
31 ((compound-procedure? procedure)
33 (procedure-body procedure)
35 (procedure-parameters procedure)
37 (procedure-environment procedure))))
39 (error "unknown procedure type -- APPLY" procedure))))
41 (define (list-of-values exps env)
42 (if (no-operands? exps)
44 (cons (eval (first-operand exps) env)
45 (list-of-values (rest-operands exps) env))))
47 (define (eval-if exp env)
48 (if (true? (eval (if-predicate exp) env))
49 (eval (if-consequent exp) env)
50 (eval (if-alternative exp) env)))
52 (define (eval-sequence exps env)
53 (cond ((last-exp? exps)
54 (eval (first-exp exps) env))
56 (eval (first-exp exps) env)
57 (eval-sequence (rest-exps exps) env))))
59 (define (eval-assignment exp env)
60 (set-variable-value! (assignment-variable exp)
61 (eval (assignment-value exp) env)
65 (define (eval-definition exp env)
66 (define-variable! (definition-variable exp)
67 (eval (definition-value exp) env)
72 (define (self-evaluating? expr)
73 (cond [(number? expr) #t]
77 (define (variable? expr)
81 (define (quoted? expr)
82 (tagged-list? expr 'quote))
84 (define (tagged-list? expr tag)
85 (or (pair? expr) (eq? (car expr) tag)))
87 (define (text-of-quotation expr)
91 (define (assignment? expr)
92 (tagged-list? expr 'set!))
94 (define (assignment-variable expr)
97 (define (assignment-value expr)
98 (car (cdr (cdr expr))))
101 (define (definition? expr)
102 (tagged-list? expr 'define))
104 (define (definition-variable expr)
105 (if (symbol? (car (cdr expr))) ;; (define foo 42)
107 ;; (define (foo x) (....))
108 (car (car (cdr expr)))))
110 (define (definition-value expr)
112 (if (symbol? (car (cdr expr)))
113 (car (cdr (cdr expr)))
114 ;; (define (foo x) (....))
115 (make-lambda (cdr (car (cdr expr))) ;; gives (x)
116 (cdr (cdr expr))))) ;; body
119 (define (lambda? expr)
120 (tagged-list? expr 'lambda))
122 (define (lambda-parameters expr)
125 ;;(lambda (x) (..)(..)...(..))
126 (define (lambda-body expr)
129 (define (make-lambda params body)
130 (cons 'lambda (cons params body)))
133 (define (if? exp) (tagged-list? exp 'if))
134 (define (if-predicate expr) (car (cdr expr)))
135 (define (if-consequent expr) (car (cdr (cdr expr))))
136 (define (if-alternative expr)
137 (if (not (null? (cdr (cdr (cdr expr)))))
138 (car (cdr (cdr (cdr expr))))
141 (define (make-if predicate consequent alternative)
142 (list 'if predicate consequent alternative))
145 (define (begin? exp) (tagged-list? exp 'begin))
146 (define (begin-actions exp) (cdr exp))
147 (define (last-exp? seq) (null? (cdr seq)))
148 (define (first-exp seq) (car seq))
149 (define (rest-exp seq) (cdr seq))
151 (define (sequence->exp seq)
152 (cond ((null? seq) seq)
153 ((last-exp? seq) (first-exp seq))
154 (else (make-begin seq))))
155 (define (make-begin seq) (cons 'begin seq))
157 ;; procedure application
158 (define (application? exp) (pair? exp))
159 (define (operator exp) (car exp))
160 (define (operands exp) (cdr exp))
161 (define (no-operands? ops) (null? ops))
162 (define (first-operand ops) (car ops))
163 (define (rest-operands ops) (cdr ops))
165 ;; expander for `cond' expressions to be transformed into `if' expressions
166 (define (cond? exp) (tagged-list? exp 'cond))
167 (define (cond-clauses exp) (cdr exp))
168 (define (cond-else-clause? clause)
169 (eq? (cond-predicate clause) 'else))
170 (define (cond-predicate clause) (car clause))
171 (define (cond-actions clause) (cdr clause))
172 (define (cond->if exp)
173 (expand-clauses (cond-clauses exp)))
175 (define (expand-clauses clauses)
177 'false ; no else clause
178 (let ((first (car clauses))
179 (rest (cdr clauses)))
180 (if (cond-else-clause? first)
182 (sequence->exp (cond-actions first))
183 (error "ELSE clause isn't last -- COND->IF"
185 (make-if (cond-predicate first)
186 (sequence->exp (cond-actions first))
187 (expand-clauses rest))))))