4.2.4 · Streams as lazy lists

A lazy evaluator can make an ordinary procedure behave like non-strict cons.

Define pairs, selectors, infinite lists, map, and take inside the guest language so delayed compound-procedure arguments supply the stream behavior.

Guiding question

What happens to list abstraction when the evaluator delays every compound-procedure operand automatically?

Define lazy-cons as an ordinary compound procedure in the guest language
Select a head without forcing the delayed tail parameter
Create a self-referential infinite ones binding
Generate an unbounded integer list recursively
Map a guest procedure over a lazy list without constructing its full tail
Use a strict finite consumer to demand an exact finite result list

lazy-cons is written as a procedure that returns a selector procedure. Under the lazy evaluator, its x and y parameters are thunks. lazy-car applies the pair to a selector that returns x, so y remains unforced. The global definition of ones can therefore refer to ones in its own delayed tail: the reference is not demanded until lazy-cdr reaches it after the binding exists.

integers-from and lazy-map use the same ordinary recursive syntax. Their recursive calls appear as delayed y operands to lazy-cons, so the infinite remainder is represented by memoized evaluator thunks. take is the demand boundary: primitive cons needs actual argument values, so it forces exactly the requested number of heads and tails into a finite host list. This example integrates lazy lists with the lesson evaluator and makes the consumer demand explicit.

SICP code7,774 of 1,048,576 UTF-8 bytes

