Some more tweaks to the low-level macro interfaces.

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index 9b8f6a474f7ff005bdc404fdb65f265d6a0d882b..5c9f065b0b01f477b71dda87523cada72cb803f6 100644 (file)
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -143,9 +143,6 @@ USA.
                     (car p)))
              supported-features))
 \f
-(define (get-closing-env)
-  (runtime-environment->syntactic system-global-environment))
-
 (define :receive
   (spar-transformer->runtime
    (delay
@@ -161,7 +158,7 @@ USA.
        (spar-push-elt spar-arg:form)
        (spar+ (spar-push-elt spar-arg:form))
        spar-match-null))
-   get-closing-env))
+   system-global-environment))
 
 (define-syntax :define-record-type
   (er-macro-transformer
@@ -245,7 +242,7 @@ USA.
          spar-match-null))
        (spar+ (spar-push-elt spar-arg:form))
        spar-match-null))
-   get-closing-env))
+   system-global-environment))
 
 (define named-let-strategy 'internal-definition)
 

diff --git a/src/runtime/syntax-low.scm b/src/runtime/syntax-low.scm
index a1e912aa808a18dfbbc03a17fc32c0a6f55c9897..f55945110251fcf50e6273572f022c0dfe851421 100644 (file)
--- a/src/runtime/syntax-low.scm
+++ b/src/runtime/syntax-low.scm
@@ -35,48 +35,54 @@ USA.
 ;;; They can become required after 9.3 release.
 
 (define (sc-macro-transformer->expander transformer env #!optional expr)
-  (expander-item (sc-wrapper transformer (runtime-getter env))
-                expr))
+  (keyword-item (sc-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))
+  (keyword-item (sc-wrapper transformer (lambda () closing-senv))
+               expr))
 
 (define (sc-wrapper transformer get-closing-senv)
-  (wrap-no-hist
-   (lambda (form use-senv)
-     (close-syntax (transformer form use-senv)
-                  (get-closing-senv)))))
+  (lambda (form use-senv hist)
+    (reclassify (with-error-context form use-senv hist
+                 (lambda ()
+                   (transformer form use-senv)))
+               (get-closing-senv)
+               hist)))
 
 (define (rsc-macro-transformer->expander transformer env #!optional expr)
-  (expander-item (rsc-wrapper transformer (runtime-getter env))
-                expr))
+  (keyword-item (rsc-wrapper transformer (runtime-getter env))
+               expr))
 
 (define (rsc-macro-transformer->keyword-item transformer closing-senv expr)
-  (expander-item (rsc-wrapper transformer (lambda () closing-senv))
-                expr))
+  (keyword-item (rsc-wrapper transformer (lambda () closing-senv))
+               expr))
 
 (define (rsc-wrapper transformer get-closing-senv)
-  (wrap-no-hist
-   (lambda (form use-senv)
-     (close-syntax (transformer form (get-closing-senv))
-                  use-senv))))
+  (lambda (form use-senv hist)
+    (reclassify (with-error-context form use-senv hist
+                 (lambda ()
+                   (transformer form (get-closing-senv))))
+               use-senv
+               hist)))
 
 (define (er-macro-transformer->expander transformer env #!optional expr)
-  (expander-item (er-wrapper transformer (runtime-getter env))
-                expr))
+  (keyword-item (er-wrapper transformer (runtime-getter env))
+               expr))
 
 (define (er-macro-transformer->keyword-item transformer closing-senv expr)
-  (expander-item (er-wrapper transformer (lambda () closing-senv))
-                expr))
+  (keyword-item (er-wrapper transformer (lambda () closing-senv))
+               expr))
 
 (define (er-wrapper transformer get-closing-senv)
-  (wrap-no-hist
-   (lambda (form use-senv)
-     (close-syntax (transformer form
-                               (make-er-rename (get-closing-senv))
-                               (make-er-compare use-senv))
-                  use-senv))))
+  (lambda (form use-senv hist)
+    (reclassify (with-error-context form use-senv hist
+                 (lambda ()
+                   (transformer form
+                                (make-er-rename (get-closing-senv))
+                                (make-er-compare use-senv))))
+               use-senv
+               hist)))
 
 (define (make-er-rename closing-senv)
   (lambda (identifier)
@@ -87,15 +93,18 @@ USA.
     (identifier=? use-senv x use-senv y)))
 
 (define (spar-macro-transformer->expander spar env expr)
-  (expander-item (spar-wrapper spar (runtime-getter env))
-                expr))
+  (keyword-item (spar-wrapper spar (runtime-getter env))
+               expr))
 
 (define (spar-macro-transformer->keyword-item spar closing-senv expr)
-  (expander-item (spar-wrapper spar (lambda () closing-senv))
-                expr))
+  (keyword-item (spar-wrapper spar (lambda () closing-senv))
+               expr))
 
 (define (spar-wrapper spar get-closing-senv)
-  (spar-transformer-promise-caller (delay spar) get-closing-senv))
+  (lambda (form use-senv hist)
+    (reclassify (spar-call spar form use-senv hist (get-closing-senv))
+               use-senv
+               hist)))
 
 (define (runtime-getter env)
   (lambda ()
@@ -115,22 +124,6 @@ USA.
 (define (keyword-item-has-expr? item)
   (not (default-object? (keyword-item-expr item))))
 
-(define (expander-item transformer expr)
-  (keyword-item (transformer->classifier transformer)
-               expr))
-
-(define (transformer->classifier transformer)
-  (lambda (form senv hist)
-    (reclassify (transformer form senv hist)
-               senv
-               hist)))
-
-(define (wrap-no-hist transformer)
-  (lambda (form senv hist)
-    (with-error-context form senv hist
-      (lambda ()
-       (transformer form senv)))))
-
 (define (classifier->runtime classifier)
   (make-unmapped-macro-reference-trap (keyword-item classifier)))
 
@@ -149,14 +142,16 @@ USA.
   (lambda (form senv hist)
     (spar-call (force promise) form senv hist senv)))
 
-(define (spar-transformer->runtime promise get-closing-senv)
+(define (spar-transformer->runtime promise env)
   (classifier->runtime
-   (transformer->classifier
-    (spar-transformer-promise-caller promise get-closing-senv))))
-
-(define (spar-transformer-promise-caller promise get-closing-senv)
-  (lambda (form use-senv hist)
-    (spar-call (force promise) form use-senv hist (get-closing-senv))))
+   (lambda (form use-senv hist)
+     (reclassify (spar-call (force promise)
+                           form
+                           use-senv
+                           hist
+                           (runtime-environment->syntactic env))
+                use-senv
+                hist))))
 
 (define (syntactic-keyword->item keyword environment)
   (let ((item (environment-lookup-macro environment keyword)))