Eliminate classify-expr.

diff --git a/src/edwin/clsmac.scm b/src/edwin/clsmac.scm
index 6ee1257ce9fd6f11b268cf9f87b7027a4d876ee5..f29d2262e085d6eb97dbcefc49ee03169f1e11bf 100644 (file)
--- 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 10a0fd13b36e5e63bfd1565bd5ee2dbcbaffe7a6..5894b7d2180bfeacef07507e197740168c69d6a9 100644 (file)
--- 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 9d1e5aba3bf11e203c2db44ce8d49da243cd14ad..f55249f8b59086922e598553efb9aa47ff7af613 100644 (file)
--- 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 558f10264b627c5697671d2357006350bf3adc84..c6b0da755a0e18dd731d5fe29206c7793740a686 100644 (file)
--- 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))))
 \f
 ;;;; 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 2ae00bf35c111d1934197d516f46578c5cd318e5..17281229c253a663bbaa82f7671f812c3101489f 100644 (file)
--- 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 e560dc16ff80b6fe6e0601c0a8ab7dba70c95095..9b59586571b41f0d6d6d738c01a4eeb33c9f2713 100644 (file)
--- 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)))
 \f
 ;;;; Classifier