Change lazy evaluator to use data-directed dispatch

This will enable on the fly overriding of sequence processing for
exercise 4.30.

mceval/leval.rkt

@@ -5,33 +5,78 @@
 
 ;;;; OMP: modified to work with racket and to fit with existing code
 
+;;;; This evaluator uses the modifications of exercise 4.31: arguments
+;;;; can be strict, lazy or lazy with memoization.  To specify a
+;;;; procedure, strict in x, lazy in y and lazy with memoization in z:
+;;;; (define (f x (y 'lazy) (z 'lazy-memo))).  Also modified from the
+;;;; book's version is the use of data-directed dispatch for eval.
+
 (#%require racket/trace)
 (#%require "syntax.rkt")
 (#%require "environment.rkt")
 (#%require "common.rkt")
 (#%require "special-forms.rkt")
+(#%require "dispatch-table.rkt")
 
 (#%provide lazy-driver-loop
-           lazy-eval-program)
+           lazy-eval-program
+           lazy-put-dispatch!
+           actual-value)
 
-;;;SECTION 4.2.2
+(define type-tag car)
+(define dispatch-table (make-dispatch-table))
 
-;;; Modifying the evaluator
+(define lazy-dispatch-alist
+  `((if . ,(lambda (exp env)
+             (lazy-eval-if exp env)))
+    (begin .
+           ,(lambda (exp env)
+              (eval-sequence (begin-actions exp) env lazy-eval)))
+    (set! . ,(lambda (exp env)
+               (eval-assignment exp env lazy-eval)))
+    (define .
+      ,(lambda (exp env)
+         (eval-definition exp env lazy-eval)))
+    (make-unbound! . ,(lambda (exp env)
+                        (eval-unbind exp env lazy-eval)))
+    (quote .
+           ,(lambda (exp env)
+              (text-of-quotation exp)))
+    (lambda .
+      ,(lambda (exp env)
+         (make-procedure (lambda-parameters exp)
+                         (scan-out-defines (lambda-body exp))
+                         env)))
+    (cond .
+          ,(lambda (exp env)
+             (lazy-eval (cond->if exp) env)))
+    (and . ,(lambda (exp env)
+              (eval-and exp env lazy-eval)))
+    (or . ,(lambda (exp env)
+             (eval-or exp env lazy-eval)))
+    (let . ,(lambda (exp env)
+              (lazy-eval (let->combination exp) env)))
+    (let* . ,(lambda (exp env)
+               (lazy-eval (let*->nested-let exp) env)))
+    (letrec . ,(lambda (exp env)
+                 (lazy-eval (letrec->let exp) env)))
+    (for . ,(lambda (exp env)
+              (lazy-eval (for->named-let exp) env)))
+    (unless . ,(lambda (exp env)
+                 (lazy-eval (unless->if exp) env)))))
+
+;; Set up dispatch table from the alist
+(put-alist! dispatch-table lazy-dispatch-alist)
+
+;; Allow setting of dispatched procedures externally
+(define (lazy-put-dispatch! tag proc)
+  (put! dispatch-table tag proc))
 
 (define (lazy-eval exp env)
   (cond ((self-evaluating? exp) exp)
         ((variable? exp) (lookup-variable-value exp env))
-        ((quoted? exp) (text-of-quotation exp))
-        ((assignment? exp) (eval-assignment exp env lazy-eval))
-        ((definition? exp) (eval-definition exp env lazy-eval))
-        ((if? exp) (lazy-eval-if exp env))
-        ((lambda? exp)
-         (make-procedure (lambda-parameters exp)
-                         (lambda-body exp)
-                         env))
-        ((begin? exp) 
-         (eval-sequence (begin-actions exp) env lazy-eval))
-        ((cond? exp) (lazy-eval (cond->if exp) env))
+        ((get dispatch-table (type-tag exp))
+         => (lambda (proc) (proc exp env)))
         ((application? exp)             ; clause from book
          (lazy-apply (actual-value (operator exp) env)
                      (operands exp)