6.001 Recitation # 15 – April 4, 2003

RI: Konrad Tollmar

• The Scheme Interpreter

• Eval review

1. Parse tree – scheme’s reader
Construct the parse tree for:
(eval '(define* z* (plus* 1 3)) GE)

(eval '(define* mpy* (lambda* (x* y*) (times* x* y*))) GE)

(eval '(mpy* 3 z*) GE)

2. Refine define*

Modify our language so define* also return the defined value.

3. Add a new operator

Extend our language with the and* operator.

(and* <exp1> <exp2> .. <expn>)

4. Change the language syntax

Add a new combination form.

(+ 1 2) (call + 1 2)

(call square 3)

Of course we also would like to change the wired prefix notation to good-old postfix style. Modify the interpreter so we can write postfix assignments instead.

(define myVar 10)

(myVar := 10)

Or maybe we would like to add a new procedure definition form.

(lambda (x) x)

(procedure (params: x) (body: x))

(lambda (x y) (+ x y) (* x y))

(procedure (params: x y)

(body: (+ x y) (* x y)))

Arithmetic calculator

(define (tag-check e sym) (and (pair? e) (eq? (car e) sym)))

(define (sum? e) (tag-check e 'plus*))

(define (eval exp)

(cond

((number? exp) exp)

((sum? exp) (eval-sum exp))

(else

(error "unknown expression " exp))))

(define (eval-sum exp)

(+ (eval (cadr exp)) (eval (caddr exp))))

(eval '(plus* 1 (plus* 1 1)))

Eval-6

(define (tag-check e sym) (and (pair? e) (eq? (car e) sym)))

(define (define? exp) (tag-check exp 'define*))

(define (if? exp) (tag-check exp 'if*))

(define (lambda? e) (tag-check e 'lambda*))

(define (application? e) (pair? e))

(define (eval exp env)

(cond

((number? exp) exp)

((symbol? exp) (lookup exp env))

((define? exp) (eval-define exp env))

((if? exp) (eval-if exp env))

((lambda? exp) (eval-lambda exp env))

((application? exp) (apply (eval (car exp) env)

(map (lambda (e) (eval e env))

(cdr exp))))

(else

(error "unknown expression " exp))))

; lookup searches the list of frames for the first match

(define (lookup name env)

(if (null? env)

(error "unbound variable: " name)

(let ((binding (table-get (car env) name)))

(if (null? binding)

(lookup name (cdr env))

(binding-value binding)))))

; define changes the first frame in the environment

(define (eval-define exp env)

(let ((name (cadr exp))

(defined-to-be (caddr exp)))

(table-put! (car env) name (eval defined-to-be env))

'undefined))

(define (binding-value binding)

(error "binding" binding)

(binding))

(define (eval-if exp)

(let ((predicate (cadr exp))

(consequent (caddr exp))

(alternative (cadddr exp)))

(let ((test (eval predicate)))

(cond

((eq? test #t) (eval consequent))

((eq? test #f) (eval alternative))

(else (error "predicate not a conditional: "

predicate))))))

(define (eval-lambda exp env)

(let ((args (cadr exp))

(body (caddr exp)))

(make-compound args body env)))

(define (apply operator operands)

(cond ((primitive? operator)

(scheme-apply (get-scheme-procedure operator)

operands))

((compound? operator)

(eval (body operator)

(extend-env-with-new-frame

(parameters operator)

operands

(env operator))))

(else

(error "operator not a procedure: " operator))))

;; ADT that implements the "double bubble"

(define compound-tag 'compound)

(define (make-compound parameters body env)

(list compound-tag parameters body env))

(define (compound? exp) (tag-check exp compound-tag))

(define (parameters compound) (cadr compound))

(define (body compound) (caddr compound))

(define (env compound) (cadddr compound))

;; primitive: an ADT that stores scheme procedures

(define prim-tag 'primitive)

(define (make-primitive scheme-proc)(list prim-tag scheme-proc))

(define (primitive? e) (tag-check e prim-tag))

(define (get-scheme-procedure prim) (cadr prim))

;; Environment model code (part of eval 6)

;; Environment = list<table>

(define (extend-env-with-new-frame names values env)

(let ((new-frame (make-table)))

(make-bindings! names values new-frame)

(cons new-frame env)))

(define (make-bindings! names values table)

(for-each

(lambda (name value) (table-put! table name value))

names values))

; the initial global environment

(define GE

(extend-env-with-new-frame

(list 'plus* 'greater*)

(list (make-primitive +) (make-primitive >))

nil))

; table

(define (find-assoc key alist)

(cond

((null? alist) #f)

((equal? key (caar alist)) (cadar alist))

(else (find-assoc key (cdr alist)))))

(define (add-assoc key val alist)

(cons (list key val) alist))

(define table-tag 'table)

(define (make-table) (cons table-tag nil))

(define (table-get tbl key)

(find-assoc key (cdr tbl)))

(define (table-put! tbl key val)

(set-cdr! tbl (add-assoc key val (cdr tbl))))