From d3036ed946d60d5fee5d85784ab7985862c2c159 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 18 Mar 2018 20:38:53 -0700
Subject: [PATCH] Simplify spar interface a bit more.

---
 src/runtime/mit-macros.scm    |  6 +++---
 src/runtime/mit-syntax.scm    | 37 +++++++++++++++--------------------
 src/runtime/runtime.pkg       |  2 --
 src/runtime/syntax-parser.scm | 18 +++++------------
 4 files changed, 24 insertions(+), 39 deletions(-)

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index 9ae619f4c..ade5c1e71 100644
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -238,13 +238,13 @@ USA.
 		   ,@vals))))
        (spar-elt)
        (spar-push spar-arg:close)
-       (spar-or (spar-elt spar-push-id)
+       (spar-or (spar-push-elt-if identifier? spar-arg:form)
 		(spar-push '#f))
        (spar-elt
-	 (spar-push-values
+	 (spar-call-with-values list
 	  (spar* (spar-elt
 		   (spar-call-with-values cons
-		     (spar-elt spar-push-id)
+		     (spar-push-elt-if identifier? spar-arg:form)
 		     (spar-or (spar-push-elt spar-arg:form)
 			      (spar-push-value unassigned-expression)))
 		   spar-match-null))
diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm
index 7d6ee8000..c9b6a4822 100644
--- a/src/runtime/mit-syntax.scm
+++ b/src/runtime/mit-syntax.scm
@@ -190,7 +190,7 @@ USA.
 		 (syntax-defn-item id (keyword-item-expr item))
 		 (seq-item '()))))
        (spar-elt)
-       (spar-elt spar-push-id)
+       (spar-push-elt-if identifier? spar-arg:form)
        (spar-push spar-arg:senv)
        (spar-elt
 	 spar-push-classified
@@ -208,9 +208,7 @@ USA.
 	 (lambda (bvl body senv)
 	   (assemble-lambda-item scode-lambda-name:unnamed bvl body senv))
        (spar-elt)
-       (spar-elt
-	 (spar-match mit-lambda-list? spar-arg:form)
-	 (spar-push spar-arg:form))
+       (spar-push-elt-if mit-lambda-list? spar-arg:form)
        spar-push-body))))
 
 (define :named-lambda
@@ -221,9 +219,8 @@ USA.
 	   (assemble-lambda-item (identifier->symbol name) bvl body senv))
        (spar-elt)
        (spar-elt
-	 (spar-elt spar-push-id)
-	 (spar-match mit-lambda-list? spar-arg:form)
-	 (spar-push spar-arg:form))
+	 (spar-push-elt-if identifier? spar-arg:form)
+	 (spar-push-if mit-lambda-list? spar-arg:form))
        spar-push-body))))
 
 (define (assemble-lambda-item name bvl body senv)
@@ -248,10 +245,10 @@ USA.
 	    (seq-item (body frame-senv))))
       (spar-elt)
       (spar-elt
-	(spar-push-values
+	(spar-call-with-values list
 	 (spar*
 	   (spar-call-with-values cons
-	     (spar-elt (spar-elt spar-push-id)
+	     (spar-elt (spar-push-elt-if identifier? spar-arg:form)
 		       (spar-elt spar-push-classified)
 		       spar-match-null))))
 	spar-match-null)
@@ -282,10 +279,10 @@ USA.
 	    (seq-item (body frame-senv))))
       (spar-elt)
       (spar-elt
-	 (spar-push-values
+	 (spar-call-with-values list
 	   (spar*
 	     (spar-call-with-values cons
-	       (spar-elt (spar-elt spar-push-id)
+	       (spar-elt (spar-push-elt-if identifier? spar-arg:form)
 			 (spar-elt spar-push-open-classified)
 			 spar-match-null))))
 	 spar-match-null)
@@ -304,7 +301,7 @@ USA.
    (delay
      (spar-call-with-values access-item
        (spar-elt)
-       (spar-elt spar-push-id)
+       (spar-push-elt-if identifier? spar-arg:form)
        (spar-elt spar-push-classified)
        spar-match-null))))
 
@@ -360,15 +357,13 @@ USA.
        (spar-elt)
        (spar-push spar-arg:senv)
        (spar-push spar-arg:hist)
-       (spar-push-values
-	(spar*
-	  (spar-elt
-	    (spar-match (lambda (form)
-			  (and (pair? form)
-			       (identifier? (car form))
-			       (list? (cdr form))))
-			spar-arg:form)
-	    (spar-push spar-arg:form))))
+       (spar-call-with-values list
+	 (spar*
+	   (spar-push-elt-if (lambda (form)
+			       (and (pair? form)
+				    (identifier? (car form))
+				    (list? (cdr form))))
+			     spar-arg:form)))
        spar-match-null))))
 
 (define (classify-id id senv hist)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index ed7142cab..b2d1f5b72 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4572,10 +4572,8 @@ USA.
 	  spar-push-body
 	  spar-push-elt
 	  spar-push-elt-if
-	  spar-push-id
 	  spar-push-if
 	  spar-push-value
-	  spar-push-values
 	  spar-repeat
 	  spar-seq
 	  spar-succeed
diff --git a/src/runtime/syntax-parser.scm b/src/runtime/syntax-parser.scm
index 4828c30e6..c5f834746 100644
--- a/src/runtime/syntax-parser.scm
+++ b/src/runtime/syntax-parser.scm
@@ -336,11 +336,14 @@ USA.
 		failure)
 	  (failure)))))
 
+(define (spar-match-elt predicate . args)
+  (spar-elt (apply spar-match predicate args)))
+
 (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 (spar-push-elt-if predicate . args)
+  (spar-elt (apply spar-push-if predicate args)))
 
 (define-deferred spar-match-null
   (spar-match null? spar-arg:form))
@@ -380,20 +383,9 @@ USA.
 		   spar-arg:form
 		   spar-arg:senv
 		   spar-arg:hist))
-
-(define-deferred spar-push-id
-  (spar-seq
-    (spar-match identifier? spar-arg:form)
-    (spar-push spar-arg:form)
-    spar-discard-form))
 
 ;;;; Value combinators
 
-(define (spar-push-values . spars)
-  (%with-output (lambda (output output*)
-		  (%output-push output (%output-all output*)))
-		spars))
-
 (define (spar-encapsulate-values procedure . spars)
   (%encapsulate procedure spars))
 
-- 
2.25.1