(begin
  (define (tagged-list? expression tag)
    (and (pair? expression) (eq? (car expression) tag)))
  (define (self-evaluating? expression)
    (or (number? expression)
        (string? expression)
        (boolean? expression)))
  (define (quoted? expression) (tagged-list? expression 'quote))
  (define (if? expression) (tagged-list? expression 'if))
  (define (lambda? expression) (tagged-list? expression 'lambda))
  (define (begin? expression) (tagged-list? expression 'begin))
  (define (definition? expression) (tagged-list? expression 'define))

  (define (text-of-quotation expression) (cadr expression))
  (define (if-predicate expression) (cadr expression))
  (define (if-consequent expression) (caddr expression))
  (define (if-alternative expression) (cadddr expression))
  (define (lambda-parameters expression) (cadr expression))
  (define (lambda-body expression) (cddr expression))
  (define (begin-actions expression) (cdr expression))
  (define (definition-variable expression)
    (if (symbol? (cadr expression))
        (cadr expression)
        (car (cadr expression))))
  (define (definition-value expression)
    (if (symbol? (cadr expression))
        (caddr expression)
        (cons 'lambda
              (cons (cdr (cadr expression))
                    (cddr expression)))))
  (define (operator expression) (car expression))
  (define (operands expression) (cdr expression))

  (define (pair-bindings variables values)
    (cond ((and (null? variables) (null? values)) '())
          ((null? variables) (error "too many guest arguments"))
          ((null? values) (error "too few guest arguments"))
          (else
           (cons (cons (car variables) (car values))
                 (pair-bindings (cdr variables) (cdr values))))))
  (define (make-frame variables values)
    (cons '*frame* (pair-bindings variables values)))
  (define (first-frame environment) (car environment))
  (define (frame-bindings frame) (cdr frame))
  (define (extend-environment variables values base)
    (cons (make-frame variables values) base))
  (define (lookup-variable-value variable environment)
    (if (null? environment)
        (error "unbound lazy guest variable" variable)
        (let ((record
               (assoc variable
                      (frame-bindings (first-frame environment)))))
          (if record
              (cdr record)
              (lookup-variable-value variable (cdr environment))))))
  (define (define-variable! variable value environment)
    (let* ((frame (first-frame environment))
           (record (assoc variable (frame-bindings frame))))
      (if record
          (set-cdr! record value)
          (set-cdr! frame
                    (cons (cons variable value)
                          (frame-bindings frame)))))
    (list 'defined variable))

  (define (make-procedure parameters body environment)
    (list 'compound parameters body environment))
  (define (compound-procedure? procedure)
    (tagged-list? procedure 'compound))
  (define (procedure-parameters procedure) (cadr procedure))
  (define (procedure-body procedure) (caddr procedure))
  (define (procedure-environment procedure) (cadddr procedure))

  (define (delay-it expression environment)
    (list 'thunk expression environment))
  (define (thunk? object) (tagged-list? object 'thunk))
  (define (evaluated-thunk? object)
    (tagged-list? object 'evaluated-thunk))
  (define (force-it object)
    (cond ((thunk? object)
           (let ((result
                  (actual-value (cadr object) (caddr object))))
             (set-car! object 'evaluated-thunk)
             (set-car! (cdr object) result)
             (set-cdr! (cdr object) '())
             result))
          ((evaluated-thunk? object) (cadr object))
          (else object)))
  (define (actual-value expression environment)
    (force-it (lazy-eval expression environment)))

  (define (true? value) (not (eq? value #f)))
  (define (eval-if expression environment)
    (if (true? (actual-value (if-predicate expression) environment))
        (lazy-eval (if-consequent expression) environment)
        (lazy-eval (if-alternative expression) environment)))
  (define (eval-sequence expressions environment)
    (cond ((null? expressions) 'ok)
          ((null? (cdr expressions))
           (lazy-eval (car expressions) environment))
          (else
           (actual-value (car expressions) environment)
           (eval-sequence (cdr expressions) environment))))
  (define (eval-definition expression environment)
    (define-variable!
      (definition-variable expression)
      (actual-value (definition-value expression) environment)
      environment))

  (define (list-of-arg-values expressions environment)
    (if (null? expressions)
        '()
        (cons (actual-value (car expressions) environment)
              (list-of-arg-values (cdr expressions) environment))))
  (define (list-of-delayed-args expressions environment)
    (if (null? expressions)
        '()
        (cons (delay-it (car expressions) environment)
              (list-of-delayed-args (cdr expressions) environment))))
  (define (apply-lazy procedure argument-expressions calling-environment)
    (cond ((procedure? procedure)
           (apply procedure
                  (list-of-arg-values
                    argument-expressions
                    calling-environment)))
          ((compound-procedure? procedure)
           (eval-sequence
             (procedure-body procedure)
             (extend-environment
               (procedure-parameters procedure)
               (list-of-delayed-args
                 argument-expressions
                 calling-environment)
               (procedure-environment procedure))))
          (else
           (error "not a lazy guest procedure" procedure))))

  (define (lazy-eval expression environment)
    (cond ((self-evaluating? expression) expression)
          ((symbol? expression)
           (lookup-variable-value expression environment))
          ((quoted? expression)
           (text-of-quotation expression))
          ((if? expression)
           (eval-if expression environment))
          ((lambda? expression)
           (make-procedure
             (lambda-parameters expression)
             (lambda-body expression)
             environment))
          ((begin? expression)
           (eval-sequence (begin-actions expression) environment))
          ((definition? expression)
           (eval-definition expression environment))
          ((pair? expression)
           (apply-lazy
             (actual-value (operator expression) environment)
             (operands expression)
             environment))
          (else
           (error "unknown lazy guest expression" expression))))

  (define probes 0)
  (define (probe value)
    (set! probes (+ probes 1))
    value)
  (define primitive-bindings
    (list (cons '+ +) (cons '- -) (cons '* *) (cons '/ /)
          (cons '= =) (cons '< <) (cons '> >)
          (cons 'list list) (cons 'cons cons)
          (cons 'car car) (cons 'cdr cdr)
          (cons 'null? null?) (cons 'pair? pair?)
          (cons 'probe probe)))
  (define global-environment
    (list (cons '*frame* primitive-bindings)))
  (define guest-program
    '(begin
       (define (lazy-cons x y)
         (lambda (selector) (selector x y)))
       (define (lazy-car pair)
         (pair (lambda (x y) x)))
       (define (lazy-cdr pair)
         (pair (lambda (x y) y)))
       (define ones (lazy-cons 1 ones))
       (define (take stream count)
         (if (= count 0)
             (quote ())
             (cons (lazy-car stream)
                   (take (lazy-cdr stream)
                         (- count 1)))))
       (take ones 5)))
  (actual-value guest-program global-environment)
)

(begin
  (define (tagged-list? expression tag)
    (and (pair? expression) (eq? (car expression) tag)))
  (define (self-evaluating? expression)
    (or (number? expression)
        (string? expression)
        (boolean? expression)))
  (define (quoted? expression) (tagged-list? expression 'quote))
  (define (if? expression) (tagged-list? expression 'if))
  (define (lambda? expression) (tagged-list? expression 'lambda))
  (define (begin? expression) (tagged-list? expression 'begin))
  (define (definition? expression) (tagged-list? expression 'define))

(define (text-of-quotation expression) (cadr expression))
  (define (if-predicate expression) (cadr expression))
  (define (if-consequent expression) (caddr expression))
  (define (if-alternative expression) (cadddr expression))
  (define (lambda-parameters expression) (cadr expression))
  (define (lambda-body expression) (cddr expression))
  (define (begin-actions expression) (cdr expression))
  (define (definition-variable expression)
    (if (symbol? (cadr expression))
        (cadr expression)
        (car (cadr expression))))
  (define (definition-value expression)
    (if (symbol? (cadr expression))
        (caddr expression)
        (cons 'lambda
              (cons (cdr (cadr expression))
                    (cddr expression)))))
  (define (operator expression) (car expression))
  (define (operands expression) (cdr expression))

(define (pair-bindings variables values)
    (cond ((and (null? variables) (null? values)) '())
          ((null? variables) (error "too many guest arguments"))
          ((null? values) (error "too few guest arguments"))
          (else
           (cons (cons (car variables) (car values))
                 (pair-bindings (cdr variables) (cdr values))))))
  (define (make-frame variables values)
    (cons '*frame* (pair-bindings variables values)))
  (define (first-frame environment) (car environment))
  (define (frame-bindings frame) (cdr frame))
  (define (extend-environment variables values base)
    (cons (make-frame variables values) base))
  (define (lookup-variable-value variable environment)
    (if (null? environment)
        (error "unbound lazy guest variable" variable)
        (let ((record
               (assoc variable
                      (frame-bindings (first-frame environment)))))
          (if record
              (cdr record)
              (lookup-variable-value variable (cdr environment))))))
  (define (define-variable! variable value environment)
    (let* ((frame (first-frame environment))
           (record (assoc variable (frame-bindings frame))))
      (if record
          (set-cdr! record value)
          (set-cdr! frame
                    (cons (cons variable value)
                          (frame-bindings frame)))))
    (list 'defined variable))

(define (make-procedure parameters body environment)
    (list 'compound parameters body environment))
  (define (compound-procedure? procedure)
    (tagged-list? procedure 'compound))
  (define (procedure-parameters procedure) (cadr procedure))
  (define (procedure-body procedure) (caddr procedure))
  (define (procedure-environment procedure) (cadddr procedure))

(define (delay-it expression environment)
    (list 'thunk expression environment))
  (define (thunk? object) (tagged-list? object 'thunk))
  (define (evaluated-thunk? object)
    (tagged-list? object 'evaluated-thunk))
  (define (force-it object)
    (cond ((thunk? object)
           (let ((result
                  (actual-value (cadr object) (caddr object))))
             (set-car! object 'evaluated-thunk)
             (set-car! (cdr object) result)
             (set-cdr! (cdr object) '())
             result))
          ((evaluated-thunk? object) (cadr object))
          (else object)))
  (define (actual-value expression environment)
    (force-it (lazy-eval expression environment)))

(define (true? value) (not (eq? value #f)))
  (define (eval-if expression environment)
    (if (true? (actual-value (if-predicate expression) environment))
        (lazy-eval (if-consequent expression) environment)
        (lazy-eval (if-alternative expression) environment)))
  (define (eval-sequence expressions environment)
    (cond ((null? expressions) 'ok)
          ((null? (cdr expressions))
           (lazy-eval (car expressions) environment))
          (else
           (actual-value (car expressions) environment)
           (eval-sequence (cdr expressions) environment))))
  (define (eval-definition expression environment)
    (define-variable!
      (definition-variable expression)
      (actual-value (definition-value expression) environment)
      environment))

(define (list-of-arg-values expressions environment)
    (if (null? expressions)
        '()
        (cons (actual-value (car expressions) environment)
              (list-of-arg-values (cdr expressions) environment))))
  (define (list-of-delayed-args expressions environment)
    (if (null? expressions)
        '()
        (cons (delay-it (car expressions) environment)
              (list-of-delayed-args (cdr expressions) environment))))
  (define (apply-lazy procedure argument-expressions calling-environment)
    (cond ((procedure? procedure)
           (apply procedure
                  (list-of-arg-values
                    argument-expressions
                    calling-environment)))
          ((compound-procedure? procedure)
           (eval-sequence
             (procedure-body procedure)
             (extend-environment
               (procedure-parameters procedure)
               (list-of-delayed-args
                 argument-expressions
                 calling-environment)
               (procedure-environment procedure))))
          (else
           (error "not a lazy guest procedure" procedure))))

(define (lazy-eval expression environment)
    (cond ((self-evaluating? expression) expression)
          ((symbol? expression)
           (lookup-variable-value expression environment))
          ((quoted? expression)
           (text-of-quotation expression))
          ((if? expression)
           (eval-if expression environment))
          ((lambda? expression)
           (make-procedure
             (lambda-parameters expression)
             (lambda-body expression)
             environment))
          ((begin? expression)
           (eval-sequence (begin-actions expression) environment))
          ((definition? expression)
           (eval-definition expression environment))
          ((pair? expression)
           (apply-lazy
             (actual-value (operator expression) environment)
             (operands expression)
             environment))
          (else
           (error "unknown lazy guest expression" expression))))

(define probes 0)
  (define (probe value)
    (set! probes (+ probes 1))
    value)
  (define primitive-bindings
    (list (cons '+ +) (cons '- -) (cons '* *) (cons '/ /)
          (cons '= =) (cons '< <) (cons '> >)
          (cons 'list list) (cons 'cons cons)
          (cons 'car car) (cons 'cdr cdr)
          (cons 'null? null?) (cons 'pair? pair?)
          (cons 'probe probe)))
  (define global-environment
    (list (cons '*frame* primitive-bindings)))
  (define guest-program
    '(begin
       (define (lazy-cons x y)
         (lambda (selector) (selector x y)))
       (define (lazy-car pair)
         (pair (lambda (x y) x)))
       (define (lazy-cdr pair)
         (pair (lambda (x y) y)))
       (define ones (lazy-cons 1 ones))
       (define (take stream count)
         (if (= count 0)
             (quote ())
             (cons (lazy-car stream)
                   (take (lazy-cdr stream)
                         (- count 1)))))
       (take ones 5)))
  (actual-value guest-program global-environment)
)

Examples

Result—

Output: —
Value: —
Diagnostic: —

Execution trace0 / 0 events

Expected result

The self-referential list returns (1 1 1 1 1). The mapped integer list returns (1 4 9 16 25 36).

Trace focus

Find each lazy-cons application and inspect the delayed y operand. In the ones run, confirm that the self-reference is first forced only through lazy-cdr after define has installed the binding. In the mapped run, count how many integers-from and square applications are demanded by take rather than imagining a completed infinite list.

Try it yourself

Change the program and compare the result.

Define lazy-filter and take the first five even integers. Then request the same prefix twice and inspect which evaluator thunks are reused after memoization.

Show hint

When a value fails the predicate, continue with the delayed tail. When it passes, construct one lazy-cons whose recursive filter call remains the delayed second argument.

Complete this lesson

0 of 23 lessons complete in this chapter0%