CprS376 Schedule
CprS376 Class 17
CprS376 Class 19

Lazy Evaluation

Class 18 - Section 4.2



Contents

leval

;;;;LAZY EVALUATOR FROM SECTION 4.2 OF
;;;; STRUCTURE AND INTERPRETATION OF COMPUTER PROGRAMS

;;;;Matches code in ch4.scm
;;;; Also includes enlarged primitive-procedures list

;;;;This file can be loaded into Scheme as a whole.
;;;;**NOTE**This file loads the metacircular evaluator of
;;;;  sections 4.1.1-4.1.4, since it uses the expression representation,
;;;;  environment representation, etc.
;;;;  You may need to change the (load ...) expression to work in your
;;;;  version of Scheme.
;;;;**WARNING: Don't load mceval twice (or you'll lose the primitives
;;;;  interface, due to renamings of apply).

;;;;Then you can initialize and start the evaluator by evaluating
;;;; the two lines at the end of the file ch4-mceval.scm
;;;; (setting up the global environment and starting the driver loop).


;;;;  To run without memoization, reload the first version of force-it below


;;**implementation-dependent loading of evaluator file
;;Note: It is loaded first so that the section 4.2 definition
;; of eval overrides the definition from 4.1.1
; (load "ch4-mceval.scm")

;;===========================================

;; Modifications by Chris Parrish are tagged <cp: comment>

;; eval renamed to leval to avoid redefining an important system primitive
;; apply renamed to lapply to avoid redefining an important system primitive

;; =============================

;; <cp: load mceval source code>

(define mceval-path
  (string-append (home-vicinity)
                 "Abelson-Sussman SICP:chap 4 metalinguistic abstr:"
                 "4.1 metacircular evaluator:"))

(define loadfile
  (lambda (path filename)
    (load (string-append path filename))))

(loadfile mceval-path "ch4-mceval.ss")

;; =============================

;;;SECTION 4.2.2

;;; Modifying the evaluator

;; <cp: renamed eval to leval>
(define (leval 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))
        ;; <cp: renamed eval to leval>
        ((cond? exp) (leval (cond->if exp) env))
        ((application? exp)             ; clause from book
         (lapply (actual-value (operator exp) env)
                (operands exp)
                env))
        (else
         (error "Unknown expression type -- EVAL" exp))))

(define (actual-value exp env)
  ;; <cp: renamed eval to leval>
  (force-it (leval exp env)))

;; <cp: renamed apply to lapply>
(define (lapply procedure arguments env)
  (cond ((primitive-procedure? procedure)
         (apply-primitive-procedure
           procedure
           (list-of-arg-values arguments env))) ; changed
        ((compound-procedure? procedure)
         (eval-sequence
           (procedure-body procedure)
           (extend-environment
             (procedure-parameters procedure)
             (list-of-delayed-args arguments env) ; changed
             (procedure-environment procedure))))
        (else
         (error
           "Unknown procedure type -- APPLY" procedure))))

(define (list-of-arg-values exps env)
  (if (no-operands? exps)
      '()
      (cons (actual-value (first-operand exps) env)
            (list-of-arg-values (rest-operands exps)
                                env))))

(define (list-of-delayed-args exps env)
  (if (no-operands? exps)
      '()
      (cons (delay-it (first-operand exps) env)
            (list-of-delayed-args (rest-operands exps)
                                  env))))

(define (eval-if exp env)
  (if (true? (actual-value (if-predicate exp) env))
      ;; <cp: renamed eval to leval>
      (leval (if-consequent exp) env)
      ;; <cp: renamed eval to leval>
      (leval (if-alternative exp) env)))

;; <cp: in mceval we renamed eval to mceval
;;      so all the helping procedures, such as eval-assignment, 
;;      eval-definition, eval-sequence, etc, will call on mceval
;;      to finish the evaluation. We need to rename mceval
;;      to leval so that these helping procedures call on
;;      leval to finish the job of evaluation

(define mceval leval)

;; =============================

;;; rep loop

(define input-prompt ";;; L-Eval input:")
(define output-prompt ";;; L-Eval value:")

(define (driver-loop)
  (prompt-for-input input-prompt)
  (let ((input (read)))
    (let ((output
           (actual-value input the-global-environment)))
      (announce-output output-prompt)
      (user-print output)))
  (driver-loop))


;; <cp: a more friendly driver-loop>

