Start of moving out analsis into separate module

Not finished and possibly not worth doing.

mceval/analyzing-mceval.rkt

@@ -9,6 +9,7 @@
 (#%require "syntax.rkt")
 (#%require "environment.rkt")
 (#%require "common.rkt")
+(#%require "special-forms.rkt")
 
 (#%provide analyzing-driver-loop
            analyzing-eval-program)
@@ -16,95 +17,24 @@
 ;;;SECTION 4.1.7
 
 (define (analyzing-eval exp env)
-  ((analyze exp) env))
+  ((analyze exp analyze) env))
 
-(define (analyze exp)
+(define (analyze exp analyze-proc)
   (cond ((self-evaluating? exp) 
-         (analyze-self-evaluating exp))
-        ((quoted? exp) (analyze-quoted exp))
-        ((variable? exp) (analyze-variable exp))
-        ((assignment? exp) (analyze-assignment exp))
-        ((definition? exp) (analyze-definition exp))
-        ((if? exp) (analyze-if exp))
-        ((lambda? exp) (analyze-lambda exp))
-        ((begin? exp) (analyze-sequence (begin-actions exp)))
-        ((cond? exp) (analyze (cond->if exp)))
-        ((let? exp) (analyze (let->combination exp)))
-        ((application? exp) (analyze-application exp))
+         (analyze-self-evaluating exp analyze-proc))
+        ((quoted? exp) (analyze-quoted exp analyze-proc))
+        ((variable? exp) (analyze-variable exp analyze-proc))
+        ((assignment? exp) (analyze-assignment exp analyze-proc))
+        ((definition? exp) (analyze-definition exp analyze-proc))
+        ((if? exp) (analyze-if exp analyze-proc))
+        ((lambda? exp) (analyze-lambda exp analyze-proc))
+        ((begin? exp) (analyze-sequence (begin-actions exp) analyze-proc))
+        ((cond? exp) (analyze (cond->if exp)) analyze-proc)
+        ((let? exp) (analyze (let->combination exp)) analyze-proc)
+        ((application? exp) (analyze-application exp analyze-proc))
         (else
          (error "Unknown expression type -- ANALYZE" exp))))
 
-(define (analyze-self-evaluating exp)
-  (lambda (env) exp))
-
-(define (analyze-quoted exp)
-  (let ((qval (text-of-quotation exp)))
-    (lambda (env) qval)))
-
-(define (analyze-variable exp)
-  (lambda (env) (lookup-variable-value exp env)))
-
-(define (analyze-assignment exp)
-  (let ((var (assignment-variable exp))
-        (vproc (analyze (assignment-value exp))))
-    (lambda (env)
-      (set-variable-value! var (vproc env) env)
-      'ok)))
-
-(define (analyze-definition exp)
-  (let ((var (definition-variable exp))
-        (vproc (analyze (definition-value exp))))
-    (lambda (env)
-      (define-variable! var (vproc env) env)
-      'ok)))
-
-(define (analyze-if exp)
-  (let ((pproc (analyze (if-predicate exp)))
-        (cproc (analyze (if-consequent exp)))
-        (aproc (analyze (if-alternative exp))))
-    (lambda (env)
-      (if (true? (pproc env))
-          (cproc env)
-          (aproc env)))))
-
-(define (analyze-lambda exp)
-  (let ((vars (lambda-parameters exp))
-        (bproc (analyze-sequence (scan-out-defines (lambda-body exp)))))
-    (lambda (env) (make-procedure vars bproc env))))
-
-(define (analyze-sequence exps)
-  (define (sequentially proc1 proc2)
-    (lambda (env) (proc1 env) (proc2 env)))
-  (define (loop first-proc rest-procs)
-    (if (null? rest-procs)
-        first-proc
-        (loop (sequentially first-proc (car rest-procs))
-              (cdr rest-procs))))
-  (let ((procs (map analyze exps)))
-    (if (null? procs)
-        (error "Empty sequence -- ANALYZE"))
-    (loop (car procs) (cdr procs))))
-
-(define (analyze-application exp)
-  (let ((fproc (analyze (operator exp)))
-        (aprocs (map analyze (operands exp))))
-    (lambda (env)
-      (execute-application (fproc env)
-                           (map (lambda (aproc) (aproc env))
-                                aprocs)))))
-
-(define (execute-application proc args)
-  (cond ((primitive-procedure? proc)
-         (apply-primitive-procedure proc args))
-        ((compound-procedure? proc)
-         ((procedure-body proc)
-          (extend-environment (procedure-parameters proc)
-                              args
-                              (procedure-environment proc))))
-        (else
-         (error
-          "Unknown procedure type -- EXECUTE-APPLICATION"
-          proc))))
 
 (define input-prompt ";;; MA-Eval input:")
 (define output-prompt ";;; MA-Eval value:")

mceval/special-forms.rkt

@@ -10,7 +10,16 @@
            eval-definition
            eval-unbind
            eval-and
-           eval-or)
+           eval-or
+           analyze-self-evaluating
+           analyze-quoted
+           analyze-variable
+           analyze-if
+           analyze-sequence
+           analyze-assignment
+           analyze-definition
+           analyze-application
+           analyze-lambda)
 
 ;; Evaulation of special forms
 
@@ -58,4 +67,83 @@
             (eval-or (make-or (rest-disjuncts disjuncts)) env)))))
 
 
+;; Analysis of special forms
 
+(define (analyze-self-evaluating exp analyze-proc)
+  (lambda (env) exp))
+
+(define (analyze-quoted exp analyze-proc)
+  (let ((qval (text-of-quotation exp)))
+    (lambda (env) qval)))
+
+(define (analyze-variable exp analyze-proc)
+  (lambda (env) (lookup-variable-value exp env)))
+
+(define (analyze-assignment exp analyze-proc)
+  (let ((var (assignment-variable exp))
+        (vproc (analyze-proc (assignment-value exp)
+                             analyze-proc)))
+    (lambda (env)
+      (set-variable-value! var (vproc env) env)
+      'ok)))
+
+(define (analyze-definition exp analyze-proc)
+  (let ((var (definition-variable exp))
+        (vproc (analyze-proc (definition-value exp)
+                             analyze-proc)))
+    (lambda (env)
+      (define-variable! var (vproc env) env)
+      'ok)))
+
+(define (analyze-if exp analyze-proc)
+  (let ((pproc (analyze-proc (if-predicate exp) analyze-proc))
+        (cproc (analyze-proc (if-consequent exp) analyze-proc))
+        (aproc (analyze-proc (if-alternative exp) analyze-proc)))
+    (lambda (env)
+      (if (true? (pproc env))
+          (cproc env)
+          (aproc env)))))
+
+(define (analyze-lambda exp analyze-proc)
+  (let ((vars (lambda-parameters exp))
+        (bproc (analyze-sequence
+                (scan-out-defines
+                 (lambda-body exp))
+                analyze-proc)))
+    (lambda (env) (make-procedure vars bproc env))))
+
+(define (analyze-sequence exps analyze-proc)
+  (define (sequentially proc1 proc2)
+    (lambda (env) (proc1 env) (proc2 env)))
+  (define (loop first-proc rest-procs)
+    (if (null? rest-procs)
+        first-proc
+        (loop (sequentially first-proc (car rest-procs))
+              (cdr rest-procs))))
+  (let ((procs (map (lambda (e) (analyze-proc e analyze-proc))
+                    exps)))
+    (if (null? procs)
+        (error "Empty sequence -- ANALYZE"))
+    (loop (car procs) (cdr procs))))
+
+(define (analyze-application exp analyze-proc)
+  (let ((fproc (analyze-proc (operator exp) analyze-proc))
+        (aprocs (map (lambda (e) (analyze-proc e analyze-proc))
+                     (operands exp))))
+    (lambda (env)
+      (execute-application (fproc env)
+                           (map (lambda (aproc) (aproc env))
+                                aprocs)))))
+
+(define (execute-application proc args)
+  (cond ((primitive-procedure? proc)
+         (apply-primitive-procedure proc args))
+        ((compound-procedure? proc)
+         ((procedure-body proc)
+          (extend-environment (procedure-parameters proc)
+                              args
+                              (procedure-environment proc))))
+        (else
+         (error
+          "Unknown procedure type -- EXECUTE-APPLICATION"
+          proc))))