blob: 67bcad1b4ecf63af562b28d620c3ca48ab17a2e7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
(declare (usual-integrations eval apply))
(define (default-eval expression environment)
(cond ((application? expression)
(apply (eval (operator expression) environment)
(operands expression)
environment))
(else
(error "Unknown expression type" expression))))
(define (default-apply procedure operands calling-environment)
(error "Unknown procedure type" procedure))
(define eval
(make-generic-operator 2 default-eval))
(defhandler eval
(lambda (expression environment) expression)
self-evaluating?)
(defhandler eval lookup-variable-value variable?)
(defhandler eval
(lambda (expression environment)
(text-of-quotation expression))
quoted?)
(defhandler eval
(lambda (expression environment)
(make-compound-procedure
(lambda-parameters expression)
(lambda-body expression)
environment))
lambda?)
(defhandler eval
(lambda (expression environment)
(if (eval (if-predicate expression) environment)
(eval (if-consequent expression) environment)
(eval (if-alternative expression) environment)))
if?)
(defhandler eval
(lambda (expression environment)
(eval (cond->if expression) environment))
cond?)
(defhandler eval
(lambda (expression environment)
(eval (let->combination expression) environment))
let?)
(defhandler eval
(lambda (expression environment)
(evaluate-sequence (begin-actions expression)
environment))
begin?)
(define (evaluate-sequence actions environment)
(cond ((null? actions)
(error "Empty sequence"))
((null? (rest-exps actions))
(eval (first-exp actions) environment))
(else
(eval (first-exp actions) environment)
(evaluate-sequence (rest-exps actions) environment))))
(defhandler eval
(lambda (expression environment)
(define-variable! (definition-variable expression)
(eval (definition-value expression) environment)
environment)
(definition-variable expression))
definition?)
(defhandler eval
(lambda (expression environment)
(set-variable-value! (assignment-variable expression)
(eval (assignment-value expression) environment)
environment))
assignment?)
(define apply
(make-generic-operator 3 default-apply))
(defhandler apply
(lambda (procedure operands calling-environment)
(apply-primitive-procedure procedure
(evaluate-list operands calling-environment)))
strict-primitive-procedure?)
(define (evaluate-list operands calling-environment)
(cond ((null? operands) '())
((null? (rest-operands operands))
(list (eval (first-operand operands)
calling-environment)))
(else
(cons (eval (first-operand operands)
calling-environment)
(evaluate-list (rest-operands operands)
calling-environment)))))
(defhandler apply
(lambda (procedure operands calling-environment)
(if (not (= (length (procedure-parameters procedure))
(length operands)))
(error "Wrong number of operands supplied"))
(let ((arguments
(map (lambda (parameter operand)
(evaluate-procedure-operand parameter
operand
calling-environment))
(procedure-parameters procedure)
operands)))
(eval (procedure-body procedure)
(extend-environment
(map procedure-parameter-name
(procedure-parameters procedure))
arguments
(procedure-environment procedure)))))
compound-procedure?)
(defhandler apply
(lambda (proc-vector operands calling-environment)
(vector-map
(lambda (proc) (apply proc
operands
calling-environment))
proc-vector))
vector?)
(define evaluate-procedure-operand
(make-generic-operator 3
(lambda (parameter operand environment)
(eval operand environment))))
(define procedure-parameter-name
(make-generic-operator 1 (lambda (x) x)))
|