(define (leval-driver-loop)
  (prompt-for-input input-prompt)
  (let ((input (read)))
    (if (equal? input 'bye)
      'chao
      (let ((output (actual-value input the-global-environment)))
        (announce-output output-prompt)
        (user-print output)
        (leval-driver-loop)))))

;; =============================

;;; Representing thunks

;; non-memoizing version of force-it

(define (force-it obj)
  (if (thunk? obj)
      (actual-value (thunk-exp obj) (thunk-env obj))
      obj))

;; thunks

(define (delay-it exp env)
  (list 'thunk exp env))

(define (thunk? obj)
  (tagged-list? obj 'thunk))

(define (thunk-exp thunk) (cadr thunk))
(define (thunk-env thunk) (caddr thunk))

;; "thunk" that has been forced and is storing its (memoized) value
(define (evaluated-thunk? obj)
  (tagged-list? obj 'evaluated-thunk))

(define (thunk-value evaluated-thunk) (cadr evaluated-thunk))


;; memoizing version of force-it

(define (force-it obj)
  (cond ((thunk? obj)
         (let ((result (actual-value
                        (thunk-exp obj)
                        (thunk-env obj))))
           (set-car! obj 'evaluated-thunk)
           (set-car! (cdr obj) result)  ; replace exp with its value
           (set-cdr! (cdr obj) '())     ; forget unneeded env
           result))
        ((evaluated-thunk? obj)
         (thunk-value obj))
        (else obj)))

;; =============================

;;; Primitives

;; A longer list of primitives -- suitable for running everything in 4.2
;; Overrides the list in ch4-mceval.scm

(define primitive-procedures
  (list (list 'car car)
        (list 'cdr cdr)
        (list 'cons cons)
        (list 'null? null?)
        (list 'list list)
        (list '+ +)
        (list '- -)
        (list '* *)
        (list '/ /)
        (list '= =)
        (list 'newline newline)
        (list 'display display)
;;      more primitives
        ))

'LAZY-EVALUATOR-LOADED

leval Transcript

;; leval.transcript

;; =============================

;; load leval source code

(define leval-path
  (string-append (home-vicinity)
                 "Abelson-Sussman SICP:chap 4 metalinguistic abstr:"
                 "4.2 lazy evaluation:"))

(define loadfile
  (lambda (path filename)
    (load (string-append path filename))))

(loadfile leval-path "ch4-leval.ss")

;; =============================

;; setup the global environment 
;; and enter the leval interpreter
;; type bye to quit

(define the-global-environment (setup-environment))
(leval-driver-loop)

;; interactions with the leval interpreter

12
'hi-there
(quote hi-there)
(define a 2)
a
(set! a 9)
a
'()
(= 0 1)
(= 1 1)
(define (add5 x) (+ 5 x))
add5
(add5 3)
(define add6 (lambda (x) (+ 6 x)))
add6
(add6 4)
(define mult (lambda (x y) (* x y)))
mult
(mult 3 4)
(cond ((= 0 1) 'true) (else 'false))
(cond ((= 1 1) 'true) (else 'false))
(cond (true 'true) (else 'false))
(cond (false 'false) (else 'true))
(define (try a b)                    ;; SICP, page 404
  (if (= a 0) 1 b))
(try 0 (/ 1 0))                      ;; whoopee!! definitely lazy
bye



Lazy

;; lazy.ss

;; SICP source code

;; EXERCISE 4.27

(define count 0)

(define (id x)
  (set! count (+ count 1))
  x)

(define w (id (id 10)))
count
w
count

;; EXERCISE 4.29

(define (square x)
  (* x x))

(square (id 10))
count

;; EXERCISE 4.30

(define (eval-sequence exps env)
  (cond ((last-exp? exps) (eval (first-exp exps) env))
        (else (actual-value (first-exp exps) env)
              (eval-sequence (rest-exps exps) env))))

;;PART A
(define (for-each proc items)
  (if (null? items)
      'done
      (begin (proc (car items))
             (for-each proc (cdr items)))))

(for-each (lambda (x) (newline) (display x))
          (list 57 321 88))

;;PART B

(define (p1 x)
  (set! x (cons x '(2)))
  x)

(define (p2 x)
  (define (p e)
    e
    x)
  (p (set! x (cons x '(2)))))


;;;SECTION 4.2.3
;;;
;;; This code can be loaded as a whole into the lazy evaluator,
;;;  and the examples (commented out with ;:) can then be evaluated
;;;  individually.

(define (cons x y)
  (lambda (m) (m x y)))

(define (car z)
  (z (lambda (p q) p)))

(define (cdr z)
  (z (lambda (p q) q)))


(define (list-ref items n)
  (if (= n 0)
      (car items)
      (list-ref (cdr items) (- n 1))))

(define (map proc items)
  (if (null? items)
      '()
      (cons (proc (car items))
            (map proc (cdr items)))))

(define (scale-list items factor)
  (map (lambda (x) (* x factor))
       items))

(define (add-lists list1 list2)
  (cond ((null? list1) list2)
        ((null? list2) list1)
        (else (cons (+ (car list1) (car list2))
                    (add-lists (cdr list1) (cdr list2))))))

;: (define ones (cons 1 ones))

;: (define integers (cons 1 (add-lists ones integers)))

;: (list-ref integers 17)

(define (integral integrand initial-value dt)
  (define int
    (cons initial-value
          (add-lists (scale-list integrand dt)
                    int)))
  int)

(define (solve f y0 dt)
  (define y (integral dy y0 dt))
  (define dy (map f y))
  y)

;: (list-ref (solve (lambda (x) x) 1 .001) 1000)


;; EXERCISE 4.33
;: (car '(a b c))

SICP Source Code

Programming Exercises

In class today we will continue our work on the following exercises from chapter 4: 1, 4, 5, 6, 7, 8, 11, 13, 14, 15, 16, 20, 23, 24, 25, 27, 29, 31, 33, 34, 38, 39, 42, 43, 45, 50, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 69.