Don't generate keyword-value-item except at top level.

They aren't needed for internal environments.

diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm
index 38ad6e38e311db3d046a965465d798caeb47ef26..cac5e142b7b8d18fd075b4432dd32e0e6109eaf4 100644 (file)
--- a/src/runtime/mit-syntax.scm
+++ b/src/runtime/mit-syntax.scm
@@ -31,33 +31,36 @@ USA.
 \f
 ;;;; Macro transformers
 
-(define (transformer-keyword name transformer->expander)
-  (lambda (form environment)
+(define (transformer-keyword procedure-name transformer->expander)
+  (lambda (form senv)
     (syntax-check '(KEYWORD EXPRESSION) form)
-    (let ((item (classify/expression (cadr form) environment)))
-      (keyword-value-item
-       (transformer->expander (transformer-eval (compile-item/expression item)
-                                               environment)
-                             environment)
-       (expr-item
-       (lambda ()
-         (output/combination (output/runtime-reference name)
-                             (list (compile-item/expression item)
-                                   (output/the-environment)))))))))
+    (let ((transformer
+          (compile-item/expression
+           (classify/expression (cadr form) senv))))
+      (let ((item
+            (transformer->expander (transformer-eval transformer senv)
+                                   senv)))
+       (if (syntactic-environment/top-level? senv)
+           (keyword-value-item
+            item
+            (expr-item
+             (lambda ()
+               (output/top-level-syntax-expander procedure-name transformer))))
+           item)))))
 
 (define classifier:sc-macro-transformer
   ;; "Syntactic Closures" transformer
-  (transformer-keyword 'SC-MACRO-TRANSFORMER->EXPANDER
+  (transformer-keyword 'sc-macro-transformer->expander
                       sc-macro-transformer->expander))
 
 (define classifier:rsc-macro-transformer
   ;; "Reversed Syntactic Closures" transformer
-  (transformer-keyword 'RSC-MACRO-TRANSFORMER->EXPANDER
+  (transformer-keyword 'rsc-macro-transformer->expander
                       rsc-macro-transformer->expander))
 
 (define classifier:er-macro-transformer
   ;; "Explicit Renaming" transformer
-  (transformer-keyword 'ER-MACRO-TRANSFORMER->EXPANDER
+  (transformer-keyword 'er-macro-transformer->expander
                       er-macro-transformer->expander))
 \f
 ;;;; Core primitives

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 7c04ffdeadc11cb25e235edcdd46533d6b1f505b..2948ab32a4de50eaa7cf4ec7a44a2ea9c25f13d5 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4531,6 +4531,7 @@ USA.
          output/top-level-definition
          output/top-level-sequence
          output/top-level-syntax-definition
+         output/top-level-syntax-expander
          output/unassigned
          output/unassigned-test
          output/unspecific

diff --git a/src/runtime/syntax-output.scm b/src/runtime/syntax-output.scm
index 58446894ca30966e1c04baca73f3b74bb758d2b9..e384dc2a6ef4a33404f14bbc6ecce9d4a43acfd5 100644 (file)
--- a/src/runtime/syntax-output.scm
+++ b/src/runtime/syntax-output.scm
@@ -59,6 +59,11 @@ USA.
 (define (output/top-level-syntax-definition name value)
   (make-scode-definition name (make-macro-reference-trap-expression value)))
 
+(define (output/top-level-syntax-expander procedure-name transformer)
+  (output/combination (output/runtime-reference procedure-name)
+                     (list transformer
+                           (output/the-environment))))
+
 (define (output/conditional predicate consequent alternative)
   (make-scode-conditional predicate consequent alternative))