Metacircular Evaluator In Lisp
May 23rd, 2019 - written by Kimserey with .
In previous posts, we explored the concepts of abstraction, mutability, and closure. A common point to all of them is that they were made available by programming languages. In fact, programming languages can themselves be seen as a very low level abstraction composed by a set of expressions. A programming language is written by composing functions together, like any other program, and interpreting the meaning of expressions given. Today we will look at how we can create an evaluator by implementing a metacircular evaluator supporting a subset of the syntax of Lisp.
Evaluator Structure
A metacircular evaluator is a evaluator written in the language that it evaluates. In this post, we will build an evaluator in Lisp, evaluating Lisp expressions. Racket in particular is a very well suited language for building evaluators due to its rich pattern matching features.
An evaluator is composed of two core functions:
eval, evaluates a given expression and returns the result if any,apply, applies a given expression to a procedure together with an environment.
The core concept being that an expression is first evaluated, and depending on the result of the evaluation, if the body of the expression contains subexpressions, the subexpressions are evaluated recursively, and if the body of the expression contains any procedure calls, it is applied to the arguments provided using the environment given to retrieve free variables.
Eval
The eval function evaluates an expression with a provided environment.
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
(define (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)]
[(lambda? exp)
(make-procedure
(lambda-parameters exp)
(lambda-body exp)
env)]
[(definition? exp)
(eval-definition exp env)]
[(if? exp)
(eval-if exp env)]
[(begin? exp)
(eval-sequence
(begin-actions exp)
env)]
[(cond? exp)
(eval (cond->if exp) env)]
[(application? exp)
(apply-local (eval (operator exp) env)
(list-of-values
(operands exp)
env))]
[else
(error "Unknown expression type: EVAL" exp)]))
We use cond to pattern match the expression and find which pattern the expression given matches. Each predicate is abstracted to its own function which we will define later. At the moment, we focus exclusively in understanding the logic of the eval procedure. In this eval, we support ten constructs:
self-evaluatingexpressions, numbers or strings that do not require evaluation,variableexpressions, retrieved from the environment,quotedexpresions, quoted expression like'aor'bwhich self evaluate,assignmentexpressions, store variable into the environment,definitionexpressions, store procedure in the environment,ifexpressions, executing a consequent or an alternative depending on the predicate,lambdaexpressions, construct a procedure capturing the body, parameter, and environment,beginexpressions, executing expressions sequentially,condexpressions, enhanced version ofifexpressions,applicationexpressions, applying procedures to arguments provided.
Apply
After the eval procedure, the next core procedure is apply, which we call apply-local in order to prevent collision with apply procedure already present in Racket.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
(define (apply-local procedure arguments)
(cond [(primitive-procedure? procedure)
(apply-primitive-procedure
procedure
arguments)]
[(compound-procedure? procedure)
(eval-sequence
(procedure-body procedure)
(extend-environment
(procedure-parameters procedure)
arguments
(procedure-environment procedure)))]
[else
(error "Unknown procedure type: APPLY" procedure)]))
Apply-local takes a procedure as argument and a set of arguments. Similarly to eval, we use cond and abstract predicates to direct the procedure to the right application.
primitive-procedurewill match primitive procedures from Racket like arithmetic operations,compount-procedurewill match the rest of the procedures with a body composed of a sequence of expressions.
Now that we have the two core procedures, we can implement the predicates and procedures evaluating the content of an expression.
Implementation
An expression is represented by a list of values. To identify syntax from an expression, we can look at the tag located at the front the expression. For example, the conditional (if #t #t #f) would be represented by a list of four values'(if #t #t #f) where the first value 'if would be the tag, and would allow us to interpret it as a conditional. While the procedure (define (x) 0) would be represented by a list of three values 'define would be the tag, and would allow us to interpret it as a definition, the second value would be a list '(x) of a single value x.
1
2
3
4
(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
false))
Self-Evaluating
We recognize numbers and strings as self-evaluating expressions by using the default Racket predicate number? and string?.
1
2
3
4
(define (self-evaluating? exp)
(cond [(number? exp) true]
[(string? exp) true]
[else false]))
Therefore when self evaluating expression are found, we simply return them directly.
1
2
; From eval
[(self-evaluating? exp) exp]
Variables are recognized as Racket symbols, therefore we use the default Racket predicate symbol?.
1
2
(define (variable? exp)
(symbol? exp))
When encountering a variable, we know that we need to find it in the environment therefore we use lookup-variable-value, which we will define later.
1
2
; From eval
[(variable? exp) (lookup-variable-value exp env)]
For quoted expression, we create a predicate which look for the tag 'quote.
1
2
3
4
5
(define (quoted? exp)
(tagged-list? exp 'quote))
(define (text-of-quotation exp)
(cadr exp))
We also create a procedure which extract the quotation value by skipping the tag and returning the second value present in the expression with (cadr exp).
1
2
; From eval
[(quoted? exp) (text-of-quotation exp)]
Assignments
Assignments are identified by looking for the tag set!.
1
2
3
4
5
6
7
8
(define (assignment? exp)
(tagged-list? exp 'set!))
(define (assignment-variable exp)
(cadr exp))
(define (assignment-value exp)
(caddr exp))
The assignment will be (set! variable value) therefore we extract the assignment variable by taking cadr and the assignment value by taking caddr.
Using the predicate and selectors, we create the evaluator function to evaluate assignments where we use set-variable-value! creating a new variable in the environment with the given value. We will see how to define set-variable-value! later.
1
2
3
4
5
6
(define (eval-assignment exp env)
(set-variable-value!
(assignment-variable exp)
(eval (assignment-value exp) env)
env)
'ok)
Eval-assignment is then used in eval
1
2
; From eval
[(assignment? exp) (eval-assignment exp env)]
Lambdas
Lambdas are identified with the tag lambda, where the second element in the list is the parameters and the rest of the elements is the body of the lambda.
1
2
3
4
5
6
7
8
(define (lambda? exp)
(tagged-list? exp 'lambda))
(define (lambda-parameters exp)
(cadr exp))
(define (lambda-body exp)
(cddr exp))
(lambda (x y z) (displayln x) (+ y z)) will have as parameters x, y, and z while (displayln x) and (+ y z) will be executed as the body of the lambda. Therefore to get the paramaters we get the cadr and to get the body we get the rest cddr.
We also define make-procedure, a procedure taking parameters, body and environment to create a procedure by adding them in a list with procedure tag as first element.
1
2
(define (make-procedure parameters body env)
(list 'procedure parameters body env))
From eval, we then use make-procedure to transform the lambda into a procedure by extracting the parameters and the body.
1
2
3
4
5
6
; From eval
[(lambda? exp)
(make-procedure
(lambda-parameters exp)
(lambda-body exp)
env)]
Definitions
Definitions starts with define, there are two types of definition, procedure definition and variable definition. A procedure definition is a simplified lambda expression, (define (x y) (+ 10 y)) is equivalent to (define x (lambda (y) (+ 10 y))), therefore we can create a lambda to represent the procedure.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
(define (definition? exp)
(tagged-list? exp 'define))
(define (definition-variable exp)
(if (symbol? (cadr exp))
(cadr exp)
(caadr exp)))
(define (make-lambda parameters body)
(cons 'lambda (cons parameters body)))
(define (definition-value exp)
(if (symbol? (cadr exp))
(caddr exp)
(make-lambda
(cdadr exp)
(cddr exp))))
For variables, the expression has the form of (define x y) where x is the variable and y is the value. For procedures, the expression has the form of (define (x a b) (+ a b)) where x is the variable and a and b are parameters and (+ a b) is the body. Therefore finding the variable would be cadr when cadr is a symbol or caadr when it is a list containing the variable and parameters. To find the value, we execute the same test and check if cadr is a symbol, if it is we take caddr which select the rest minus the tag and the variable, and if not we create a lambda using make-lambda selecting cdadr for the parameters and cddr for the body.
We then use definition-variable and definition-value to extract variables and values and create a variable in the environment using define-variable! which we will define later. This will add a value which is either an expression when the variable is a symbol, or a lambda when the variable is a list containing a variable name and parameters.
1
2
3
4
5
6
(define (eval-definition exp env)
(define-variable!
(definition-variable exp)
(eval (definition-value exp) env)
env)
'ok)
We then use eval-definition in eval to evaluate definitions.
1
2
; From eval
[(definition? exp) (eval-definition exp env)]
Conditionals
Conditional expressions, here if in particular would start by if. We create a true? predicate using the default false from Racket.
1
2
3
4
(define (if? exp) (tagged-list? exp 'if))
(define (true? x)
(not (eq? x false)))
An if expression looks like (if (predicate) (consequent) (alternative)), where we have three expressions, the predicate, the consequent and the alternative. We get the predicate by taking the cadr, the consequent by taking caddr, and the alternative, if any, is taken with cadddr.
1
2
3
4
5
6
7
8
(define (if-predicate exp) (cadr exp))
(define (if-consequent exp) (caddr exp))
(define (if-alternative exp)
(if (not (null? (cdddr exp)))
(cadddr exp)
'false))
We decide to return 'false when no alternative is provided. We then use true?, if-predicate, if-consequent and if-alternative to construct eval-if.
1
2
3
4
(define (eval-if exp env)
(if (true? (eval (if-predicate exp) env))
(eval (if-consequent exp) env)
(eval (if-alternative exp) env)))
And we use eval-if to evaluate a if expression.
1
2
; From eval
[(if? exp) (eval-if exp env)]
Begins
begin expressions are used to bundle a set of expressions together and return the last expression in the body.
1
2
3
4
(begin
(displayln "Hello")
(displayln "World")
(do-something))
We recognize begin expression by looking at begin tag.
1
2
(define (begin? exp)
(tagged-list? exp 'begin))
Then we get the list of actions, or the body of begin by taking cdr. And we create last-exp? predicate which find the last expression of the body so that we know which is the expression to return the result from.
1
2
3
4
5
6
7
8
9
(define (begin-actions exp) (cdr exp))
(define (last-exp? seq) (null? (cdr seq)))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))
(define (make-begin seq) (cons 'begin seq))
We also created first-exp and rest-exps selectors to select the first expression in the sequence of expression given and the rest of the expressions. Make-begin is a constructor creating a begin expression by appending 'begin to the front of a sequence of expressions.
Using the predicates and selectors, we then create eval-sequence which evaluates a sequence of expressions recursively and return the result of the last expression evaluated.
1
2
3
4
5
6
(define (eval-sequence exps env)
(cond [(last-exp? exps)
(eval (first-exp exps) env)]
[else
(eval (first-exp exps) env)
(eval-sequence (rest-exps exps) env)]))
And we use eval-sequence to evaluate a begin expression.
1
2
3
[(begin? exp) (eval-sequence
(begin-actions exp)
env)]
Derived Expressions
Writing the evaluator allows us to provided higher level syntax which can be built on top of lower level functionality. In the following example, we define cond, a conditional construct used to specify multiple patterns and consequent action to take for the first matching pattern. Cond is built on top of if which we defined earlier.
We identify conditional expression with cond, and all clauses are what follows the tag, as the conditional expression would look like (cond [(predicate) (consequent)] [else (alternative)]).
1
2
3
4
(define (cond? exp)
(tagged-list? exp 'cond))
(define (cond-clauses exp) (cdr exp))
We then create selectors to work on clause of the conditional. Since the conditions are specified as [(predicate) (consequent)], we create cond-predicate selecting the predicate with car, and cond-actions selecting the actions with cdr. We also identify the else clause by checking if the predicate is just else.
1
2
3
4
5
6
7
8
(define (cond-predicate clause)
(car clause))
(define (cond-actions clause)
(cdr clause))
(define (cond-else-clause? clause)
(eq? (cond-predicate clause) 'else))
Using the helpers from begin we created earlier, we create a procedure transforming a sequence into an expression sequence->exp and a constructor creating a if with make-if.
1
2
3
4
5
6
7
(define (sequence->exp seq)
(cond [(null? seq) seq]
[(last-exp? seq) (first-exp seq)]
[else (make-begin seq)]))
(define (make-if predicate consequent alternative)
(list 'if predicate consequent alternative))
We then use all the selectors and constructors to expand all the clauses from cond by recursively going through all clauses, extrating the first one and the rest, checking if the first clause is the else clause, if is is then we transform the sequence of actions into a begin expression with sequence->exp, else we create a if with make-if using the predicate of the clause. And we recursively go through the remaining clauses.
1
2
3
4
5
6
7
8
9
10
11
12
(define (expand-clauses clauses)
(if (null? clauses)
'false
(let ([first (car clauses)]
[rest (cdr clauses)])
(if (cond-else-clause? first)
(if (null? rest)
(sequence->exp (cond-actions first))
(error "ELSE clause isn't last: COND->IF" clauses))
(make-if (cond-predicate first)
(sequence->exp (cond-actions first))
(expand-clauses rest))))))
Then using expand-clauses, we define cond->if, a procedure tranforming a cond to a set of if where the alternative is the next cond clause.
1
2
(define (cond->if exp)
(expand-clauses (cond-clauses exp)))
And we use cond-if to evaluate cond.
1
2
; From eval
[(cond? exp) (eval (cond->if exp) env)]
Procedures
The last evaluation in eval is for procedure application where apply-local is used.
1
2
3
4
5
6
7
; From eval
[(application? exp)
(apply-local
(eval (operator exp) env)
(list-of-values
(operands exp)
env))]
Applications are recognized by pairs provided that the first element of the pair doesn’t match any known tags.
1
(define (application? exp) (pair? exp))
We can then extract the operator as the first element and the operands as the rest.
1
2
3
4
5
6
7
8
9
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))
(define (no-operands? ops) (null? ops))
(define (first-operand ops) (car ops))
(define (rest-operands ops) (cdr ops))
We also create predicate and selectors which will serve to evaluate all operands:
1
2
3
4
5
(define (list-of-values exps env)
(if (no-operands? exps)
'()
(cons (eval (first-operand exps) env)
(list-of-values (rest-operands exps) env))))
Given a list of expressions, we return a list of values, resulting of the evaluation of each expression.
Apply-local condition checks for compound procedures which are tagged with procedure.
1
2
(define (compound-procedure? p)
(tagged-list? p 'procedure))
And we create selectors to select paramters, body, and environment from the procedure.
1
2
3
4
5
(define (procedure-parameters p) (cadr p))
(define (procedure-body p) (caddr p))
(define (procedure-environment p) (cadddr p))
Which is then used in the apply-local to evaluate a sequence given a procedure body and an environment extended with bound parameters and arguments provided from eval using list-of-values.
1
2
3
4
5
6
7
8
; From apply-local
[(compound-procedure? procedure)
(eval-sequence
(procedure-body procedure)
(extend-environment
(procedure-parameters procedure)
arguments
(procedure-environment procedure)))]
Primitives
The first condition in apply-local checks if the procedure provided is a primitive procedure. If it is, it is applied using apply-primitive-procedure.
1
2
3
4
5
; From apply-local
[(primitive-procedure? procedure)
(apply-primitive-procedure
procedure
arguments)]
Primitive procedures are procedures coming from the evaluator language. We recognize expression of primitive procedures by looking for the tag primitive.
1
2
(define (primitive-procedure? proc)
(tagged-list? proc 'primitive))
We define a list of primitve procedures which we want to support.
1
2
3
4
5
6
7
8
9
(define primitive-procedures
(list (list 'car car)
(list 'cdr cdr)
(list 'cons cons)
(list 'null? null?)
(list '+ +)
(list '- -)
(list '/ /)
(list '* *)))
And we provide selectors to append the tag primitive via primitive-procedure-objects and to retrieve a list of all primitive procedures name via primitive-procedure-names. And we retrieve the implementation by taking cadr as the second element will be the procedure.
1
2
3
4
5
6
7
8
9
10
(define (primitive-procedure-objects)
(map (lambda (proc)
(list 'primitive (cadr proc)))
primitive-procedures))
(define (primitive-procedure-names)
(map car primitive-procedures))
(define (primitive-implementation proc)
(cadr proc))
Primitive-procedure-objects and primitive-procedure-names will be used to setup the initial environment which we will see later. Applying a primitive procedure is done by using the apply procedure from Racket and selecting the implementation of the procedure, and applying it to the arguments.
1
2
(define (apply-primitive-procedure proc args)
(apply (primitive-implementation proc) args))
Environment
In self evaluation, we used lookup-variable-value to find a value for a variable in the environment. Then in assignments, we used set-variable-value! to set a value for a variable in a given environment. We also used define-variable! in definitions to set a value to a variable in the first frame of an environment. An environment is simply a set of frames holding values and variables.
1
2
3
4
5
(define (make-frame variables values) (mcons variables values))
(define (frame-variables frame) (mcar frame))
(define (frame-values frame) (mcdr frame))
To interact with frames, we create a constructor make-frame, frame-variables, and frame-values to select the parts of the frame. To make changes on a frame, we use the mutable cons of Racket, mcons with mcar and mcdr.
Adding a binding in a frame is done by updating the variables and values of the frame with a new list containing the new binding.
1
2
3
(define (add-binding-to-frame! var val frame)
(set-mcar! frame (cons var (frame-variables frame)))
(set-mcdr! frame (cons val (frame-values frame))))
When creating a procedure, the environment in which the procedure gets created is captured, we can see that in make-lambda. When the procedure gets applied, the environment is augmented with a new frame which we can see in compound-procedure application where we use extend-environment. After being applied, we can access the enclosed environment by taking the cdr.
1
2
3
4
5
(define the-empty-environment 'the-empty-environment)
(define (first-frame env) (car env))
(define (enclosing-environment env) (cdr env))
We create a variable representing an empty environment, and also a selector getting the first-frame with car.
With that we can now create our main procedures to interact with the environment starting by extend-environment.
1
2
3
4
5
6
7
8
9
10
(define (extend-environment vars vals base-env)
(if (= (length vars) (length vals))
(cons (make-frame vars vals) base-env)
(if (< (length vars) (length vals))
(error "Too many arguments supplied"
vars
vals)
(error "Too few arguments supplied"
vars
vals))))
Extending the environment is done by creating a new frame with initial variables and values on top of a base environment.
1
2
3
4
5
6
7
8
9
10
11
12
(define (lookup-variable-value var env)
(define (env-loop env)
(define (scan vars vals)
(cond [(null? vars) (env-loop (enclosing-environment env))]
[(eq? var (car vars))(car vals)]
[else (scan (cdr vars) (cdr vals))]))
(if (eq? env the-empty-environment)
(error "Unbound variable" var)
(let ([frame (first-frame env)])
(scan (frame-variables frame)
(frame-values frame)))))
(env-loop env))
Lookup of a value for a given variable is done by recursively looking at each frame of the environment, exploring enclosed environments when variable can’t be found on the current frame.
1
2
3
4
5
6
7
8
9
10
11
12
(define (set-variable-value! var val env)
(define (env-loop env)
(define (scan vars vals)
(cond [(null? vars) (env-loop (enclosing-environment env))]
[(eq? var (car vars)) (set-mcar! vals val)]
[else (scan (cdr vars) (cdr vals))]))
(if (eq? env the-empty-environment)
(error "Unbound variable: SET!" var)
(let ([frame (first-frame env)])
(scan (frame-variables frame)
(frame-values frame)))))
(env-loop env))
Setting a variable is done by recursively looking at each frame of the environment and setting the variable if found, else if the variable does not exists, an unbound variable error is raised.
1
2
3
4
5
6
7
8
(define (define-variable! var val env)
(let ([frame (first-frame env)])
(define (scan vars vals)
(cond [(null? vars) (add-binding-to-frame! var val frame)]
[(eq? var (car vars)) (set-mcar! vals val)]
[else (scan (cdr vars) (cdr vals))]))
(scan (frame-variables frame)
(frame-values frame))))
In contrary, defining a variable will only search for an existing variable within the first frame, which is the new frame augmenting the environment at application, for an existing variable or creating a new one if it does not exists, effectively shadowing any existing variable defined in enclosed environment without changing them. Since lookup-variable-value picks the first variable, any shadowed variables will then be taken from the new frame.
Running the Evaluator
Now that we are done with the implementation of eval and apply-local, we can setup the global environment.
1
2
3
4
5
6
7
8
9
10
(define (setup-environment)
(let ([initial-env (extend-environment
(primitive-procedure-names)
(primitive-procedure-objects)
the-empty-environment)])
(define-variable! 'true true initial-env)
(define-variable! 'false false initial-env)
initial-env))
(define the-global-environment (setup-environment))
Our initial environment is the global environment. It extends the the-empty-environment by adding a frame containing all primitive procedures, using primitive-procedure-names and primitive-procedure-objects previously defined, and adds in the same frame a definition of true and false. Using this environment we can create a driver-loop which will evaluate a given expression in the global environment.
1
(eval input the-global-environment)
To create the driver-loop, we start by creating tracing input and ouput prompt.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
(define input-prompt ";;; M-Eval input:")
(define (prompt-for-input string)
(newline)
(newline)
(display string)
(newline))
(define output-prompt ";;; M-Eval value:")
(define (announce-output string)
(newline)
(display string)
(newline))
(define (user-print object)
(if (compound-procedure? object)
(display
(list 'compound-procedure
(procedure-parameters object)
(procedure-body object)
'<procedure-env>))
(display object)))
Prompt-for-input and announce-output are generic prompt for displaying messages. We use them to display input-prompt and output-prompt. User-print will prints the output returned by the evaluation. Lastly we define the driver-loop which recursively uses read procedure provided by Racket to read a text input as an expression.
1
2
3
4
5
6
7
(define (driver-loop)
(prompt-for-input input-prompt)
(let ([input (read)])
(let ([output (eval input the-global-environment)])
(announce-output output-prompt)
(user-print output)))
(driver-loop))
We read and save into the input, then use eval passing in the input and the the-global-environment, save the result into output, print the output, then recursively call the driver-loop again to evaluate a new procedure.
We can then run the evaluator
1
2
3
(driver-loop)
;;; M-Eval input:
Define a procedure which gets evaluated by our own evaluator
1
2
3
4
5
6
7
8
9
(define (append x y)
(if (null? x)
y
(cons (car x) (append (cdr x) y))))
;;; M-Eval value:
ok
;;; M-Eval input:
Then execute the procedure.
1
2
3
4
(append '(a b c) '(d e f))
;;; M-Eval value:
(a b c d e f)
Append is applied to the two lists and the result is displayed properly.
Conclusion
A programming language is no different to any other sort of abstractions. It is interesting to see how a language providing simple instruction opens a vast amount of possibility to build more powerful programs executing more complex logic than the evaluator evaluating the language itself. Today we saw how to code a metacircular evaluator which supports a subset of Lisp. We started by looking at the implementation of te main functions eval and apply composing an evaluator. Then we looked into how an environment was represented and how assignments were handled. And lastly we completed by looking at how we could setup a driver loop to accepted an expression as input, evaluate it, then return a result. I hope you liked this post and I see you on the next one!
Complete Source Code
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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
; **
; Eval and Apply
; **
(define (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)
(eval (cond->if exp) env)]
[(application? exp)
(apply-local (eval (operator exp) env)
(list-of-values
(operands exp)
env))]
[else
(error "Unknown expression type: EVAL" exp)]))
(define (apply-local procedure arguments)
(cond [(primitive-procedure? procedure)
(apply-primitive-procedure
procedure
arguments)]
[(compound-procedure? procedure)
(eval-sequence
(procedure-body procedure)
(extend-environment
(procedure-parameters procedure)
arguments
(procedure-environment procedure)))]
[else
(error "Unknown procedure type: APPLY" procedure)]))
(define (list-of-values exps env)
(if (no-operands? exps)
'()
(cons (eval (first-operand exps) env)
(list-of-values (rest-operands exps) env))))
(define (eval-if exp env)
(if (true? (eval (if-predicate exp) env))
(eval (if-consequent exp) env)
(eval (if-alternative exp) env)))
(define (eval-sequence exps env)
(cond [(last-exp? exps)
(eval (first-exp exps) env)]
[else
(eval (first-exp exps) env)
(eval-sequence (rest-exps exps) env)]))
(define (eval-assignment exp env)
(set-variable-value!
(assignment-variable exp)
(eval (assignment-value exp) env)
env)
'ok)
(define (eval-definition exp env)
(define-variable!
(definition-variable exp)
(eval (definition-value exp) env)
env)
'ok)
; **
; Expressions
; **
(define (self-evaluating? exp)
(cond [(number? exp) true]
[(string? exp) true]
[else false]))
(define (variable? exp)
(symbol? exp))
(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
false))
(define (quoted? exp)
(tagged-list? exp 'quote))
(define (text-of-quotation exp)
(cadr exp))
(define (assignment? exp)
(tagged-list? exp 'set!))
(define (assignment-variable exp)
(cadr exp))
(define (assignment-value exp)
(caddr exp))
(define (definition? exp)
(tagged-list? exp 'define))
(define (definition-variable exp)
(if (symbol? (cadr exp))
(cadr exp)
(caadr exp)))
(define (definition-value exp)
(if (symbol? (cadr exp))
(caddr exp)
(make-lambda
(cdadr exp)
(cddr exp))))
(define (lambda? exp)
(tagged-list? exp 'lambda))
(define (lambda-parameters exp)
(cadr exp))
(define (lambda-body exp)
(cddr exp))
(define (make-lambda parameters body)
(cons 'lambda (cons parameters body)))
(define (if? exp) (tagged-list? exp 'if))
(define (if-predicate exp) (cadr exp))
(define (if-consequent exp) (caddr exp))
(define (if-alternative exp)
(if (not (null? (cdddr exp)))
(cadddr exp)
'false))
(define (make-if predicate consequent alternative)
(list 'if predicate consequent alternative))
(define (begin? exp)
(tagged-list? exp 'begin))
(define (begin-actions exp) (cdr exp))
(define (last-exp? seq) (null? (cdr seq)))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))
(define (sequence->exp seq)
(cond [(null? seq) seq]
[(last-exp? seq) (first-exp seq)]
[else (make-begin seq)]))
(define (make-begin seq) (cons 'begin seq))
(define (application? exp) (pair? exp))
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))
(define (no-operands? ops) (null? ops))
(define (first-operand ops) (car ops))
(define (rest-operands ops) (cdr ops))
(define (cond? exp)
(tagged-list? exp 'cond))
(define (cond-clauses exp) (cdr exp))
(define (cond-else-clause? clause)
(eq? (cond-predicate clause) 'else))
(define (cond-predicate clause)
(car clause))
(define (cond-actions clause)
(cdr clause))
(define (cond->if exp)
(expand-clauses (cond-clauses exp)))
(define (expand-clauses clauses)
(if (null? clauses)
'false ;no else clause
(let ([first (car clauses)]
[rest (cdr clauses)])
(if (cond-else-clause? first)
(if (null? rest)
(sequence->exp (cond-actions first))
(error "ELSE clause isn't last: COND->IF" clauses))
(make-if (cond-predicate first)
(sequence->exp (cond-actions first))
(expand-clauses rest))))))
(define (true? x)
(not (eq? x false)))
(define (make-procedure parameters body env)
(list 'procedure parameters body env))
(define (compound-procedure? p)
(tagged-list? p 'procedure))
(define (procedure-parameters p) (cadr p))
(define (procedure-body p) (caddr p))
(define (procedure-environment p) (cadddr p))
; **
; Environment
; **
(define (enclosing-environment env) (cdr env))
(define (first-frame env) (car env))
(define the-empty-environment 'the-empty-environment)
(define (make-frame variables values)
(mcons variables values))
(define (frame-variables frame) (mcar frame))
(define (frame-values frame) (mcdr frame))
(define (add-binding-to-frame! var val frame)
(set-mcar! frame (cons var (frame-variables frame)))
(set-mcdr! frame (cons val (frame-values frame))))
(define (extend-environment vars vals base-env)
(if (= (length vars) (length vals))
(cons (make-frame vars vals) base-env)
(if (< (length vars) (length vals))
(error "Too many arguments supplied"
vars
vals)
(error "Too few arguments supplied"
vars
vals))))
(define (lookup-variable-value var env)
(define (env-loop env)
(define (scan vars vals)
(cond [(null? vars) (env-loop (enclosing-environment env))]
[(eq? var (car vars))(car vals)]
[else (scan (cdr vars) (cdr vals))]))
(if (eq? env the-empty-environment)
(error "Unbound variable" var)
(let ([frame (first-frame env)])
(scan (frame-variables frame)
(frame-values frame)))))
(env-loop env))
(define (set-variable-value! var val env)
(define (env-loop env)
(define (scan vars vals)
(cond [(null? vars) (env-loop (enclosing-environment env))]
[(eq? var (car vars)) (set-mcar! vals val)]
[else (scan (cdr vars) (cdr vals))]))
(if (eq? env the-empty-environment)
(error "Unbound variable: SET!" var)
(let ([frame (first-frame env)])
(scan (frame-variables frame)
(frame-values frame)))))
(env-loop env))
(define (define-variable! var val env)
(let ([frame (first-frame env)])
(define (scan vars vals)
(cond [(null? vars) (add-binding-to-frame! var val frame)]
[(eq? var (car vars)) (set-mcar! vals val)]
[else (scan (cdr vars) (cdr vals))]))
(scan (frame-variables frame)
(frame-values frame))))
; **
; Run
; **
(define (setup-environment)
(let ([initial-env (extend-environment
(primitive-procedure-names)
(primitive-procedure-objects)
the-empty-environment)])
(define-variable! 'true true initial-env)
(define-variable! 'false false initial-env)
initial-env))
(define (primitive-procedure? proc)
(tagged-list? proc 'primitive))
(define (primitive-implementation proc)
(cadr proc))
(define primitive-procedures
(list (list 'car car)
(list 'cdr cdr)
(list 'cons cons)
(list 'null? null?)
(list '+ +)
(list '- -)
(list '/ /)
(list '* *)))
(define (primitive-procedure-names)
(map car primitive-procedures))
(define (primitive-procedure-objects)
(map (lambda (proc)
(list 'primitive (cadr proc)))
primitive-procedures))
(define (apply-primitive-procedure proc args)
(apply (primitive-implementation proc) args))
(define the-global-environment (setup-environment))
(define input-prompt ";;; M-Eval input:")
(define output-prompt ";;; M-Eval value:")
(define (driver-loop)
(prompt-for-input input-prompt)
(let ([input (read)])
(let ([output (eval input the-global-environment)])
(announce-output output-prompt)
(user-print output)))
(driver-loop))
(define (prompt-for-input string)
(newline)
(newline)
(display string)
(newline))
(define (announce-output string)
(newline)
(display string)
(newline))
(define (user-print object)
(if (compound-procedure? object)
(display
(list 'compound-procedure
(procedure-parameters object)
(procedure-body object)
'<procedure-env>))
(display object)))
;; Run the evaluator
(driver-loop)