From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 12 Feb 2018 05:09:55 +0000 (-0800)
Subject: Eliminate the remaining three compilers.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~255
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8d2d1d63f18a559dec96b15e23b2ae5398cd21c5;p=mit-scheme.git

Eliminate the remaining three compilers.
---

diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm
index b2c46eb96..a1890a4f6 100644
--- a/src/runtime/mit-syntax.scm
+++ b/src/runtime/mit-syntax.scm
@@ -59,13 +59,13 @@ USA.
 
 ;;;; Core primitives
 
-(define (compiler:lambda form senv hist)
+(define (classifier:lambda form senv hist)
   (syntax-check '(_ mit-bvl + form) form)
   (compile-lambda scode-lambda-name:unnamed
 		  (cadr form)
 		  form senv hist))
 
-(define (compiler:named-lambda form senv hist)
+(define (classifier:named-lambda form senv hist)
   (syntax-check '(_ (identifier . mit-bvl) + form) form)
   (compile-lambda (identifier->symbol (caadr form))
 		  (cdadr form)
@@ -78,9 +78,9 @@ USA.
 	   (map-mit-lambda-list (lambda (identifier)
 				  (bind-variable identifier senv))
 				bvl)))
-      (output/lambda name
-		     bvl
-		     (compile-body-item (classify-body-cddr form senv hist))))))
+      (lambda-item name
+		   bvl
+		   (lambda () (classify-body-cddr form senv hist))))))
 
 (define (compile-body-item item)
   (output/body (compile-body-items (item->list item))))
@@ -126,9 +126,9 @@ USA.
 	  (else
 	   (syntax-error "Variable required in this context:" (cadr form))))))
 
-(define (compiler:delay form senv hist)
+(define (classifier:delay form senv hist)
   (syntax-check '(_ expression) form)
-  (output/delay (compile-expr-item (classify-form-cadr form senv hist))))
+  (delay-item (lambda () (classify-form-cadr form senv hist))))
 
 ;;;; Definitions
 
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 3273ca89a..8ba7bb7a5 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4581,20 +4581,20 @@ USA.
 	  classifier:begin
 	  classifier:declare
 	  classifier:define-syntax
+	  classifier:delay
 	  classifier:er-macro-transformer
 	  classifier:if
+	  classifier:lambda
 	  classifier:let-syntax
 	  classifier:letrec-syntax
+	  classifier:named-lambda
 	  classifier:or
 	  classifier:quote
 	  classifier:quote-identifier
 	  classifier:rsc-macro-transformer
 	  classifier:sc-macro-transformer
 	  classifier:set!
-	  classifier:the-environment
-	  compiler:delay
-	  compiler:lambda
-	  compiler:named-lambda)
+	  classifier:the-environment)
   (export (runtime mit-macros)
 	  keyword:access
 	  keyword:define
diff --git a/src/runtime/syntax-definitions.scm b/src/runtime/syntax-definitions.scm
index 9b9147b93..cf8966a3b 100644
--- a/src/runtime/syntax-definitions.scm
+++ b/src/runtime/syntax-definitions.scm
@@ -32,11 +32,10 @@ USA.
 (add-boot-init!
  (lambda ()
 
-   (define (def name item)
-     (environment-define-macro system-global-environment name item))
-
    (define (define-classifier name classifier)
-     (def name (classifier-item classifier)))
+     (environment-define-macro system-global-environment
+			       name
+			       (classifier-item classifier)))
 
    (define-classifier 'begin classifier:begin)
    (define-classifier 'declare classifier:declare)
@@ -52,10 +51,6 @@ USA.
    (define-classifier 'sc-macro-transformer classifier:sc-macro-transformer)
    (define-classifier 'set! classifier:set!)
    (define-classifier 'the-environment classifier:the-environment)
-
-   (define (define-compiler name compiler)
-     (def name (compiler-item compiler)))
-
-   (define-compiler 'delay compiler:delay)
-   (define-compiler 'lambda compiler:lambda)
-   (define-compiler 'named-lambda compiler:named-lambda)))
\ No newline at end of file
+   (define-classifier 'delay classifier:delay)
+   (define-classifier 'lambda classifier:lambda)
+   (define-classifier 'named-lambda classifier:named-lambda)))
\ No newline at end of file
diff --git a/src/runtime/syntax-items.scm b/src/runtime/syntax-items.scm
index b2bb81db8..23cd6170f 100644
--- a/src/runtime/syntax-items.scm
+++ b/src/runtime/syntax-items.scm
@@ -172,10 +172,10 @@ USA.
    (lambda ()
      (output/constant datum))))
 
-(define (lambda-item name bvl body-item)
+(define (lambda-item name bvl classify-body)
   (expr-item
    (lambda ()
-     (output/lambda name bvl (compile-expr-item body-item)))))
+     (output/lambda name bvl (compile-expr-item (classify-body))))))
 
 (define (let-item names value-items body-item)
   (expr-item
@@ -213,10 +213,10 @@ USA.
 			       (compile-expr-item env-item)
 			       (compile-expr-item rhs-item)))))
 
-(define (delay-item item)
+(define (delay-item classify)
   (expr-item
    (lambda ()
-     (output/delay (compile-expr-item item)))))
+     (output/delay (compile-expr-item (classify))))))
 
 (define (or-item items)
   (expr-item