From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 7 Mar 2018 01:46:34 +0000 (-0800)
Subject: More tweaks to syntax-parser interface.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~219
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=99adc09499b5f06a07c490d437972f5086d362f2;p=mit-scheme.git

More tweaks to syntax-parser interface.
---

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 82727d6da..b371eb8a9 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4560,8 +4560,10 @@ USA.
 	  spar-or
 	  spar-push
 	  spar-push-body
+	  spar-push-elt
+	  spar-push-elt-if
 	  spar-push-id
-	  spar-push-id=
+	  spar-push-if
 	  spar-push-value
 	  spar-push-values
 	  spar-repeat
diff --git a/src/runtime/syntax-parser.scm b/src/runtime/syntax-parser.scm
index af4388dba..4828c30e6 100644
--- a/src/runtime/syntax-parser.scm
+++ b/src/runtime/syntax-parser.scm
@@ -184,6 +184,10 @@ USA.
 	     (%output-push-all output (%subst-args input senv output args))
 	     failure)))
 
+(define (spar-push-if predicate . args)
+  (spar-seq (apply spar-match predicate args)
+	    (apply spar-push args)))
+
 (define (spar-push-value procedure . args)
   (lambda (input senv output success failure)
     (success input
@@ -332,6 +336,12 @@ USA.
 		failure)
 	  (failure)))))
 
+(define (spar-push-elt . args)
+  (spar-elt (apply spar-push args)))
+
+(define (spar-push-elt-if . args)
+  (spar-elt (apply spar-push-if args)))
+
 (define-deferred spar-match-null
   (spar-match null? spar-arg:form))
 
@@ -376,16 +386,6 @@ USA.
     (spar-match identifier? spar-arg:form)
     (spar-push spar-arg:form)
     spar-discard-form))
-
-(define (spar-push-id= id)
-  (spar-seq
-    (spar-match (lambda (form senv)
-		  (and (identifier? form)
-		       (identifier=? senv form senv id)))
-		spar-arg:form
-		spar-arg:senv)
-    (spar-push spar-arg:form)
-    spar-discard-form))
 
 ;;;; Value combinators