# 4.2 Variations on a Scheme—Lazy Evaluation
(define (try a b) (if (= a 0) 1 b))With lazy evaluation, this would return 1 instead of raising an error.
(try 0 (/ 1 0)) =!> ""
(define (unless condition usual-value exceptional-value)
(if condition exceptional-value usual-value))# Exercise 4.25
(define (factorial n)
(unless (= n 1) (* n (factorial (- n 1))) 1))
(factorial 5) =>...This never terminates in our applicative-order Scheme because the call to unless always evaluates all parameters, including the recursive call to factorial when n is 1. In a normal-order language, it would work, since the recursive call in the base case is not used and hence not evaluated.
# Exercise 4.26
Ben is correct. You can implement unless as a special form:
(define (unless->if exp)
(list 'if (cadr exp) (cadddr exp) (caddr exp)))
(define (unless-pkg)
(put 'eval 'unless (lambda (exp env) (eval (unless->if exp) env))))
(using eval-pkg unless-pkg)
(define env (setup-environment))
(eval '(unless #f "hi" undefined-variable) env) => "hi"But Alyssa also has a point: this is just syntax, so it can’t be used with higher-order procedures. Here is an example where that would be useful:
(with-eval eval env
(define (map f as bs cs)
(cond ((null? as) '())
(else (cons (f (car as) (car bs) (car cs))
(map f (cdr as) (cdr bs) (cdr cs))))))
(define uppercase '(#t #f))
(map unless uppercase '(a b) '(A B)))
=!> "unbound variable: unless"# 4.2.2 An Interpreter with Lazy Evaluation
# 4.2.2.1 Modifying the evaluator
(define (eval-call exp env)
(apply (actual-value (operator exp) env)
(operands exp)
env))
(define (apply proc args env)
(cond ((primitive-procedure? proc)
(apply-primitive-procedure proc (list-of-arg-values args env)))
((compound-procedure? proc)
(eval-sequence
(procedure-body proc)
(extend-environment (procedure-parameters proc)
(list-of-delayed-args args env)
(procedure-environment proc))))
(else (error 'apply "unknown procedure type" proc))))
(define (list-of-arg-values exps env)
(cond ((no-operands? exps) '())
(else (cons (actual-value (first-operand exps) env)
(list-of-arg-values (rest-operands exps) env)))))
(define (list-of-delayed-args exps env)
(cond ((no-operands? exps) '())
(else (cons (memo-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))
(eval (if-consequent exp) env)
(eval (if-alternative exp) env)))
(define (lazy-eval-pkg)
(put 'eval 'call eval-call)
(put 'eval 'if eval-if))
(using eval-pkg)
(with-eval eval (setup-environment)
(define (try a b) (if (= a 0) 1 b))
(try 0 (/ 1 0)))
=!> "/"Note: With the lazy evaluator, we use actual-value for the top-level REPL rather than eval. Thus we have a fourth condition for forcing expressions (in addition to operands, if-predicates, and primitive procedure operands).
(using eval-pkg lazy-eval-pkg)
(with-eval actual-value (setup-environment)
(define (try a b) (if (= a 0) 1 b))
(try 0 (/ 1 0)))
=> 1# 4.2.2.2 Representing thunks
Moved here from Section 4.2.2.1 to avoid import cycle.
(define (actual-value exp env) (force-it (eval exp env)))Support both non-memoized and memoized thunks, to make Exercise 4.31 easier.
(define (delay-it exp env) (list 'thunk exp env))
(define (memo-delay-it exp env) (list 'memo-thunk exp env))
(define (thunk? obj) (tagged-list? obj 'thunk))
(define (memo-thunk? obj) (tagged-list? obj 'memo-thunk))
(define (thunk-exp thunk) (cadr thunk))
(define (thunk-env thunk) (caddr thunk))
(define (evaluated-thunk? obj) (tagged-list? obj 'evaluated-thunk))
(define (thunk-value thunk) (cadr thunk))
(define (force-it obj)
(cond ((thunk? obj) (actual-value (thunk-exp obj) (thunk-env obj)))
((evaluated-thunk? obj) (thunk-value obj))
((memo-thunk? obj)
(let ((result (actual-value (thunk-exp obj) (thunk-env obj))))
(set-car! obj 'evaluated-thunk)
(set-car! (cdr obj) result)
(set-cdr! (cdr obj) '())
result))
(else obj)))# Exercise 4.27
(using eval-pkg lazy-eval-pkg)
(define env (setup-environment))
(with-eval actual-value env
(define count 0)
(define (id x) (set! count (+ count 1)) x)
(define w (id (id 10))))When we defined w, it forced the outer id operand, resulting in count being incremented. The (id 10) argument is delayed.
(actual-value 'count env) => 1Using actual-value forces the full evaluation of w to 10.
(actual-value 'w env) => 10Forcing w caused the inner (id 10) to increment count again.
(actual-value 'count env) => 2# Exercise 4.28
(using eval-pkg lazy-eval-pkg)Here is an example that demonstrates the need for forcing the operand:
(define exp '(((lambda (x) x) car) (cons 1 2)))
(define env (setup-environment))
(define (do-it-with f)
(force-it (apply (f (operator exp) env) (operands exp) env)))With actual-value (the normal behavior), it works fine.
(do-it-with actual-value) => 1But with eval, the operator ((lambda (x) x) car) remains a thunk, whereas apply expects either a primitive or compound procedure object.
(do-it-with eval) =!> "apply: unknown procedure type"# Exercise 4.29
This program would be much slower without memoization, since it would re-evaluate then (fib 100) thunk five times.
(define (five-times-fib-hundred)
(let ((x (fib 100)))
(+ x x x x x)))
(using eval-pkg lazy-eval-pkg)
(define env (setup-environment))
(with-eval actual-value env
(define count 0)
(define (id x) (set! count (+ count 1)) x)
(define (square x) (* x x))
(square (id 10)))
=> 100With memoization, this is 1. Without memoization, it would be 2.
(actual-value 'count env) => 1# Exercise 4.30
(paste (:4.2.2.1 apply eval-call))Cy D. Fect proposes the following change:
(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))))
(define (proposed-sequence-pkg)
(put 'eval 'begin (lambda (exp env) (eval-sequence (begin-actions exp) env)))
(put 'eval 'call eval-call))
(using eval-pkg lazy-eval-pkg)
(define env (setup-environment))
(with-eval actual-value env
;; Ben Bitdiddle's example program:
(define (for-each proc items)
(if (null? items)
'done
(begin (proc (car items))
(for-each proc (cdr items)))))
(define (bens-example)
(for-each (lambda (x) (newline) (display x))
(list 57 321 88)))
;; Cy D. Fect's example program:
(define (p1 x)
(set! x (cons x '(2))) x)
(define (p2 x)
(define (p e) e x)
(p (set! x (cons x '(2))))))Ben is right about the behavior of
for-eachin his example. Evaluating(proc (car items))is sufficient to enact the side effects inproc. There is no need to force a returned thunk because it does not return anything.(using eval-pkg lazy-eval-pkg) (actual-value '(bens-example) env) =$> ["57" "321" "88"]With the original
eval-sequence,(p2 1)has an unexpected result. With Cy’s proposed change,p2behaves the same asp1.(using eval-pkg lazy-eval-pkg) (actual-value '(p1 1) env) => '(1 2) (actual-value '(p2 1) env) => 1 (using eval-pkg lazy-eval-pkg proposed-sequence-pkg) (actual-value '(p1 1) env) => '(1 2) (actual-value '(p2 1) env) => '(1 2)Cy is write: his proposed
eval-sequencedoes not affect part (a). All it does is force the return value ofdisplayandnewline. These are void, not thunks, so forcing is a no-op.(using eval-pkg lazy-eval-pkg proposed-sequence-pkg) (actual-value '(bens-example) env) =$> ["57" "321" "88"]I prefer Cy’s approach because otherwise
beginblocks, or procedures with multiple expressions in the body, are useless with the lazy evaluator. This does not totally solve the side-effects confusion, but it helps.
# Exercise 4.31
(paste (:4.2.2.1 eval-call))
(define (procedure-parameter-names p)
(map (lambda (x) (if (pair? x) (cadr x) x))
(procedure-parameters p)))
(define (list-of-args exps params env)
(if (no-operands? exps)
'()
(let ((f (cond ((symbol? (car params)) actual-value)
((eq? (caar params) 'lazy) delay-it)
((eq? (caar params) 'lazy-memo) memo-delay-it)
(else (error 'list-of-args
"invalid parameter"
(car params))))))
(cons (f (first-operand exps) env)
(list-of-args (rest-operands exps) (cdr params) env)))))
(define (apply proc args env)
(cond ((primitive-procedure? proc)
(apply-primitive-procedure proc (list-of-arg-values args env)))
((compound-procedure? proc)
(eval-sequence
(procedure-body proc)
(extend-environment
(procedure-parameter-names proc)
(list-of-args args (procedure-parameters proc) env)
(procedure-environment proc))))
(else (error 'apply "unknown procedure type" proc))))
(define (explicit-lazy-pkg)
(put 'eval 'call eval-call)
(put 'eval 'if eval-if))
(using eval-pkg explicit-lazy-pkg)
(define env (setup-environment))
(with-eval actual-value env
(define (try a b) (if (= a 0) 1 b))
(define (try-lazy a (lazy b)) (if (= a 0) 1 b))
(define (try-lazy-memo a (lazy-memo b)) (if (= a 0) 1 b))
(define (double x) (+ x x))
(define (double-lazy (lazy x)) (+ x x))
(define (double-lazy-memo (lazy-memo x)) (+ x x)))
(actual-value '(try 0 (/ 1 0)) env) =!> "/"
(actual-value '(try-lazy 0 (/ 1 0)) env) => 1
(actual-value '(try-lazy-memo 0 (/ 1 0)) env) => 1
(actual-value '(double (begin (display "x") 1)) env) =$> "x"
(actual-value '(double-lazy (begin (display "x") 1)) env) =$> "xx"
(actual-value '(double-lazy-memo (begin (display "x") 1)) env) =$> "x"# 4.2.3 Streams as Lazy Lists
Used in Exercise 4.34.
(define (lazy-cons? exp)
(and (compound-procedure? exp)
(equal? (procedure-parameters exp) '(*lazy-cons*))))
(define (lazy-cons-car exp)
(lookup-variable-value 'car (procedure-environment exp)))
(define (lazy-cons-cdr exp)
(lookup-variable-value 'cdr (procedure-environment exp)))
(using eval-pkg lazy-eval-pkg)
(define lazy-list-env (setup-environment))
(with-eval actual-value lazy-list-env
(define (cons car cdr) (lambda (*lazy-cons*) (*lazy-cons* car cdr)))
(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))
=> 18
(with-eval actual-value (make-environment lazy-list-env)
(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 0.001) 1000))
~> 2.716923932235896# Exercise 4.32
(using eval-pkg lazy-eval-pkg)
(define env (make-environment lazy-list-env))This example works equally well with the streams from Chapter 3.
(with-eval actual-value env
(define (scan xs)
(cons (car xs)
(map (lambda (x) (+ x (car xs))) (scan (cdr xs)))))
(define pascal (cons ones (map scan pascal)))
(define (choose n k) (list-ref (list-ref pascal (- n k)) k))
(choose 7 2))
=> 21This example takes advantage of the extra laziness of lazy lists. With the streams from Chapter 3, it would display “012345” instead of “5.”
(with-eval actual-value env
(define (from n) (cons (display n) (from (+ n 1))))
(define display-ints (from 0))
(list-ref display-ints 5))
=$> "5"# Exercise 4.33
(define (quoted->lazy x)
(cond ((pair? x) (list 'cons (quoted->lazy (car x)) (quoted->lazy (cdr x))))
;; Note: We can't simply move the `eval` call inside `quoted->lazy` and
;; then omit it in this branch, since we might have recursed into a cons
;; structure. We need this "dumb-quote" escape hatch.
(else (list 'dumb-quote x))))
(define (lazy-quote-pkg)
(put 'eval 'quote
(lambda (exp env) (eval (quoted->lazy (text-of-quotation exp)) env)))
(put 'eval 'dumb-quote
(lambda (exp env) (text-of-quotation exp))))
(define env (make-environment lazy-list-env))
(using eval-pkg lazy-eval-pkg)
(actual-value ''() env) => '()
(actual-value ''a env) => 'a
(actual-value '(car '(a b c)) env) =!> "apply: unknown procedure type"
(using eval-pkg lazy-eval-pkg lazy-quote-pkg)
(actual-value ''() env) => '()
(actual-value ''a env) => 'a
(actual-value '(car '(a b c)) env) => 'a# Exercise 4.34
(define (show exp)
(define (go exp ad dd space parens)
(cond ((and (null? exp) (not parens)))
((lazy-cons? exp)
(when space (display " "))
(when parens (display "("))
(if (zero? ad)
(display "...")
(go (lazy-cons-car exp) (- ad 1) dd #f #t))
(if (zero? dd)
(display " ...")
(let* ((exp-cdr (lazy-cons-cdr exp))
(dot (not (or (null? exp-cdr) (pair? exp-cdr)))))
(when dot (display ". "))
(go exp-cdr ad (- dd 1) #t dot)))
(when parens (display ")")))
((or (memo-thunk? exp) (evaluated-thunk? exp))
(go (force-it exp) ad dd space parens))
(else (display exp))))
(go exp 9 9 #f #t))
(using eval-pkg lazy-eval-pkg)
(define env (make-environment lazy-list-env))
(with-eval actual-value env
(define x (cons 1 (cons 2 (cons 3 '()))))
(define ones (cons 1 ones))
(define one-two (cons 1 (cons 2 one-two))))
(show (actual-value 'x env)) =$> "(1 2 3)"
(show (actual-value 'ones env)) =$> "(1 1 1 1 1 1 1 1 1 1 ...)"
(show (actual-value 'one-two env)) =$> "(1 2 1 2 1 2 1 2 1 2 ...)"