Fill in pseudo-keywords so that they can be imported from libraries.
authorChris Hanson <org/chris-hanson/cph>
Tue, 29 May 2018 00:55:24 +0000 (17:55 -0700)
committerChris Hanson <org/chris-hanson/cph>
Tue, 29 May 2018 00:55:24 +0000 (17:55 -0700)
src/runtime/mit-syntax.scm
src/runtime/runtime.pkg

index 8273932f516aaad6cdb34fa04bf89c865c616dc1..fa030125c86d486891cad4dbf0ca90dc6c6be49d 100644 (file)
@@ -291,22 +291,22 @@ USA.
   (spar-classifier->runtime
    (delay
      (spar-call-with-values
-       (lambda (ctx bindings body-ctx body)
-         (let ((frame-senv (make-internal-senv (serror-ctx-senv ctx)))
-               (ids (map car bindings)))
-           (for-each (lambda (id)
-                       (reserve-identifier id frame-senv))
-                     ids)
-           (for-each (lambda (id item)
-                       (bind-keyword id frame-senv item))
-                     ids
-                     (map (lambda (binding)
-                            ((cdr binding) frame-senv))
-                          bindings))
-           (seq-item body-ctx (body frame-senv))))
-      (spar-subform)
-      (spar-push spar-arg:ctx)
-      (spar-subform
+        (lambda (ctx bindings body-ctx body)
+          (let ((frame-senv (make-internal-senv (serror-ctx-senv ctx)))
+                (ids (map car bindings)))
+            (for-each (lambda (id)
+                        (reserve-identifier id frame-senv))
+                      ids)
+            (for-each (lambda (id item)
+                        (bind-keyword id frame-senv item))
+                      ids
+                      (map (lambda (binding)
+                             ((cdr binding) frame-senv))
+                           bindings))
+            (seq-item body-ctx (body frame-senv))))
+       (spar-subform)
+       (spar-push spar-arg:ctx)
+       (spar-subform
         (spar-call-with-values list
           (spar*
             (spar-call-with-values cons
@@ -316,6 +316,30 @@ USA.
         (spar-match-null))
        (spar-push-body)))))
 \f
+;;;; Pseudo keywords
+
+(define (pseudo-keyword-classifier form senv hist)
+  (serror (serror-ctx form senv hist)
+         "Special keyword can't be expanded:" form))
+
+(define $...
+  (classifier->runtime pseudo-keyword-classifier))
+
+(define $=>
+  (classifier->runtime pseudo-keyword-classifier))
+
+(define $_
+  (classifier->runtime pseudo-keyword-classifier))
+
+(define $else
+  (classifier->runtime pseudo-keyword-classifier))
+
+(define $unquote
+  (classifier->runtime pseudo-keyword-classifier))
+
+(define $unquote-splicing
+  (classifier->runtime pseudo-keyword-classifier))
+\f
 ;;;; MIT-specific syntax
 
 (define $access
index faac808ce2bc0b238ebe88fde4d85e2ad9df759d..342a12b3cceaddffcee9b0ea4d71c6725ec540e2 100644 (file)
@@ -4734,11 +4734,15 @@ USA.
   (files "mit-syntax")
   (parent (runtime syntax))
   (export ()
+         (... $...)                    ;R7RS
+         (=> $=>)                      ;R7RS
+         (_ $_)                        ;R7RS
          (access $access)
          (begin $begin)                ;R7RS
          (declare $declare)
          (define-syntax $define-syntax) ;R7RS
-         (delay $delay)                 ;R7RS
+         (delay $delay)                ;R7RS
+         (else $else)                  ;R7RS
          (er-macro-transformer $er-macro-transformer)
          (if $if)                      ;R7RS
          (lambda $lambda)              ;R7RS
@@ -4752,7 +4756,10 @@ USA.
          (sc-macro-transformer $sc-macro-transformer)
          (set! $set!)                  ;R7RS
          (spar-macro-transformer $spar-macro-transformer)
-         (the-environment $the-environment))
+         (the-environment $the-environment)
+         (unquote $unquote)            ;R7RS
+         (unquote-splicing $unquote-splicing) ;R7RS
+         )
   (export (runtime mit-macros)
          keyword:define
          keyword:let-syntax