Finish explicit-control evaluator and exercises

1 files changed, 757 insertions, 13 deletions

diff --git a/chap5/part4.rkt b/chap5/part4.rkt
index 34d0fd8..c200f95 100644
--- a/chap5/part4.rkt
+++ b/chap5/part4.rkt
@@ -29,6 +29,10 @@
       (branch (label ev-lambda))
       (test (op begin?) (reg exp))
       (branch (label ev-begin))
+      (test (op cond?) (reg exp))
+      (branch (label ev-cond))
+      (test (op let?) (reg exp))
+      (branch (label ev-let))
       (test (op application?) (reg exp))
       (branch (label ev-application))
       (goto (label unknown-expression-type))))
@@ -97,7 +101,7 @@
       (assign unev (op rest-operands) (reg unev))
       (goto (label ev-appl-operand-loop))
     ev-appl-last-arg
-      (assign continue (label appl-accum-last-arg))
+      (assign continue (label ev-appl-accum-last-arg))
       (goto (label eval-dispatch))
     ev-appl-accum-last-arg
       (restore argl)
@@ -153,7 +157,7 @@
 
 (define ev-sequence-bad
   '(ev-sequence
-      (test (op no-more-exps) (reg unev))
+      (test (op no-more-exps?) (reg unev))
       (branch (label ev-sequence-end))
       (assign exp (op first-exp) (reg unev))
       (save unev)
@@ -167,7 +171,7 @@
       (goto (label ev-sequence))
     ev-sequence-end
       (restore continue)
-      (goto (label continue))))
+      (goto (reg continue))))
 
 (#%provide count)
 (define (count n)
@@ -188,6 +192,7 @@
     ev-if-decide
       (restore continue)
       (restore env)
+      (restore exp)
       (test (op true?) (reg val))
       (branch (label ev-if-consequent))
     ev-if-alternative
@@ -222,6 +227,7 @@
       (save env)
       (save continue)
       (assign continue (label ev-definition-1))
+      (goto (label eval-dispatch))
     ev-definition-1
       (restore continue)
       (restore env)
@@ -230,6 +236,20 @@
       (assign val (const ok))
       (goto (reg continue))))
 
+#| 5.23 |#
+
+(define ev-cond
+  '(ev-cond
+      (assign exp (op cond->if) (reg exp))
+      (goto (label eval-dispatch))))
+
+(define ev-let
+  '(ev-let
+      (assign exp (op let->combination) (reg exp))
+      (goto (label eval-dispatch))))
+
+;; Running the Evaluator
+
 (define read-eval-print-loop
   '(read-eval-print-loop
       (perform (op initialize-stack))
@@ -239,6 +259,7 @@
       (assign continue (label print-result))
       (goto (label eval-dispatch))
     print-result
+      (perform (op print-stack-statistics))
       (perform (op announce-output) (const ";;; EC-Eval value:"))
       (perform (op user-print) (reg val))
       (goto (label read-eval-print-loop))))
@@ -262,10 +283,11 @@
       (car xss)
       (flatten (cdr xss)))))
 
