4.2.2 · An interpreter with lazy evaluation

A memoized thunk performs demanded work at most once.

Delay compound-procedure operands, force primitive operands and predicates, and rewrite a thunk into an evaluated-thunk after its first actual-value request.

Guiding question

How can an evaluator postpone argument work while preventing repeated references from recomputing the same expression?

Delay operand expressions together with their calling environments
Force an operator before deciding how to apply it
Force every primitive argument and if predicate to an actual value
Pass delayed arguments to compound procedures
Memoize a thunk by changing its tag and stored payload
Observe unused, repeated, and unselected expressions separately

apply-lazy distinguishes host primitives from represented compound procedures. A primitive needs actual argument values, so its operands are forced before host apply. A compound procedure instead receives thunk records containing the original operand expressions and calling environment. Variable lookup returns that record, and actual-value decides whether it must be forced.

force-it evaluates a fresh thunk once, rewrites the same mutable record to evaluated-thunk, stores the result, and discards the saved expression and environment. The unused argument therefore performs no probe. The duplicated x expression is demanded twice but probes once. The false branch of the selected if is never evaluated. This evaluator implements call by need for the listed forms under an explicit work budget.

SICP code7,892 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 unused
    '((lambda (x) 1) (probe 10)))
  (define duplicated
    '((lambda (x) (+ x x)) (probe 10)))
  (define selected-branch
    '(if #t (quote safe) (probe 99)))
  (set! probes 0)
  (define unused-value
    (actual-value unused global-environment))
  (define unused-probes probes)
  (set! probes 0)
  (define duplicated-value
    (actual-value duplicated global-environment))
  (define duplicated-probes probes)
  (set! probes 0)
  (define branch-value
    (actual-value selected-branch global-environment))
  (list (list 'unused unused-value unused-probes)
        (list 'duplicated duplicated-value duplicated-probes)
        (list 'branch branch-value probes))
)

(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 unused
    '((lambda (x) 1) (probe 10)))
  (define duplicated
    '((lambda (x) (+ x x)) (probe 10)))
  (define selected-branch
    '(if #t (quote safe) (probe 99)))
  (set! probes 0)
  (define unused-value
    (actual-value unused global-environment))
  (define unused-probes probes)
  (set! probes 0)
  (define duplicated-value
    (actual-value duplicated global-environment))
  (define duplicated-probes probes)
  (set! probes 0)
  (define branch-value
    (actual-value selected-branch global-environment))
  (list (list 'unused unused-value unused-probes)
        (list 'duplicated duplicated-value duplicated-probes)
        (list 'branch branch-value probes))
)

Examples

Result—

Output: —
Value: —
Diagnostic: —

Execution trace0 / 0 events

Expected result

The evaluator returns ((unused 1 0) (duplicated 20 1) (branch safe 0)).

Trace focus

Follow compound application into list-of-delayed-args, then find the first lookup that sends a thunk to force-it. Verify the record mutation to evaluated-thunk and the second lookup returning the cached value. In the if expression, confirm that only the predicate and selected consequent are evaluated.

Try it yourself

Change the program and compare the result.

Add ((lambda (x) (+ x (+ x x))) (probe 4)) and predict the value and probe count. Then remove the thunk mutation in force-it and compare the result.

Show hint

With memoization the argument probes once no matter how many x lookups occur. Without mutation, every lookup re-evaluates the saved expression.

Complete this lesson

0 of 23 lessons complete in this chapter0%