Implement spar-macro-transformer.

diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm
index 19fc2ef0337b124c9afe78aad061082dcb982829..b4e69ab0b7cecc4d7124f198b0bf142e475e76f4 100644 (file)
--- a/src/runtime/mit-syntax.scm
+++ b/src/runtime/mit-syntax.scm
@@ -61,6 +61,12 @@ USA.
   (classifier->runtime
    (transformer-classifier er-macro-transformer->keyword-item
                           'er-macro-transformer->expander)))
+
+(define :spar-macro-transformer
+  ;; "Syntax PARser" transformer
+  (classifier->runtime
+   (transformer-classifier spar-macro-transformer->keyword-item
+                          'spar-macro-transformer->expander)))
 \f
 ;;;; Core primitives
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index e9f1b80c5338b87ef21665d7eb57e527731d59a7..edfa5e368426914ac437d6f0ecd86e5e342c2aed 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4452,6 +4452,7 @@ USA.
          er-macro-transformer->expander
          rsc-macro-transformer->expander
          sc-macro-transformer->expander
+         spar-macro-transformer->expander
          syntactic-keyword->item)
   (export (runtime syntax)
          classifier->runtime
@@ -4462,7 +4463,8 @@ USA.
          keyword-item-impl
          keyword-item?
          rsc-macro-transformer->keyword-item
-         sc-macro-transformer->keyword-item))
+         sc-macro-transformer->keyword-item
+         spar-macro-transformer->keyword-item))
 
 (define-package (runtime syntax items)
   (files "syntax-items")
@@ -4639,6 +4641,7 @@ USA.
          (rsc-macro-transformer :rsc-macro-transformer)
          (sc-macro-transformer :sc-macro-transformer)
          (set! :set!)
+         (spar-macro-transformer :spar-macro-transformer)
          (the-environment :the-environment))
   (export (runtime mit-macros)
          keyword:access

diff --git a/src/runtime/syntax-low.scm b/src/runtime/syntax-low.scm
index 17d12348c6a2ec5aa7f6e02ea3b2990ec781b756..c05c9d80910b19eb651e7f1a917020b0a7f1ac64 100644 (file)
--- a/src/runtime/syntax-low.scm
+++ b/src/runtime/syntax-low.scm
@@ -38,44 +38,40 @@ USA.
   (expander-item (sc-wrapper transformer (runtime-getter env))
                 expr))
 
-(define (rsc-macro-transformer->expander transformer env #!optional expr)
-  (expander-item (rsc-wrapper transformer (runtime-getter env))
-                expr))
-
-(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-macro-transformer->expander transformer env #!optional expr)
+  (expander-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))
+
 (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)
+(define (er-macro-transformer->expander transformer env #!optional expr)
+  (expander-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))
+
+(define (er-wrapper transformer get-closing-senv)
   (lambda (form use-senv)
     (close-syntax (transformer form
-                              (make-er-rename (get-closing-env))
+                              (make-er-rename (get-closing-senv))
                               (make-er-compare use-senv))
                  use-senv)))
 
@@ -86,6 +82,25 @@ USA.
 (define (make-er-compare use-senv)
   (lambda (x y)
     (identifier=? use-senv x use-senv y)))
+
+(define (spar-macro-transformer->expander spar env expr)
+  (keyword-item (spar-wrapper spar (runtime-getter env))
+               expr))
+
+(define (spar-macro-transformer->keyword-item spar closing-senv expr)
+  (keyword-item (spar-wrapper spar (lambda () closing-senv))
+               expr))
+
+(define (spar-wrapper spar get-closing-senv)
+  (lambda (form senv hist)
+    (reclassify (close-syntax ((spar->classifier spar) form senv hist)
+                             (get-closing-senv))
+               senv
+               hist)))
+
+(define (runtime-getter env)
+  (lambda ()
+    (runtime-environment->syntactic env)))
 \f
 ;;; Keyword items represent syntactic keywords.
 

diff --git a/src/runtime/syntax-parser.scm b/src/runtime/syntax-parser.scm
index a8d98d037e7ef45b0e6444f0126c6a263181bf8c..4da6494ebf06f961eaf925df3a47d67d20c69ff6 100644 (file)
--- a/src/runtime/syntax-parser.scm
+++ b/src/runtime/syntax-parser.scm
@@ -65,18 +65,17 @@ USA.
 ;;;     (failure)
 
 (define (spar->classifier spar)
-  (keyword-item
-   (lambda (form senv hist)
-     (spar (%new-input form hist)
-          senv
-          (%new-output)
-          (lambda (input senv output failure)
-            (declare (ignore senv failure))
-            (if (%input-null? input)
-                (error "Rule failed to match entire form."))
-            (output 'get-only))
-          (lambda ()
-            (serror form senv hist "Ill-formed syntax:" form))))))
+  (lambda (form senv hist)
+    (spar (%new-input form hist)
+         senv
+         (%new-output)
+         (lambda (input senv output failure)
+           (declare (ignore senv failure))
+           (if (%input-null? input)
+               (error "Rule failed to match entire form."))
+           (output 'get-only))
+         (lambda ()
+           (serror form senv hist "Ill-formed syntax:" form)))))
 \f
 ;;;; Inputs and outputs