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.

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.

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-evaluating`

expressions, numbers or strings that do not require evaluation,`variable`

expressions, retrieved from the environment,`quoted`

expresions, quoted expression like`'a`

or`'b`

which self evaluate,`assignment`

expressions, store variable into the environment,`definition`

expressions, store procedure in the environment,`if`

expressions, executing a consequent or an alternative depending on the predicate,`lambda`

expressions, construct a procedure capturing the body, parameter, and environment,`begin`

expressions, executing expressions sequentially,`cond`

expressions, enhanced version of`if`

expressions,`application`

expressions, applying procedures to arguments provided.

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-procedure`

will match primitive procedures from Racket like arithmetic operations,`compount-procedure`

will 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.

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))

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 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 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 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)]

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)]

`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)]

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)]

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)))]

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))

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.

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.

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!

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)