MASSACHVSETTS INSTITVTE OF TECHNOLOGY
Department of Electrical Engineering and Computer Science
6.001--Structure and Interpretation of Computer Programs
Fall Semester, 1998
Problem Set 8 Solutions
To extend the initial global environment with bindings for the primitive procedures, we need to modify the procedure primitive-procedures:
(define primitive-procedures
(list (list 'car car)
(list 'cdr cdr)
(list 'cons cons)
(list 'null? null?)
;; new stuff for #1
(list '+ +)
(list '- -)
(list '* *)
(list '/ /)
(list '= =)
(list '< <)
(list '> >)
(list '1+ 1+)
(list 'list list)
(list 'pair? pair?)
(list 'symbol? symbol? )
(list 'eq? eq?)
;; end of new stuff
(list 'write-line write-line) ))
To add nil to the initial environment, we should modify setup-environment:
(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)
(define-variable! 'nil '() initial-env) ;; new for #1
initial-env))
We can verify that our changes work by running a few simple examples:
(init) ;;; M-Eval input: (define a 3) ;;; M-Eval value: ok ;;; M-Eval input: (define b (cons a nil)) ;;; M-Eval value: ok ;;; M-Eval input: b ;;; M-Eval value: (3) ;;; M-Eval input: (= (car b) 3) ;;; M-Eval value: #t
;;; M-Eval input: (define (and arg1 arg2) (if arg1 arg2 #f)) ;;; M-Eval value: ok ;;; M-Eval input: (and 1 2) ;;; M-Eval value: 2 ;;; M-Eval input: (and #f (/ 1 2)) ;;; M-Eval value: #f ;;; M-Eval input: (and #f (/ 1 0)) ;The object 0, passed as the second argument to integer-remainder, is not in the correct range. ;Type D to debug error, Q to quit back to REP loop:Oops, so our AND procedure failed on the last call. This is because AND should be a special form that evaluates from left to right, and stops when it reaches a false value. Because our AND procedure is not a special form, it evaluates both arguments first, thereby dying unnecessarily.
(b) So let's try again by implementing AND as a derived expression. We can first convert AND to an IF expression, then evaluate the resulting IF expression.
We'll first add to syntax.scm the code:
(define (and? exp) (tagged-list? exp 'and))
(define (and-vals cndl) (cdr cndl))
(define (and-first-val vals) (car vals))
(define (and-rest-vals vals) (cdr vals))
(define (and->if and-exp)
(and-change (and-vals and-exp)))
(define (and-change clauses)
(if (null? clauses)
'true
(let ((first (car clauses))
(rest (cdr clauses)))
(if (null? rest) first
(make-if first
(and-change rest)
'false)))))
Then, we'll have to add a line to the big COND statement in
meval to handle the and case:
((and? exp) (meval (and->if exp) env)) ;; ex. #2b
b) We can also handle AND as a special form directly. We'll add to meval.scm the the lines:
(define (eval-and exp env)
(eval-and-helper (and-vals exp) env))
(define (eval-and-helper exp env)
(if (null? exp) true
(let ((first (and-first-val exp))
(rest (and-rest-vals exp)))
(if (null? rest)
(meval first env)
(if (meval first env)
(eval-and-helper rest env)
false)))))
And then make a call to eval-and in meval (replacing the line from part b):
((and? exp) (eval-and exp env)) ;; ex. #2c
(define (let? exp) (tagged-list? exp 'let))
(define (let-assign exp) (cadr exp))
(define (let-body exp) (cddr exp))
(define (let-vars assign) (map car assign))
(define (let-exps assign) (map cadr assign))
(define (make-application operator operands)
(cons operator operands))
(define (let->comb exp)
(let ((assign (let-assign exp))
(body (let-body exp)))
(make-application
(make-lambda (let-vars assign) body )
(let-exps assign))))
Then we'll add a clause to the COND statement in meval to handle let:
((let? exp) (meval (let->comb exp) env)) ;; ex. #3a
We can verify the answer for Tutorial Exercise #4 for the lexical scoping part:
;;; M-Eval input:
(let ((y 1))
(let ((f (lambda (y) (lambda (x) (+ x y))) ))
((f 20) 300)))
;;; M-Eval value:
320
;;; M-Eval input:
(let ((y 1))
(let ((f (lambda (x) (+ x y)) ))
(let ((y 20))
(f 300))))
;;; M-Eval value:
301
b) We can de-sugar LET* into a series of LETs.
(define (let*? exp) (tagged-list? exp 'let*))
(define (let*-assign exp) (cadr exp))
(define (let*-body exp) (cddr exp))
(define (let*-first assign) (car assign))
(define (let*-rest assign) (cdr assign))
(define (make-let assign body)
(cons 'let (cons assign body)))
(define (let*->nested-lets exp)
(let ((assign (let*-assign exp))
(body (let*-body exp)))
(car (let*-helper assign body))))
(define (let*-helper assign body)
(if (null? assign) body
(let ((first (let*-first assign))
(rest (let*-rest assign)))
(list (make-let (list first)
(let*-helper rest body))))))
We can then modify meval to handle LET*.
((let*? exp) (meval (let*->nested-lets exp) env)) ;; ex. #3
(define (for? exp) (tagged-list? exp 'for)) (define (for-var exp) (cadr exp)) (define (for-initial exp) (caddr exp)) (define (for-pred exp) (cadddr exp)) (define (for-next exp) (caddddr exp)) (define (for-body exp) (cddr( cdddr exp)))In meval.scm, we add the procedures:
(define (eval-for exp env)
(eval-for-helper exp
;; create new frame for evaluating for
(extend-environment (list (for-var exp))
(list (meval (for-initial exp) env))
env)))
(define (eval-for-helper exp env)
;;(write-line env)
(cond ((false? (meval (for-pred exp) env)) 'ok) ;; end of loop
(else (eval-sequence (for-body exp) env)
(set-variable-value! (for-var exp) (meval (for-next exp) env) env)
(eval-for-helper exp env))))
Then we add the following to the COND statement in meval:
((for? exp) (eval-for exp env))
Let's make sure that this indeed works as we expected:
;;; M-Eval input: (for x 0 (<= x 10) (+ 1 x) (write-line x)) 0 1 2 3 4 5 6 7 8 9 10 ;;; M-Eval value: ok
(define (mapply procedure arguments dyn_env) ;; new variable to keep track of dyn. env
(cond ((primitive-procedure? procedure)
(apply-primitive-procedure procedure arguments))
((compound-procedure? procedure)
(eval-sequence
(procedure-body procedure)
(extend-environment
(procedure-parameters procedure)
arguments
dyn_env)))
(else (error "Unknown procedure type -- APPLY" procedure))))
And we need to pass in the environment when calling mapply in meval:
((application? exp)
(mapply (meval (operator exp) env)
(list-of-values (operands exp) env)
env)) ;; ex. #5: passing calling env
We can verify the answers for dynamic scoping part of Tutorial Ex. 4:
;;; M-Eval input:
(let ((y 1))
(let ((f (lambda (y) (lambda (x) (+ x y))) ))
((f 20) 300)))
;;; M-Eval value:
301
;;; M-Eval input:
(let ((y 1))
(let ((f (lambda (x) (+ x y)) ))
(let ((y 20))
(f 300))))
;;; M-Eval value:
320
;;; syntax predicates
(define (dynamic? exp) (tagged-list? exp 'dynamic ) )
(define (dynamic-declaration? exp)
(and (dynamic? exp) (= (length exp) 2)) )
(define (dynamic-definition? exp)
(and (dynamic? exp) (= (length exp) 3)))
;;; syntax selectors
(define (dynamic-variable exp) (cadr exp) )
(define (dynamic-value exp) (caddr exp) )
;;; accessors to the new environment structure
; also left for you to complete
(define (enclosing-environment env) (cadr env) ) ;; lexical
(define (enclosing-dyn-env env) (caddr env) )
(define (dynamics-in-env env) (cadddr env) )
(define (add-dynamic-in-env var env)
(set-car! (cdddr env) (cons var (dynamics-in-env env)) ))
For the last part of the code, we have to complete four procedures.
Luckily, most of it is quite similar to what's given. :)
;; lookup-dynamic-loop is similar to lookup-lexical-loop, you just need
;; to make sure to look up the enclosing-dyn-env instead.
(define (lookup-dynamic-loop var env)
(define (scan vars vals)
(cond (((null? vars) || !(dynamic-in-env? var env) )
(lookup-dynamic-loop var (enclosing-dyn-env env))) ;; dyn. 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)))))
;; the set-variable procedures are similar to look-up variable.
(define (set-variable-value! var val env)
(if (dynamics-in-env? var env)
(set-dynamic-variable-loop var val env)
(set-lexical-variable-loop var val env)) )
;; similar to look-lexical-loop, just need to change the variable instead of
;; returning its value
(define (set-lexical-variable-loop var val env)
(define (scan vars vals)
(cond ((null? vars)
(set-lexical-variable-loop var (enclosing-environment env)))
((eq? var (car vars))
(set-car! vals val)) ;; change variable binding here!
(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)))))
;; similar to look-dynamic-loop, just need to change the varible instead of
;; returning its value
(define (set-dynamic-variable-loop var val env)
(define (scan vars vals)
(cond (((null? vars) || !(dynamic-in-env? var env) )
(set-dynamic-variable-loop var (enclosing-dyn-env env)))
((eq? var (car vars))
(set-car! vals val)) ;; change variable binding here!
(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)))))
You can now run this with the code given in the assignment to make sure that
it works.That's all folks!! :)