5.5.2 · Compiling expressions

Source forms become instruction tags before execution begins.

Compile values, variables, quotation, assignment, conditionals, lambdas, and applications into an instruction language, then execute the result.

Guiding question

What source-language decisions disappear from the execution loop after compilation?

Compile every core expression category to explicit instruction data
Preserve left-to-right operator and operand order in calls
Represent compiled closures with parameters, code, and lexical environment
Mutate definitions and assignments through explicit environment operations
Select one compiled branch without revisiting source syntax
Execute compiled code with a separate stack machine

compile-expression performs every source classification. The result contains only literal, load, closure, define, set, discard, branch, and call instructions. A lambda stores already compiled body code with its parameters. A begin inserts discard between nonfinal forms, and an application places operator code before operand code before one call instruction.

run-code dispatches on compiled instruction tags after compile-expression has classified the source forms. A compiled procedure extends the lexical environment captured at closure construction and runs its body code on a fresh operand stack. This lesson VM executes global definition, captured local assignment, quotation, branching, closures, and primitive application through the listed instruction set.

SICP code10,895 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 (assignment? expression) (tagged-list? expression 'set!))
  (define (definition? expression) (tagged-list? expression 'define))
  (define (if? expression) (tagged-list? expression 'if))
  (define (lambda? expression) (tagged-list? expression 'lambda))
  (define (begin? expression) (tagged-list? expression 'begin))

  (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 (compile-sequence expressions)
    (cond ((null? expressions)
           '((literal ok)))
          ((null? (cdr expressions))
           (compile-expression (car expressions)))
          (else
           (append
             (compile-expression (car expressions))
             (cons '(discard)
                   (compile-sequence (cdr expressions)))))))
  (define (compile-operands operands)
    (if (null? operands)
        '()
        (append
          (compile-expression (car operands))
          (compile-operands (cdr operands)))))
  (define (compile-expression expression)
    (cond
      ((self-evaluating? expression)
       (list (list 'literal expression)))
      ((symbol? expression)
       (list (list 'load expression)))
      ((quoted? expression)
       (list (list 'literal (cadr expression))))
      ((assignment? expression)
       (append
         (compile-expression (caddr expression))
         (list (list 'set (cadr expression)))))
      ((definition? expression)
       (append
         (compile-expression (definition-value expression))
         (list (list 'define
                     (definition-variable expression)))))
      ((if? expression)
       (append
         (compile-expression (cadr expression))
         (list
           (list 'branch
                 (compile-expression (caddr expression))
                 (compile-expression (cadddr expression))))))
      ((lambda? expression)
       (list
         (list 'closure
               (cadr expression)
               (compile-sequence (cddr expression)))))
      ((begin? expression)
       (compile-sequence (cdr expression)))
      ((pair? expression)
       (append
         (compile-expression (car expression))
         (append
           (compile-operands (cdr expression))
           (list (list 'call (length (cdr expression)))))))
      (else
       (error "unknown expression for compiler" expression))))

  (define (pair-bindings variables values)
    (cond ((and (null? variables) (null? values)) '())
          ((null? variables) (error "too many arguments"))
          ((null? values) (error "too few 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 (frame-bindings frame) (cdr frame))
  (define (extend-environment variables values environment)
    (cons (make-frame variables values) environment))
  (define (lookup-variable-value variable environment)
    (if (null? environment)
        (error "unbound compiled variable" variable)
        (let ((binding
               (assoc variable
                      (frame-bindings (car environment)))))
          (if binding
              (cdr binding)
              (lookup-variable-value variable
                                     (cdr environment))))))
  (define (define-variable! variable value environment)
    (let* ((frame (car environment))
           (binding (assoc variable (frame-bindings frame))))
      (if binding
          (set-cdr! binding value)
          (set-cdr! frame
                    (cons (cons variable value)
                          (frame-bindings frame)))))
    (list 'defined variable))
  (define (set-variable-value! variable value environment)
    (if (null? environment)
        (error "unbound compiled assignment" variable)
        (let ((binding
               (assoc variable
                      (frame-bindings (car environment)))))
          (if binding
              (begin
                (set-cdr! binding value)
                (list 'assigned variable))
              (set-variable-value! variable
                                   value
                                   (cdr environment))))))

  (define (make-primitive implementation)
    (list 'primitive implementation))
  (define (primitive? procedure)
    (tagged-list? procedure 'primitive))
  (define (primitive-implementation procedure) (cadr procedure))
  (define (make-compiled-procedure parameters code environment)
    (list 'compiled parameters code environment))
  (define (compiled-procedure? procedure)
    (tagged-list? procedure 'compiled))
  (define (compiled-parameters procedure) (cadr procedure))
  (define (compiled-code procedure) (caddr procedure))
  (define (compiled-environment procedure) (cadddr procedure))

  (define (split-call stack count)
    (define (loop remaining-stack remaining-count arguments)
      (if (= remaining-count 0)
          (list (car remaining-stack)
                arguments
                (cdr remaining-stack))
          (loop (cdr remaining-stack)
                (- remaining-count 1)
                (cons (car remaining-stack) arguments))))
    (loop stack count '()))

  (define (run-code code stack environment)
    (if (null? code)
        (list stack environment)
        (let* ((instruction (car code))
               (tag (car instruction)))
          (cond
            ((eq? tag 'literal)
             (run-code (cdr code)
                       (cons (cadr instruction) stack)
                       environment))
            ((eq? tag 'load)
             (run-code
               (cdr code)
               (cons
                 (lookup-variable-value
                   (cadr instruction)
                   environment)
                 stack)
               environment))
            ((eq? tag 'closure)
             (run-code
               (cdr code)
               (cons
                 (make-compiled-procedure
                   (cadr instruction)
                   (caddr instruction)
                   environment)
                 stack)
               environment))
            ((eq? tag 'define)
             (let ((result
                    (define-variable!
                      (cadr instruction)
                      (car stack)
                      environment)))
               (run-code (cdr code)
                         (cons result (cdr stack))
                         environment)))
            ((eq? tag 'set)
             (let ((result
                    (set-variable-value!
                      (cadr instruction)
                      (car stack)
                      environment)))
               (run-code (cdr code)
                         (cons result (cdr stack))
                         environment)))
            ((eq? tag 'discard)
             (run-code (cdr code)
                       (cdr stack)
                       environment))
            ((eq? tag 'branch)
             (let* ((selected
                      (if (car stack)
                          (cadr instruction)
                          (caddr instruction)))
                    (branch-state
                      (run-code selected
                                (cdr stack)
                                environment)))
               (run-code (cdr code)
                         (car branch-state)
                         (cadr branch-state))))
            ((eq? tag 'call)
             (let* ((parts
                      (split-call stack (cadr instruction)))
                    (procedure (car parts))
                    (arguments (cadr parts))
                    (caller-stack (caddr parts)))
               (if (primitive? procedure)
                   (run-code
                     (cdr code)
                     (cons
                       (apply
                         (primitive-implementation procedure)
                         arguments)
                       caller-stack)
                     environment)
                   (if (compiled-procedure? procedure)
                       (let* ((call-environment
                                (extend-environment
                                  (compiled-parameters procedure)
                                  arguments
                                  (compiled-environment procedure)))
                              (call-state
                                (run-code
                                  (compiled-code procedure)
                                  '()
                                  call-environment))
                              (value (car (car call-state))))
                         (run-code (cdr code)
                                   (cons value caller-stack)
                                   environment))
                       (error "not a compiled procedure"
                              procedure)))))
            (else
             (error "unknown compiled instruction"
                    instruction))))))

  (define (make-global-environment)
    (list
      (cons '*frame*
        (list
          (cons '+ (make-primitive +))
          (cons '- (make-primitive -))
          (cons '* (make-primitive *))
          (cons '/ (make-primitive /))
          (cons '= (make-primitive =))
          (cons '< (make-primitive <))
          (cons '> (make-primitive >))
          (cons 'list (make-primitive list))
          (cons 'cons (make-primitive cons))
          (cons 'car (make-primitive car))
          (cons 'cdr (make-primitive cdr))
          (cons 'null? (make-primitive null?))))))
  (define (compile-and-run expression)
    (let* ((code (compile-expression expression))
           (environment (make-global-environment))
           (state (run-code code '() environment)))
      (list (car (car state))
            code
            environment)))
  (define program
    '(begin
       (define base 10)
       (define (make-adder x)
         (lambda (y) (+ x y)))
       (define add-three (make-adder 3))
       (set! base (+ base 5))
       (if (> base 12)
           (list (add-three base) (quote large) base)
           (list 0 (quote small) base))))
  (define result (compile-and-run program))
  (list (car result)
        (map car (cadr result))
        (length (cadr result)))
)

(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 (assignment? expression) (tagged-list? expression 'set!))
  (define (definition? expression) (tagged-list? expression 'define))
  (define (if? expression) (tagged-list? expression 'if))
  (define (lambda? expression) (tagged-list? expression 'lambda))
  (define (begin? expression) (tagged-list? expression 'begin))

(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 (compile-sequence expressions)
    (cond ((null? expressions)
           '((literal ok)))
          ((null? (cdr expressions))
           (compile-expression (car expressions)))
          (else
           (append
             (compile-expression (car expressions))
             (cons '(discard)
                   (compile-sequence (cdr expressions)))))))
  (define (compile-operands operands)
    (if (null? operands)
        '()
        (append
          (compile-expression (car operands))
          (compile-operands (cdr operands)))))
  (define (compile-expression expression)
    (cond
      ((self-evaluating? expression)
       (list (list 'literal expression)))
      ((symbol? expression)
       (list (list 'load expression)))
      ((quoted? expression)
       (list (list 'literal (cadr expression))))
      ((assignment? expression)
       (append
         (compile-expression (caddr expression))
         (list (list 'set (cadr expression)))))
      ((definition? expression)
       (append
         (compile-expression (definition-value expression))
         (list (list 'define
                     (definition-variable expression)))))
      ((if? expression)
       (append
         (compile-expression (cadr expression))
         (list
           (list 'branch
                 (compile-expression (caddr expression))
                 (compile-expression (cadddr expression))))))
      ((lambda? expression)
       (list
         (list 'closure
               (cadr expression)
               (compile-sequence (cddr expression)))))
      ((begin? expression)
       (compile-sequence (cdr expression)))
      ((pair? expression)
       (append
         (compile-expression (car expression))
         (append
           (compile-operands (cdr expression))
           (list (list 'call (length (cdr expression)))))))
      (else
       (error "unknown expression for compiler" expression))))

(define (pair-bindings variables values)
    (cond ((and (null? variables) (null? values)) '())
          ((null? variables) (error "too many arguments"))
          ((null? values) (error "too few 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 (frame-bindings frame) (cdr frame))
  (define (extend-environment variables values environment)
    (cons (make-frame variables values) environment))
  (define (lookup-variable-value variable environment)
    (if (null? environment)
        (error "unbound compiled variable" variable)
        (let ((binding
               (assoc variable
                      (frame-bindings (car environment)))))
          (if binding
              (cdr binding)
              (lookup-variable-value variable
                                     (cdr environment))))))
  (define (define-variable! variable value environment)
    (let* ((frame (car environment))
           (binding (assoc variable (frame-bindings frame))))
      (if binding
          (set-cdr! binding value)
          (set-cdr! frame
                    (cons (cons variable value)
                          (frame-bindings frame)))))
    (list 'defined variable))
  (define (set-variable-value! variable value environment)
    (if (null? environment)
        (error "unbound compiled assignment" variable)
        (let ((binding
               (assoc variable
                      (frame-bindings (car environment)))))
          (if binding
              (begin
                (set-cdr! binding value)
                (list 'assigned variable))
              (set-variable-value! variable
                                   value
                                   (cdr environment))))))

(define (make-primitive implementation)
    (list 'primitive implementation))
  (define (primitive? procedure)
    (tagged-list? procedure 'primitive))
  (define (primitive-implementation procedure) (cadr procedure))
  (define (make-compiled-procedure parameters code environment)
    (list 'compiled parameters code environment))
  (define (compiled-procedure? procedure)
    (tagged-list? procedure 'compiled))
  (define (compiled-parameters procedure) (cadr procedure))
  (define (compiled-code procedure) (caddr procedure))
  (define (compiled-environment procedure) (cadddr procedure))

(define (split-call stack count)
    (define (loop remaining-stack remaining-count arguments)
      (if (= remaining-count 0)
          (list (car remaining-stack)
                arguments
                (cdr remaining-stack))
          (loop (cdr remaining-stack)
                (- remaining-count 1)
                (cons (car remaining-stack) arguments))))
    (loop stack count '()))

(define (run-code code stack environment)
    (if (null? code)
        (list stack environment)
        (let* ((instruction (car code))
               (tag (car instruction)))
          (cond
            ((eq? tag 'literal)
             (run-code (cdr code)
                       (cons (cadr instruction) stack)
                       environment))
            ((eq? tag 'load)
             (run-code
               (cdr code)
               (cons
                 (lookup-variable-value
                   (cadr instruction)
                   environment)
                 stack)
               environment))
            ((eq? tag 'closure)
             (run-code
               (cdr code)
               (cons
                 (make-compiled-procedure
                   (cadr instruction)
                   (caddr instruction)
                   environment)
                 stack)
               environment))
            ((eq? tag 'define)
             (let ((result
                    (define-variable!
                      (cadr instruction)
                      (car stack)
                      environment)))
               (run-code (cdr code)
                         (cons result (cdr stack))
                         environment)))
            ((eq? tag 'set)
             (let ((result
                    (set-variable-value!
                      (cadr instruction)
                      (car stack)
                      environment)))
               (run-code (cdr code)
                         (cons result (cdr stack))
                         environment)))
            ((eq? tag 'discard)
             (run-code (cdr code)
                       (cdr stack)
                       environment))
            ((eq? tag 'branch)
             (let* ((selected
                      (if (car stack)
                          (cadr instruction)
                          (caddr instruction)))
                    (branch-state
                      (run-code selected
                                (cdr stack)
                                environment)))
               (run-code (cdr code)
                         (car branch-state)
                         (cadr branch-state))))
            ((eq? tag 'call)
             (let* ((parts
                      (split-call stack (cadr instruction)))
                    (procedure (car parts))
                    (arguments (cadr parts))
                    (caller-stack (caddr parts)))
               (if (primitive? procedure)
                   (run-code
                     (cdr code)
                     (cons
                       (apply
                         (primitive-implementation procedure)
                         arguments)
                       caller-stack)
                     environment)
                   (if (compiled-procedure? procedure)
                       (let* ((call-environment
                                (extend-environment
                                  (compiled-parameters procedure)
                                  arguments
                                  (compiled-environment procedure)))
                              (call-state
                                (run-code
                                  (compiled-code procedure)
                                  '()
                                  call-environment))
                              (value (car (car call-state))))
                         (run-code (cdr code)
                                   (cons value caller-stack)
                                   environment))
                       (error "not a compiled procedure"
                              procedure)))))
            (else
             (error "unknown compiled instruction"
                    instruction))))))

(define (make-global-environment)
    (list
      (cons '*frame*
        (list
          (cons '+ (make-primitive +))
          (cons '- (make-primitive -))
          (cons '* (make-primitive *))
          (cons '/ (make-primitive /))
          (cons '= (make-primitive =))
          (cons '< (make-primitive <))
          (cons '> (make-primitive >))
          (cons 'list (make-primitive list))
          (cons 'cons (make-primitive cons))
          (cons 'car (make-primitive car))
          (cons 'cdr (make-primitive cdr))
          (cons 'null? (make-primitive null?))))))
  (define (compile-and-run expression)
    (let* ((code (compile-expression expression))
           (environment (make-global-environment))
           (state (run-code code '() environment)))
      (list (car (car state))
            code
            environment)))
  (define program
    '(begin
       (define base 10)
       (define (make-adder x)
         (lambda (y) (+ x y)))
       (define add-three (make-adder 3))
       (set! base (+ base 5))
       (if (> base 12)
           (list (add-three base) (quote large) base)
           (list 0 (quote small) base))))
  (define result (compile-and-run program))
  (list (car result)
        (map car (cadr result))
        (length (cadr result)))
)

Examples

Result—

Output: —
Value: —
Diagnostic: —

Execution trace0 / 0 events

Expected result

The first compiled program returns ((18 large 15) (literal define discard closure define discard load literal call define discard load load literal call set discard load load literal call branch) 22). The stateful closure returns ((12 15 5 ok) (literal define discard closure define discard load literal call define discard load load literal call load literal call load literal call) 21).

Trace focus

First inspect the code tags and confirm that no source-form tags remain. During execution, follow closure creation before make-adder or make-counter is called, the fresh call frame for each compiled application, the captured start record changing across counter calls, and the branch selecting exactly one nested code list.

Try it yourself

Change the program and compare the result.

Add a recursive compiled procedure or a second nested closure. Predict the top-level code tags, then identify which procedure environment each load and set instruction must search.

Show hint

Definition installs the compiled closure in the shared global frame after the closure has captured that frame object, so later recursive lookup can find the installed name.

Complete this lesson

0 of 23 lessons complete in this chapter0%