Split transformer->expander procedures into internal and external.

The external version takes a runtime environment as its closing env, while the
internal version takes a syntactic environment.

diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm
index 14d13f3d86bb74e584da5b44b710ff9500be577e..19fc2ef0337b124c9afe78aad061082dcb982829 100644 (file)
--- a/src/runtime/mit-syntax.scm
+++ b/src/runtime/mit-syntax.scm
@@ -31,34 +31,36 @@ USA.
 \f
 ;;;; Macro transformers
 
-(define (transformer-classifier procedure-name transformer->expander)
+(define (transformer-classifier transformer->keyword-item
+                               transformer->expander-name)
   (lambda (form senv hist)
     (scheck '(_ expression) form senv hist)
     (let ((transformer (compile-expr-item (classify-form-cadr form senv hist))))
-      (transformer->expander (transformer-eval transformer senv)
-                            senv
-                            (expr-item
-                             (lambda ()
-                               (output/top-level-syntax-expander
-                                procedure-name transformer)))))))
+      (transformer->keyword-item
+       (transformer-eval transformer senv)
+       senv
+       (expr-item
+       (lambda ()
+         (output/top-level-syntax-expander transformer->expander-name
+                                           transformer)))))))
 
 (define :sc-macro-transformer
   ;; "Syntactic Closures" transformer
   (classifier->runtime
-   (transformer-classifier 'sc-macro-transformer->expander
-                          sc-macro-transformer->expander)))
+   (transformer-classifier sc-macro-transformer->keyword-item
+                          'sc-macro-transformer->expander)))
 
 (define :rsc-macro-transformer
   ;; "Reversed Syntactic Closures" transformer
   (classifier->runtime
-   (transformer-classifier 'rsc-macro-transformer->expander
-                          rsc-macro-transformer->expander)))
+   (transformer-classifier rsc-macro-transformer->keyword-item
+                          'rsc-macro-transformer->expander)))
 
 (define :er-macro-transformer
   ;; "Explicit Renaming" transformer
   (classifier->runtime
-   (transformer-classifier 'er-macro-transformer->expander
-                          er-macro-transformer->expander)))
+   (transformer-classifier er-macro-transformer->keyword-item
+                          'er-macro-transformer->expander)))
 \f
 ;;;; Core primitives
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index bdeff62bf90e4ca076f402593111dab79cbb6a49..e9f1b80c5338b87ef21665d7eb57e527731d59a7 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4455,11 +4455,14 @@ USA.
          syntactic-keyword->item)
   (export (runtime syntax)
          classifier->runtime
+         er-macro-transformer->keyword-item
          keyword-item
          keyword-item-expr
          keyword-item-has-expr?
          keyword-item-impl
-         keyword-item?))
+         keyword-item?
+         rsc-macro-transformer->keyword-item
+         sc-macro-transformer->keyword-item))
 
 (define-package (runtime syntax items)
   (files "syntax-items")

diff --git a/src/runtime/syntax-low.scm b/src/runtime/syntax-low.scm
index 3a2de40ea5754c5b26c3ee4d0e2bda5af1e510e6..17d12348c6a2ec5aa7f6e02ea3b2990ec781b756 100644 (file)
--- a/src/runtime/syntax-low.scm
+++ b/src/runtime/syntax-low.scm
@@ -34,35 +34,72 @@ USA.
 ;;; These optional arguments are needed for cross-compiling 9.2->9.3.
 ;;; They can become required after 9.3 release.
 
-(define (sc-macro-transformer->expander transformer closing-env #!optional expr)
-  (expander-item (lambda (form use-senv)
-                  (close-syntax (transformer form use-senv)
-                                (->senv closing-env)))
+(define (sc-macro-transformer->expander transformer env #!optional expr)
+  (expander-item (sc-wrapper transformer (runtime-getter env))
                 expr))
 
-(define (rsc-macro-transformer->expander transformer closing-env
-                                        #!optional expr)
-  (expander-item (lambda (form use-senv)
-                  (close-syntax (transformer form (->senv closing-env))
-                                use-senv))
+(define (rsc-macro-transformer->expander transformer env #!optional expr)
+  (expander-item (rsc-wrapper transformer (runtime-getter env))
                 expr))
 
-(define (er-macro-transformer->expander transformer closing-env #!optional expr)
-  (expander-item (lambda (form use-senv)
-                  (close-syntax (transformer form
-                                             (make-er-rename
-                                              (->senv closing-env))
-                                             (make-er-compare use-senv))
-                                use-senv))
+(define (er-macro-transformer->expander transformer env #!optional expr)
+  (expander-item (er-wrapper transformer (runtime-getter env))
                 expr))
 
+(define (sc-macro-transformer->keyword-item transformer closing-senv expr)
+  (expander-item (sc-wrapper transformer (lambda () closing-senv))
+                expr))
+
+(define (rsc-macro-transformer->keyword-item transformer closing-senv expr)
+  (expander-item (rsc-wrapper transformer (lambda () closing-senv))
+                expr))
+
+(define (er-macro-transformer->keyword-item transformer closing-senv expr)
+  (expander-item (er-wrapper transformer (lambda () closing-senv))
+                expr))
+
+(define (runtime-getter env)
+  (lambda ()
+    (runtime-environment->syntactic env)))
+
+(define (sc-wrapper transformer get-closing-senv)
+  (lambda (form use-senv)
+    (close-syntax (transformer form use-senv)
+                 (get-closing-senv))))
+
+(define (rsc-wrapper transformer get-closing-senv)
+  (lambda (form use-senv)
+    (close-syntax (transformer form (get-closing-senv))
+                 use-senv)))
+
+(define (er-wrapper transformer get-closing-env)
+  (lambda (form use-senv)
+    (close-syntax (transformer form
+                              (make-er-rename (get-closing-env))
+                              (make-er-compare use-senv))
+                 use-senv)))
+
+(define (make-er-rename closing-senv)
+  (lambda (identifier)
+    (close-syntax identifier closing-senv)))
+
+(define (make-er-compare use-senv)
+  (lambda (x y)
+    (identifier=? use-senv x use-senv y)))
+\f
 ;;; Keyword items represent syntactic keywords.
 
 (define (keyword-item impl #!optional expr)
   (%keyword-item impl expr))
 
-(define (keyword-item-has-expr? item)
-  (not (default-object? (keyword-item-expr item))))
+(define (expander-item impl expr)
+  (%keyword-item (lambda (form senv hist)
+                  (reclassify (with-error-context form senv hist
+                                (lambda ()
+                                  (impl form senv)))
+                              senv
+                              hist))
+                expr))
 
 (define-record-type <keyword-item>
     (%keyword-item impl expr)
@@ -70,31 +107,12 @@ USA.
   (impl keyword-item-impl)
   (expr keyword-item-expr))
 
-(define (expander-item impl expr)
-  (keyword-item (lambda (form senv hist)
-                 (reclassify (with-error-context form senv hist
-                               (lambda ()
-                                 (impl form senv)))
-                             senv
-                             hist))
-               expr))
+(define (keyword-item-has-expr? item)
+  (not (default-object? (keyword-item-expr item))))
 
 (define (classifier->runtime classifier)
   (make-unmapped-macro-reference-trap (keyword-item classifier)))
 
-(define (->senv env)
-  (if (syntactic-environment? env)
-      env
-      (runtime-environment->syntactic env)))
-
-(define (make-er-rename closing-senv)
-  (lambda (identifier)
-    (close-syntax identifier closing-senv)))
-
-(define (make-er-compare use-senv)
-  (lambda (x y)
-    (identifier=? use-senv x use-senv y)))
-
 (define (syntactic-keyword->item keyword environment)
   (let ((item (environment-lookup-macro environment keyword)))
     (if (not item)