5.5.1 · Structure of the compiler

Dispatch by syntax, honor target and linkage, compose instruction contracts.

Build one compiler dispatcher whose specialized procedures emit instruction-sequence records with explicit needs, modifications, statements, and targets.

Guiding question

Which compiler decisions depend on source syntax, and which depend on the requested target register and linkage?

Classify every supported source form before compilation
Pass a target register and linkage through specialized compilers
Represent instruction sequences with needs, modifies, and statements
Compose sequences while retaining conservative register contracts
Generate labels for conditional control
Compile a lambda body into stored procedure code rather than leaving raw body source

compile owns only syntax dispatch. Specialized compilers decide how a self-evaluating value, variable, quotation, conditional, lambda, sequence, or application reaches a target. end-with-linkage then adds no control transfer, a return through continue, or a direct label goto. This keeps expression meaning separate from where its value must land and what should happen next.

Instruction sequences carry statements plus conservative needs and modifies sets. append-sequences combines those contracts while preserving order. The conditional example shows labels and linkage around recursively compiled predicate and branches. The lambda compiler recursively compiles its body and stores the resulting instruction data in a represented compiled procedure. This educational instruction set models the displayed SICP compiler structure with a generic apply-procedure operation.

SICP code7,888 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 (expression-class expression)
    (cond ((self-evaluating? expression) 'self)
          ((symbol? expression) 'variable)
          ((quoted? expression) 'quote)
          ((if? expression) 'if)
          ((lambda? expression) 'lambda)
          ((begin? expression) 'begin)
          ((pair? expression) 'application)
          (else 'unknown)))

  (define (contains? item items)
    (cond ((null? items) #f)
          ((eq? item (car items)) #t)
          (else (contains? item (cdr items)))))
  (define (adjoin item items)
    (if (contains? item items)
        items
        (append items (list item))))
  (define (union left right)
    (if (null? right)
        left
        (union (adjoin (car right) left)
               (cdr right))))
  (define (difference left right)
    (cond ((null? left) '())
          ((contains? (car left) right)
           (difference (cdr left) right))
          (else
           (cons (car left)
                 (difference (cdr left) right)))))

  (define (make-sequence needs modifies statements)
    (list needs modifies statements))
  (define (sequence-needs sequence) (car sequence))
  (define (sequence-modifies sequence) (cadr sequence))
  (define (sequence-statements sequence) (caddr sequence))
  (define empty-sequence (make-sequence '() '() '()))
  (define (append-sequences first second)
    (make-sequence
      (union (sequence-needs first)
             (difference (sequence-needs second)
                         (sequence-modifies first)))
      (union (sequence-modifies first)
             (sequence-modifies second))
      (append (sequence-statements first)
              (sequence-statements second))))

  (define label-counter 0)
  (define (new-label prefix)
    (set! label-counter (+ label-counter 1))
    (list prefix label-counter))
  (define (linkage-sequence linkage)
    (cond ((eq? linkage 'next) empty-sequence)
          ((eq? linkage 'return)
           (make-sequence
             '(continue)
             '()
             '((goto (reg continue)))))
          (else
           (make-sequence
             '()
             '()
             (list (list 'goto
                         (list 'label linkage)))))))
  (define (end-with-linkage sequence linkage)
    (append-sequences sequence
                      (linkage-sequence linkage)))

  (define (compile-self expression target linkage)
    (end-with-linkage
      (make-sequence
        '()
        (list target)
        (list (list 'assign target
                    (list 'const expression))))
      linkage))
  (define (compile-variable expression target linkage)
    (end-with-linkage
      (make-sequence
        '(env)
        (list target)
        (list
          (list 'assign target
                (list 'op
                      'lookup-variable-value
                      (list 'const expression)
                      '(reg env)))))
      linkage))
  (define (compile-quote expression target linkage)
    (compile-self (cadr expression) target linkage))

  (define (compile-operands operands)
    (define (loop remaining result)
      (if (null? remaining)
          result
          (loop
            (cdr remaining)
            (append-sequences
              result
              (append-sequences
                (compile (car remaining) 'val 'next)
                (make-sequence
                  '(argl val)
                  '(argl)
                  '((assign argl
                      (op append-argument
                          (reg argl)
                          (reg val))))))))))
    (loop operands
          (make-sequence
            '()
            '(argl)
            '((assign argl (const ()))))))

  (define (compile-application expression target linkage)
    (end-with-linkage
      (append-sequences
        (compile (car expression) 'proc 'next)
        (append-sequences
          (compile-operands (cdr expression))
          (make-sequence
            '(proc argl)
            (list target)
            (list
              (list 'assign target
                    '(op apply-procedure
                         (reg proc)
                         (reg argl)))))))
      linkage))

  (define (compile-if expression target linkage)
    (let ((alternative-label (new-label 'false-branch))
          (after-label (new-label 'after-if)))
      (end-with-linkage
        (make-sequence
          '(env continue)
          (union (list target) '(val proc argl continue))
          (append
            (sequence-statements
              (compile (cadr expression) 'val 'next))
            (append
              '((test (op false? (reg val))))
              (append
                (list (list 'branch
                            (list 'label alternative-label)))
                (append
                  (sequence-statements
                    (compile (caddr expression)
                             target
                             'next))
                  (append
                    (list
                      (list 'goto (list 'label after-label))
                      (list 'label alternative-label))
                    (append
                      (sequence-statements
                        (compile (cadddr expression)
                                 target
                                 'next))
                      (list (list 'label after-label)))))))))
        linkage)))

  (define (compile-sequence expressions target linkage)
    (cond ((null? expressions) empty-sequence)
          ((null? (cdr expressions))
           (compile (car expressions) target linkage))
          (else
           (append-sequences
             (compile (car expressions) 'val 'next)
             (compile-sequence
               (cdr expressions)
               target
               linkage)))))

  (define (compile-lambda expression target linkage)
    (let ((parameters (cadr expression))
          (body-code
            (compile-sequence (cddr expression)
                              'val
                              'return)))
      (end-with-linkage
        (make-sequence
          '(env)
          (list target)
          (list
            (list 'assign target
                  (list 'op
                        'make-compiled-procedure
                        (list 'const parameters)
                        (list 'const
                              (sequence-statements body-code))
                        '(reg env)))))
        linkage)))

  (define (compile expression target linkage)
    (cond ((self-evaluating? expression)
           (compile-self expression target linkage))
          ((symbol? expression)
           (compile-variable expression target linkage))
          ((quoted? expression)
           (compile-quote expression target linkage))
          ((if? expression)
           (compile-if expression target linkage))
          ((lambda? expression)
           (compile-lambda expression target linkage))
          ((begin? expression)
           (compile-sequence (cdr expression)
                             target
                             linkage))
          ((pair? expression)
           (compile-application expression target linkage))
          (else
           (error "unknown compiler expression" expression))))
  (map expression-class
       '(42
         x
         (quote ok)
         (if x 1 2)
         (lambda (x) (+ x 1))
         (begin 1 2)
         (+ 1 2)))
)

(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 (expression-class expression)
    (cond ((self-evaluating? expression) 'self)
          ((symbol? expression) 'variable)
          ((quoted? expression) 'quote)
          ((if? expression) 'if)
          ((lambda? expression) 'lambda)
          ((begin? expression) 'begin)
          ((pair? expression) 'application)
          (else 'unknown)))

(define (contains? item items)
    (cond ((null? items) #f)
          ((eq? item (car items)) #t)
          (else (contains? item (cdr items)))))
  (define (adjoin item items)
    (if (contains? item items)
        items
        (append items (list item))))
  (define (union left right)
    (if (null? right)
        left
        (union (adjoin (car right) left)
               (cdr right))))
  (define (difference left right)
    (cond ((null? left) '())
          ((contains? (car left) right)
           (difference (cdr left) right))
          (else
           (cons (car left)
                 (difference (cdr left) right)))))

(define (make-sequence needs modifies statements)
    (list needs modifies statements))
  (define (sequence-needs sequence) (car sequence))
  (define (sequence-modifies sequence) (cadr sequence))
  (define (sequence-statements sequence) (caddr sequence))
  (define empty-sequence (make-sequence '() '() '()))
  (define (append-sequences first second)
    (make-sequence
      (union (sequence-needs first)
             (difference (sequence-needs second)
                         (sequence-modifies first)))
      (union (sequence-modifies first)
             (sequence-modifies second))
      (append (sequence-statements first)
              (sequence-statements second))))

(define label-counter 0)
  (define (new-label prefix)
    (set! label-counter (+ label-counter 1))
    (list prefix label-counter))
  (define (linkage-sequence linkage)
    (cond ((eq? linkage 'next) empty-sequence)
          ((eq? linkage 'return)
           (make-sequence
             '(continue)
             '()
             '((goto (reg continue)))))
          (else
           (make-sequence
             '()
             '()
             (list (list 'goto
                         (list 'label linkage)))))))
  (define (end-with-linkage sequence linkage)
    (append-sequences sequence
                      (linkage-sequence linkage)))

(define (compile-self expression target linkage)
    (end-with-linkage
      (make-sequence
        '()
        (list target)
        (list (list 'assign target
                    (list 'const expression))))
      linkage))
  (define (compile-variable expression target linkage)
    (end-with-linkage
      (make-sequence
        '(env)
        (list target)
        (list
          (list 'assign target
                (list 'op
                      'lookup-variable-value
                      (list 'const expression)
                      '(reg env)))))
      linkage))
  (define (compile-quote expression target linkage)
    (compile-self (cadr expression) target linkage))

(define (compile-operands operands)
    (define (loop remaining result)
      (if (null? remaining)
          result
          (loop
            (cdr remaining)
            (append-sequences
              result
              (append-sequences
                (compile (car remaining) 'val 'next)
                (make-sequence
                  '(argl val)
                  '(argl)
                  '((assign argl
                      (op append-argument
                          (reg argl)
                          (reg val))))))))))
    (loop operands
          (make-sequence
            '()
            '(argl)
            '((assign argl (const ()))))))

(define (compile-application expression target linkage)
    (end-with-linkage
      (append-sequences
        (compile (car expression) 'proc 'next)
        (append-sequences
          (compile-operands (cdr expression))
          (make-sequence
            '(proc argl)
            (list target)
            (list
              (list 'assign target
                    '(op apply-procedure
                         (reg proc)
                         (reg argl)))))))
      linkage))

(define (compile-if expression target linkage)
    (let ((alternative-label (new-label 'false-branch))
          (after-label (new-label 'after-if)))
      (end-with-linkage
        (make-sequence
          '(env continue)
          (union (list target) '(val proc argl continue))
          (append
            (sequence-statements
              (compile (cadr expression) 'val 'next))
            (append
              '((test (op false? (reg val))))
              (append
                (list (list 'branch
                            (list 'label alternative-label)))
                (append
                  (sequence-statements
                    (compile (caddr expression)
                             target
                             'next))
                  (append
                    (list
                      (list 'goto (list 'label after-label))
                      (list 'label alternative-label))
                    (append
                      (sequence-statements
                        (compile (cadddr expression)
                                 target
                                 'next))
                      (list (list 'label after-label)))))))))
        linkage)))

(define (compile-sequence expressions target linkage)
    (cond ((null? expressions) empty-sequence)
          ((null? (cdr expressions))
           (compile (car expressions) target linkage))
          (else
           (append-sequences
             (compile (car expressions) 'val 'next)
             (compile-sequence
               (cdr expressions)
               target
               linkage)))))

(define (compile-lambda expression target linkage)
    (let ((parameters (cadr expression))
          (body-code
            (compile-sequence (cddr expression)
                              'val
                              'return)))
      (end-with-linkage
        (make-sequence
          '(env)
          (list target)
          (list
            (list 'assign target
                  (list 'op
                        'make-compiled-procedure
                        (list 'const parameters)
                        (list 'const
                              (sequence-statements body-code))
                        '(reg env)))))
        linkage)))

(define (compile expression target linkage)
    (cond ((self-evaluating? expression)
           (compile-self expression target linkage))
          ((symbol? expression)
           (compile-variable expression target linkage))
          ((quoted? expression)
           (compile-quote expression target linkage))
          ((if? expression)
           (compile-if expression target linkage))
          ((lambda? expression)
           (compile-lambda expression target linkage))
          ((begin? expression)
           (compile-sequence (cdr expression)
                             target
                             linkage))
          ((pair? expression)
           (compile-application expression target linkage))
          (else
           (error "unknown compiler expression" expression))))
  (map expression-class
       '(42
         x
         (quote ok)
         (if x 1 2)
         (lambda (x) (+ x 1))
         (begin 1 2)
         (+ 1 2)))
)

Examples

Result—

Output: —
Value: —
Diagnostic: —

Execution trace0 / 0 events

Expected result

The dispatch program returns (self variable quote if lambda begin application). The conditional compiler returns ((env continue) (val proc argl continue) 15 (assign test branch assign assign assign assign assign assign assign goto label assign label goto) 2).

Trace focus

In the second program, separate predicate compilation from the generated test and branch. Then follow operator compilation into proc, operand compilation into val and argl, the alternative label, the after-if label, and the final return through continue. The needs and modifies sets provide conservative register-traffic contracts.

Try it yourself

Change the program and compare the result.

Compile a lambda containing a begin and an if with target proc and a named linkage. Inspect the stored body instructions separately from the outer closure-construction sequence.

Show hint

The lambda body always compiles toward val with return linkage. The outer target and linkage describe the expression that creates the compiled procedure.

Complete this lesson

0 of 23 lessons complete in this chapter0%