-(#%provide ec-eval-controller)
-(define ec-eval-controller
+(#%provide eceval-controller)
+(define eceval-controller
   (flatten
     (list
+      read-eval-print-loop
       eval-dispatch
       ev-self-eval
       ev-variable
@@ -274,25 +296,83 @@
       ev-application
       apply-dispatch
       ev-begin
+      ev-cond
+      ev-let
       ev-sequence
-      ev-sequence-bad
       ev-if
       ev-assignment
       ev-definition
-      read-eval-print-loop
       errors)))
 
-#| 5.23 |#
-#| 5.24 |#
-#| 5.25 |#
+#| 5.26 |#
 
-;; Running the Evaluator
+(define (factorial-iter n)
+  (define (iter product counter)
+    (if (> counter n)
+      product
+      (iter (* counter product) (+ counter 1))))
+  (iter 1 1))
+
+; maximum stack depth for any n is 10
+
+(#%provide total-pushes-factorial-iter)
+(define (total-pushes-factorial-iter n)
+  (+ (* 35 n) 29))
 
-#| 5.26 |#
 #| 5.27 |#
+
+(define (factorial n)
+  (if (= n 1) 1 (* (factorial (- n 1)) n)))
+
+(#%provide max-depth-factorial-rec)
+(define (max-depth-factorial-rec n)
+  (+ (* 5 n) 3))
+
+(#%provide total-pushes-factorial-rec)
+(define (total-pushes-factorial-rec n)
+  (- (* 32 n) 16))
+
+          #| |   Max depth   |   Num pushes |#
+#| ----------|---------------|----------------- |#
+#| fact-rec  | (+ (* 5 n) 3) | (- (* 32 n) 16) |#
+#| ----------|---------------|----------------- |#
+#| fact-iter |            10 | (+ (* 35 n) 29) |#
+
 #| 5.28 |#
+
+;; without tail-recursive ev-sequence:
+
+          #| |   Max depth    |   Num pushes |#
+#| ----------|----------------|----------------- |#
+#| fact-rec  |  (+ (* 8 n) 3) | (- (* 34 n) 16) |#
+#| ----------|----------------|----------------- |#
+#| fact-iter | (+ (* 3 n) 14) | (+ (* 37 n) 33) |#
+
 #| 5.29 |#
-#| 5.30 |#
+
+(define (fib n)
+  (if (< n 2)
+    n
+    (+ (fib (- n 1)) (fib (- n 2)))))
+
+(#%provide max-depth-fib)
+(define (max-depth-fib n)
+  (+ (* 5 n) 3))
+
+(#%provide total-pushes-fib)
+(define (total-pushes-fib n)
+  (if (< n 2)
+    16
+    (+
+      40
+      (total-pushes-fib (- n 1))
+      (total-pushes-fib (- n 2)))))
+
+(#%provide total-pushes-fib-)
+(define (total-pushes-fib- n)
+  (- (* 56 (fib (+ n 1))) 40))
+
+; syntax and run-time procedures
 
 (define (self-evaluating? exp)
   (cond
@@ -561,6 +641,7 @@
     (list 'cdr cdr)
     (list 'cons cons)
     (list 'null? null?)
+    (list 'number? number?)
     (list '+ +)
     (list '- -)
     (list '* *)
@@ -603,3 +684,666 @@
         (procedure-body object)
         '<procedure-env>))
     (display object)))
+
+; register-machine simulator
+
+(define (get-contents register)
+  (register 'get))
+
+(define (set-contents! register value)
+  ((register 'set) value))
+
+(define (pop stack)
+  (stack 'pop))
+
+(define (push stack value)
+  ((stack 'push) value))
+
+(define (make-instruction text)
+  (list text false '()))
+
+(define (instruction-text inst)
+  (car inst))
+
+(define (instruction-label inst)
+  (cadr inst))
+
+(define (instruction-execution-proc inst)
+  (caddr inst))
+
+(define (set-instruction-label! inst label)
+  (set-cdr! inst (cons label (cddr inst))))
+
+(define (set-instruction-execution-proc! inst proc)
+  (set-cdr! (cdr inst) (list proc)))
+
+(define (make-new-machine)
+  (let
+    ((pc (make-register 'pc))
+     (flag (make-register 'flag))
+     (stack (make-statck))
+     (the-instruction-sequence '())
+     (instructions-used '())
+     (entry-regs '())
+     (stack-regs '())
+     (reg-assignments '())
+     (inst-count 0)
+     (trace? false))
+    (let
+      ((the-ops
+        (list
+          (list
+            'initialize-stack
+            (lambda () (stack 'initialize)))
+          (list
+            'print-stack-statistics
+            (lambda () (stack 'print-statistics)))))
+       (register-table
+         (list (list 'pc pc) (list 'flag flag))))
+      (define (allocate-register name)
+        (if (assoc name register-table)
+          (error "Multiply-defined register: " name)
+          (set! register-table
+            (cons
+              (list name (make-register name))
+              register-table)))
+        'register-allocated)
+      (define (lookup-register name)
+        (let ((val (assoc name register-table)))
+          (if val
+            (cadr val)
+            (error "Unknown register:" name))))
+      (define (lookup-register- name)
+        (let ((val (assoc name register-table)))
+          (if val
+            (cadr val)
+            (begin
+              (allocate-register name)
+              (lookup-register name)))))
+      (define (execute)
+        (let ((insts (get-contents pc)))
+          (if (null? insts)
+            'done
+            (begin
+              (if trace?
+                (begin
+                  (if (instruction-label (car insts))
+                    (begin
+                      (display (instruction-label (car insts)))
+                      (newline)))
+                  (display "  ")
+                  (display (instruction-text (car insts)))
+                  (newline)))
+              ((instruction-execution-proc (car insts)))
+              (set! inst-count (+ inst-count 1))
+              (execute)))))
+      (define (write-datapath-info insts)
+        (set! instructions-used (list-insts insts))
+        (set! entry-regs
+          (dedup
+            (map
+              cadr
+              (filter
+                (lambda (x) (eq? (car x) 'reg))
+                (map
+                  goto-dest
+                  (filter
+                    (lambda (inst) (eq? (car inst) 'goto))
+                    instructions-used))))))
+        (set! stack-regs
+          (dedup
+            (map
+              stack-inst-reg-name
+              (filter
+                (lambda (inst)
+                  (or
+                    (eq? (car inst) 'save)
+                    (eq? (car inst) 'restore)))
+                instructions-used))))
+        (set! reg-assignments
+          (map
+            (lambda (r)
+              (list
+                r
+                (map
+                  assign-value-exp
+                  (filter
+                    (lambda (assign-inst)
+                      (eq? (assign-reg-name assign-inst) r))
+                    (filter
+                      (lambda (inst) (eq? (car inst) 'assign))
+                      instructions-used)))))
+            (map car register-table)))
+        'done)
+      (define (dispatch message)
+        (cond
+          ((eq? message 'start)
+           (set-contents! pc the-instruction-sequence)
+           (execute))
+          ((eq? message 'install-instruction-sequence)
+           (lambda (seq) (set! the-instruction-sequence seq)))
+          ((eq? message 'allocate-register) allocate-register)
+          ((eq? message 'get-register) lookup-register)
+          ((eq? message 'get-register-alloc) lookup-register-)
+          ((eq? message 'install-operations)
+           (lambda (ops) (set! the-ops (append the-ops ops))))
+          ((eq? message 'stack) stack)
+          ((eq? message 'instructions-used) instructions-used)
+          ((eq? message 'entry-regs) entry-regs)
+          ((eq? message 'stack-regs) stack-regs)
+          ((eq? message 'reg-assigns) reg-assignments)
+          ((eq? message 'operations) the-ops)
+          ((eq? message 'write-info) write-datapath-info)
+          ((eq? message 'reset-inst-count)
+           (display (list inst-count 'instructions 'executed))
+           (newline)
+           (set! inst-count 0))
+          ((eq? message 'trace-on) (set! trace? true))
+          ((eq? message 'trace-off) (set! trace? false))
+          (else (error "Unknown request -- MACHINE" message))))
+      dispatch)))
+
+(#%provide start)
+(define (start machine)
+  (machine 'start))
+
+(define (get-register machine reg-name)
+  ((machine 'get-register) reg-name))
+
+(define (get-register-contents machine register-name)
+  (get-contents (get-register machine register-name)))
+
+(define (set-register-contents! machine register-name value)
+  (set-contents! (get-register machine register-name) value)
+  'done)
+
+(#%provide make-machine)
+(define (make-machine ops controller-text)
+  (let ((machine (make-new-machine)))
+    ((machine 'install-operations) ops)
+    ((machine 'install-instruction-sequence)
+     (assemble controller-text machine))
+    ((machine 'write-info) controller-text)
+    machine))
+
+(define (make-label-entry label-name insts)
+  (cons label-name insts))
+
+(define (lookup-label labels label-name)
+  (let ((val (assoc label-name labels)))
+    (if val
+      (cdr val)
+      (error "Undefined label -- ASSEMBLE" label-name))))
+
+(define (extract-labels text receive)
+  (if (null? text)
+    (receive '() '())
+    (extract-labels
+      (cdr text)
+      (lambda (insts labels)
+        (let ((next-inst (car text)))
+          (if (symbol? next-inst)
+            (if (assoc next-inst labels)
+              (error "Duplicate label -- ASSEMBLE" next-inst)
+              (begin
+                (if (not (null? insts))
+                  (set-instruction-label! (car insts) next-inst))
+                (receive
+                  insts
+                  (cons
+                    (make-label-entry next-inst insts)
+                    labels))))
+            (receive
+              (cons
+                (make-instruction next-inst)
+                insts)
+              labels)))))))
+
+(define (update-insts! insts labels machine)
+  (let
+    ((pc (get-register machine 'pc))
+     (flag (get-register machine 'flag))
+     (stack (machine 'stack))
+     (ops (machine 'operations)))
+    (for-each
+      (lambda (inst)
+        (set-instruction-execution-proc!
+          inst
+          (make-execution-procedure
+            (instruction-text inst)
+            labels
+            machine
+            pc
+            flag
+            stack
+            ops)))
+      insts)))
+
+(define (assemble controller-text machine)
+  (extract-labels
+    controller-text
+    (lambda (insts labels)
+      (update-insts! insts labels machine)
+      insts)))
+
+(define (make-execution-procedure
+          inst
+          labels
+          machine
+          pc
+          flag
+          stack
+          ops)
+  (cond
+    ((eq? (car inst) 'assign)
+     (make-assign inst machine labels ops pc))
+    ((eq? (car inst) 'test)
+     (make-test inst machine labels ops flag pc))
+    ((eq? (car inst) 'branch)
+     (make-branch inst machine labels flag pc))
+    ((eq? (car inst) 'goto)
+     (make-goto inst machine labels pc))
+    ((eq? (car inst) 'save)
+     (make-save inst machine stack pc))
+    ((eq? (car inst) 'restore)
+     (make-restore inst machine stack pc))
+    ((eq? (car inst) 'perform)
+     (make-perform inst machine labels ops pc))
+    (else
+      (error "Unknown instruction type -- ASSEMBLE" inst))))
+
+(define (make-assign inst machine labels operations pc)
+  (let
+    ((target
+      (get-register-alloc machine (assign-reg-name inst)))
+     (value-exp (assign-value-exp inst)))
+    (let
+      ((value-proc
+        (if (operation-exp? value-exp)
+          (make-operation-exp
+            value-exp
+            machine
+            labels
+            operations)
+          (make-primitive-exp
+            (car value-exp)
+            machine
+            labels))))
+      (lambda ()
+        (set-contents! target (value-proc))
+        (advance-pc pc)))))
+
+(define (assign-reg-name assign-instruction)
+  (cadr assign-instruction))
+
+(define (assign-value-exp assign-instruction)
+  (cddr assign-instruction))
+
+(define (advance-pc pc)
+  (set-contents! pc (cdr (get-contents pc))))
+
+(define (make-test inst machine labels operations flag pc)
+  (let ((condition (test-condition inst)))
+    (if (operation-exp? condition)
+      (let
+        ((condition-proc
+          (make-operation-exp
+            condition
+            machine
+            labels
+            operations)))
+        (lambda ()
+          (set-contents! flag (condition-proc))
+          (advance-pc pc)))
+      (error "Bad TEST instruction -- ASSEMBLE" inst))))
+
+(define (test-condition test-instruction)
+  (cdr test-instruction))
+
+(define (make-branch inst machine labels flag pc)
+  (let ((dest (branch-dest inst)))
+    (if (label-exp? dest)
+      (let ((insts (lookup-label labels (label-exp-label dest))))
+        (lambda ()
+          (if (get-contents flag)
+            (set-contents! pc insts)
+            (advance-pc pc))))
+      (error "Bad BRANCH instruction -- ASSEMBLE" inst))))
+
+(define (branch-dest branch-instruction)
+  (cadr branch-instruction))
+
+(define (make-goto inst machine labels pc)
+  (let ((dest (goto-dest inst)))
+    (cond
+      ((label-exp? dest)
+       (let
+         ((insts (lookup-label labels (label-exp-label dest))))
+         (lambda () (set-contents! pc insts))))
+      ((register-exp? dest)
+       (let
+         ((reg (get-register-alloc machine (register-exp-reg dest))))
+         (lambda () (set-contents! pc (get-contents reg)))))
+      (else (error "Bad GOTO instruction -- ASSEMBLE" inst)))))
+
+(define (goto-dest goto-instruction)
+  (cadr goto-instruction))
+
+(define (make-save inst machine stack pc)
+  (let
+    ((reg
+      (get-register-alloc
+        machine
+        (stack-inst-reg-name inst))))
+    (lambda ()
+      (push stack (get-contents reg))
+      (advance-pc pc))))
+
+(define (make-restore inst machine stack pc)
+  (let
+    ((reg
+      (get-register-alloc
+        machine
+        (stack-inst-reg-name inst))))
+    (lambda ()
+      (set-contents! reg (pop stack))
+      (advance-pc pc))))
+
+(define (stack-inst-reg-name stack-instruction)
+  (cadr stack-instruction))
+
+(define (make-perform inst machine labels operations pc)
+  (let ((action (perform-action inst)))
+    (if (operation-exp? action)
+      (let
+        ((action-proc
+          (make-operation-exp
+            action
+            machine
+            labels
+            operations)))
+        (lambda ()
+          (action-proc)
+          (advance-pc pc)))
+      (error "Bad PERFORM instruction -- ASSEMBLE" inst))))
+
+(define (perform-action inst) (cdr inst))
+
+(define (make-primitive-exp exp machine labels)
+  (cond
+    ((constant-exp? exp)
+     (let ((c (constant-exp-value exp)))
+       (lambda () c)))
+    ((label-exp? exp)
+     (let ((insts (lookup-label labels (label-exp-label exp))))
+       (lambda () insts)))
+    ((register-exp? exp)
+     (let ((r (get-register-alloc machine (register-exp-reg exp))))
+       (lambda () (get-contents r))))
+    (else
+     (error "Unknown expression type -- ASSEMBLE" exp))))
+
+(define (register-exp? exp) (tagged-list? exp 'reg))
+
+(define (register-exp-reg exp) (cadr exp))
+
+(define (constant-exp? exp) (tagged-list? exp 'const))
+
+(define (constant-exp-value exp) (cadr exp))
+
+(define (label-exp? exp) (tagged-list? exp 'label))
+
+(define (label-exp-label exp) (cadr exp))
+
+(define (make-operation-exp exp machine labels operations)
+  (let
+    ((op (lookup-prim (operation-exp-op exp) operations))
+     (aprocs
+      (map
+        (lambda (e)
+          (make-op-primitive-exp e machine labels))
+        (operation-exp-operands exp))))
+    (lambda ()
+      (apply op (map (lambda (p) (p)) aprocs)))))
+
+(define (operation-exp? exp)
+  (and (pair? exp) (tagged-list? (car exp) 'op)))
+
+(define (operation-exp-op operation-exp)
+  (cadr (car operation-exp)))
+
+(define (operation-exp-operands operation-exp)
+  (cdr operation-exp))
+
+(define (lookup-prim symbol operations)
+  (let ((val (assoc symbol operations)))
+    (if val
+      (cadr val)
+      (error "Unknown operation -- ASSEMBLE" symbol))))
+
+(define (make-op-primitive-exp exp machine labels)
+  (cond
+    ((constant-exp? exp)
+     (let ((c (constant-exp-value exp)))
+       (lambda () c)))
+    ((register-exp? exp)
+     (let ((r (get-register-alloc machine (register-exp-reg exp))))
+       (lambda () (get-contents r))))
+    ((label-exp? exp)
+     (error "Label in operator expression" exp))
+    (else
+     (error "Unknown expression type -- ASSEMBLE" exp))))
+
+(define (sort-insts insts)
+  (define (number inst)
+    (cond
+      ((symbol? inst) 0)
+      ((eq? (car inst) 'assign) 1)
+      ((eq? (car inst) 'test) 2)
+      ((eq? (car inst) 'branch) 3)
+      ((eq? (car inst) 'goto) 4)
+      ((eq? (car inst) 'save) 5)
+      ((eq? (car inst) 'restore) 6)
+      ((eq? (car inst) 'perform) 7)
+      (else 8)))
+  (define (compare inst1 inst2)
+    (cond
+      ((< (number inst1) (number inst2)) 'LT)
+      ((= (number inst1) (number inst2)) 'EQ)
+      (else 'GT)))
+  (define (split xs)
+    (cond
+      ((null? xs) (list '() '()))
+      ((null? (cdr xs)) (list xs '()))
+      (else
+       (let ((rest-parted (split (cddr xs))))
+         (list
+           (cons (car xs) (car rest-parted))
+           (cons (cadr xs) (cadr rest-parted)))))))
+  (define (merge insts1 insts2)
+    (cond
+      ((null? insts1) insts2)
+      ((null? insts2) insts1)
+      (else
+        (let
+          ((i1 (car insts1))
+           (i2 (car insts2)))
+          (cond
+            ((eq? (compare i1 i2) 'LT)
+             (cons i1 (merge (cdr insts1) insts2)))
+            ((eq? (compare i1 i2) 'EQ)
+             (cons i1 (cons i2 (merge (cdr insts1) (cdr insts2)))))
+            (else
+             (cons i2 (merge insts1 (cdr insts2)))))))))
+  (if (or (null? insts) (null? (cdr insts)))
+    insts
+    (let ((parted (split insts)))
+      (merge
+        (sort-insts (car parted))
+        (sort-insts (cadr parted))))))
+
+(define (filter pred xs)
+  (cond
+    ((null? xs) '())
+    ((pred (car xs))
+     (cons (car xs) (filter pred (cdr xs))))
+    (else
+     (filter pred (cdr xs)))))
+
+(define (nub xs)
+  (cond
+    ((null? xs) '())
+    ((null? (cdr xs)) xs)
+    ((equal? (car xs) (cadr xs))
+     (nub (cons (car xs) (cddr xs))))
+    (else
+     (cons (car xs) (nub (cdr xs))))))
+
+(define (list-insts insts)
+  (nub
+    (filter
+      (lambda (x) (not (symbol? x)))
+      (sort-insts insts))))
+
+(define (dedup syms)
+  (cond
+    ((null? syms) '())
+    ((memq (car syms) (cdr syms))
+     (dedup (cdr syms)))
+    (else (cons (car syms) (dedup (cdr syms))))))
+
+(define (get-register-alloc machine reg-name)
+  ((machine 'get-register-alloc) reg-name))
+
+(define (make-statck)
+  (let
+    ((s '())
+     (number-pushes 0)
+     (max-depth 0)
+     (current-depth 0))
+    (define (push x)
+      (set! s (cons x s))
+      (set! number-pushes (+ 1 number-pushes))
+      (set! current-depth (+ 1 current-depth))
+      (set! max-depth (max current-depth max-depth)))
+    (define (pop)
+      (if (null? s)
+        (error "Empty statck -- POP")
+        (let ((top (car s)))
+          (set! s (cdr s))
+          (set! current-depth (- current-depth 1))
+          top)))
+    (define (initialize)
+      (set! s '())
+      (set! number-pushes 0)
+      (set! max-depth 0)
+      (set! current-depth 0)
+      'done)
+    (define (print-statistics)
+      (display
+        (list
+          'total-pushes '= number-pushes
+          'maximum-depth '= max-depth))
+      (newline))
+    (define (dispatch message)
+      (cond
+        ((eq? message 'push) push)
+        ((eq? message 'pop) (pop))
+        ((eq? message 'initialize) (initialize))
+        ((eq? message 'print-statistics)
+         (print-statistics))
+        (else
+         (error "Unknown request -- STATCK" message))))
+    dispatch))
+
+(define (make-register name)
+  (let
+    ((contents '*unassigned*)
+     (trace? false))
+    (define (dispatch message)
+      (cond
+        ((eq? message 'get) contents)
+        ((eq? message 'set)
+         (lambda (value)
+           (if trace?
+             (begin
+               (display
+                 (list
+                    name
+                    'old-contents '= contents
+                    'new-contents '= value))
+               (newline)))
+           (set! contents value)))
+        ((eq? message 'trace-on) (set! trace? true))
+        ((eq? message 'trace-off) (set! trace? false))
+        (else
+         (error "Unknown request -- REGISTER" message))))
+    dispatch))
+
+(define (trace-reg machine reg-name on?)
+  (let ((reg (get-register machine reg-name)))
+    (cond
+      ((eq? on? 'on) (reg 'trace-on))
+      ((eq? on? 'off) (reg 'trace-off))
+      (else "Unknown request - TRACE-REG" on?))))
+
+(define the-global-environment (setup-environment))
+
+(define (get-global-environment) the-global-environment)
+
+(#%provide eceval-operations)
+(define eceval-operations
+  (list
+    (list 'adjoin-arg adjoin-arg)
+    (list 'announce-output announce-output)
+    (list 'application? application?)
+    (list 'apply-primitive-procedure apply-primitive-procedure)
+    (list 'assignment? assignment?)
+    (list 'assignment-value assignment-value)
+    (list 'assignment-variable assignment-variable)
+    (list 'begin? begin?)
+    (list 'begin-actions begin-actions)
+    (list 'compound-procedure? compound-procedure?)
+    (list 'cond? cond?)
+    (list 'cond->if cond->if)
+    (list 'define-variable! define-variable!)
+    (list 'definition? definition?)
+    (list 'definition-value definition-value)
+    (list 'definition-variable definition-variable)
+    (list 'empty-arglist empty-arglist)
+    (list 'extend-environment extend-environment)
+    (list 'first-exp first-exp)
+    (list 'first-operand first-operand)
+    (list 'get-global-environment get-global-environment)
+    (list 'if? if?)
+    (list 'if-alternative if-alternative)
+    (list 'if-consequent if-consequent)
+    (list 'if-predicate if-predicate)
+    (list 'lambda? lambda?)
+    (list 'lambda-body lambda-body)
+    (list 'lambda-parameters lambda-parameters)
+    (list 'last-exp? last-exp?)
+    (list 'last-operand? last-operand?)
+    (list 'let? let?)
+    (list 'let->combination let->combination)
+    (list 'lookup-variable-value lookup-variable-value)
+    (list 'make-procedure make-procedure)
+    (list 'no-more-exps? no-more-exps?)
+    (list 'no-operands? no-operands?)
+    (list 'operands operands)
+    (list 'operator operator)
+    (list 'primitive-procedure? primitive-procedure?)
+    (list 'procedure-body procedure-body)
+    (list 'procedure-environment procedure-environment)
+    (list 'procedure-parameters procedure-parameters)
+    (list 'prompt-for-input prompt-for-input)
+    (list 'quoted? quoted?)
+    (list 'read read)
+    (list 'rest-exps rest-exps)
+    (list 'rest-operands rest-operands)
+    (list 'self-evaluating? self-evaluating?)
+    (list 'set-variable-value! set-variable-value!)
+    (list 'text-of-quotation text-of-quotation)
+    (list 'true? true?)
+    (list 'user-print user-print)
+    (list 'variable? variable?)))