From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 29 May 2018 00:55:24 +0000 (-0700)
Subject: Fill in pseudo-keywords so that they can be imported from libraries.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~2
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=afe3025a40877c377f8af970ba74d53732891aa0;p=mit-scheme.git

Fill in pseudo-keywords so that they can be imported from libraries.
---

diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm
index 8273932f5..fa030125c 100644
--- a/src/runtime/mit-syntax.scm
+++ b/src/runtime/mit-syntax.scm
@@ -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)))))
 
+;;;; 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))
+
 ;;;; MIT-specific syntax
 
 (define $access
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index faac808ce..342a12b3c 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -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