From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 10 Feb 2018 04:12:04 +0000 (-0800)
Subject: Eliminate classify-expr.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~268
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8eabc530ea768492ac66845682b4ebee889951ba;p=mit-scheme.git

Eliminate classify-expr.
---

diff --git a/src/edwin/clsmac.scm b/src/edwin/clsmac.scm
index 6ee1257ce..f29d2262e 100644
--- a/src/edwin/clsmac.scm
+++ b/src/edwin/clsmac.scm
@@ -97,14 +97,15 @@ USA.
 	(transform-instance-variables
 	 (class-instance-transforms
 	  (name->class (identifier->symbol class-name)))
-	 (compile-expr self environment)
+	 (compile-expr-item (classify-form self environment))
 	 free-names
-	 (compile-expr
-	  `(,(close-syntax 'begin
-			   (runtime-environment->syntactic
-			    system-global-environment))
-	    ,@body)
-	  environment)))))))
+	 (compile-expr-item
+	  (classify-form
+	   `(,(close-syntax 'begin
+			    (runtime-environment->syntactic
+			     system-global-environment))
+	     ,@body)
+	   environment))))))))
 
 (define-syntax ==>
   (syntax-rules ()
diff --git a/src/edwin/edwin.pkg b/src/edwin/edwin.pkg
index 10a0fd13b..5894b7d21 100644
--- a/src/edwin/edwin.pkg
+++ b/src/edwin/edwin.pkg
@@ -285,7 +285,8 @@ USA.
 	  usual==>
 	  with-instance-variables)
   (import (runtime syntax)
-	  compile-expr
+	  classify-form
+	  compile-expr-item
 	  compiler-item))
 
 (define-package (edwin class-macros transform-instance-variables)
diff --git a/src/runtime/host-adapter.scm b/src/runtime/host-adapter.scm
index 9d1e5aba3..f55249f8b 100644
--- a/src/runtime/host-adapter.scm
+++ b/src/runtime/host-adapter.scm
@@ -190,7 +190,11 @@ USA.
 
   (let ((env (->environment '(runtime syntax))))
     (provide-rename env 'make-compiler-item 'compiler-item)
-    (provide-rename env 'compile/expression 'compile-expr))
+    (provide-rename env 'compile-item/expression 'compile-expr-item)
+    (if (unbound? env 'classify-form)
+	(eval '(define (classify-form form env)
+		 (classify/form form env env))
+	      env)))
 
   (let ((env (->environment '(package))))
     (if (eval '(not (link-description? '#(name1 (package name) name2 #f)))
diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm
index 558f10264..c6b0da755 100644
--- a/src/runtime/mit-syntax.scm
+++ b/src/runtime/mit-syntax.scm
@@ -34,7 +34,7 @@ USA.
 (define (transformer-keyword procedure-name transformer->expander)
   (lambda (form senv)
     (syntax-check '(KEYWORD EXPRESSION) form)
-    (let ((transformer (compile-expr (cadr form) senv)))
+    (let ((transformer (compile-expr-item (classify-form (cadr form) senv))))
       (transformer->expander (transformer-eval transformer senv)
 			     senv
 			     (expr-item
@@ -92,10 +92,10 @@ USA.
 (define (compiler:if form environment)
   (syntax-check '(KEYWORD EXPRESSION EXPRESSION ? EXPRESSION) form)
   (output/conditional
-   (compile-expr (cadr form) environment)
-   (compile-expr (caddr form) environment)
+   (compile-expr-item (classify-form (cadr form) environment))
+   (compile-expr-item (classify-form (caddr form) environment))
    (if (pair? (cdddr form))
-       (compile-expr (cadddr form) environment)
+       (compile-expr-item (classify-form (cadddr form) environment))
        (output/unspecific))))
 
 (define (compiler:quote form environment)
@@ -116,7 +116,7 @@ USA.
       (classify/location (cadr form) environment)
     (let ((value
 	   (if (pair? (cddr form))
-	       (compile-expr (caddr form) environment)
+	       (compile-expr-item (classify-form (caddr form) environment))
 	       (output/unassigned))))
       (if environment-item
 	  (output/access-assignment
@@ -136,7 +136,7 @@ USA.
 
 (define (compiler:delay form environment)
   (syntax-check '(KEYWORD EXPRESSION) form)
-  (output/delay (compile-expr (cadr form) environment)))
+  (output/delay (compile-expr-item (classify-form (cadr form) environment))))
 
 ;;;; Definitions
 
@@ -239,7 +239,7 @@ USA.
   (syntax-check '(KEYWORD * EXPRESSION) form)
   (if (pair? (cdr form))
       (let loop ((expressions (cdr form)))
-	(let ((compiled (compile-expr (car expressions) environment)))
+	(let ((compiled (compile-expr-item (classify-form (car expressions) environment))))
 	  (if (pair? (cdr expressions))
 	      (output/disjunction compiled (loop (cdr expressions)))
 	      compiled)))
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 2ae00bf35..17281229c 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4408,7 +4408,6 @@ USA.
 	  classify-form
 	  compile-body-items
 	  compile-expr-item
-	  compile-expr
 	  compiler->keyword
 	  define-item-compiler
 	  raw-identifier?))
diff --git a/src/runtime/syntax.scm b/src/runtime/syntax.scm
index e560dc16f..9b5958657 100644
--- a/src/runtime/syntax.scm
+++ b/src/runtime/syntax.scm
@@ -58,11 +58,8 @@ USA.
 	   (compile-top-level-body (classify-body forms senv))
 	   (output/sequence
 	    (map (lambda (expr)
-		   (compile-expr expr senv))
+		   (compile-expr-item (classify-form expr senv)))
 		 forms)))))))
-
-(define (compile-expr expr senv)
-  (compile-expr-item (classify-form expr senv)))
 
 ;;;; Classifier