From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 29 Mar 2018 04:06:23 +0000 (-0700)
Subject: Change spar pattern (elt ...) to (subform ...).
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~163
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d7d808f6a2c8b12990fc9e5a520bad304810cedb;p=mit-scheme.git

Change spar pattern (elt ...) to (subform ...).
---

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index 66da99d40..a91ff3bf6 100644
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -53,8 +53,8 @@ USA.
 			clause-pattern*
 			(spar-match-null))))))))
   `((values compare)
-    (+ (elt (cons (spar ,clause-pattern)
-		  (* any))))))
+    (+ (subform (cons (spar ,clause-pattern)
+		      (* any))))))
 
 (define (generate-cond-expand compare clauses)
 
@@ -183,12 +183,12 @@ USA.
    (delay
      (scons-rule
 	 `((or (and id (values #f))
-	       (elt id any))
+	       (subform id any))
 	   (or (and id (values #f))
 	       (and ,not (values #f))
-	       (elt id (* symbol)))
+	       (subform id (* symbol)))
 	   (or id ,not)
-	   (* (elt (list symbol id (or id (values #f))))))
+	   (* (subform (list symbol id (or id (values #f))))))
        (lambda (type-name parent maker-name maker-args pred-name field-specs)
 	 (apply scons-begin
 		(scons-define type-name
@@ -277,7 +277,7 @@ USA.
    system-global-environment))
 
 (define (let-bindings-pattern)
-  `(elt (* (elt (list id ,(optional-value-pattern))))))
+  `(subform (* (subform (list id ,(optional-value-pattern))))))
 
 (define named-let-strategy 'internal-definition)
 
@@ -328,7 +328,7 @@ USA.
   (spar-transformer->runtime
    (delay
      (scons-rule
-	 '((elt (* (elt (list id any))))
+	 '((subform (* (subform (list id any))))
 	   (+ any))
        (lambda (bindings body-forms)
 	 (expand-let* scons-let-syntax bindings body-forms))))
@@ -397,10 +397,10 @@ USA.
 		     (cons (values begin)
 			   (+ any)))))
 	   `(any
-	     (* (elt (cons (elt (* any))
-			   ,action-pattern)))
-	     (or (elt (noise-keyword else)
-		      ,action-pattern)
+	     (* (subform (cons (subform (* any))
+			       ,action-pattern)))
+	     (or (subform (noise-keyword else)
+			  ,action-pattern)
 		 (values #f))))
        (lambda (expr clauses else-clause)
 	 (let ((temp (new-identifier 'key)))
@@ -446,8 +446,8 @@ USA.
    (delay
      (scons-rule
 	 `((* ,cond-clause-pattern)
-	   (or (elt (noise-keyword else)
-		    (+ any))
+	   (or (subform (noise-keyword else)
+			(+ any))
 	       (values #f)))
        (lambda (clauses else-actions)
 	 (fold-right expand-cond-clause
@@ -458,13 +458,13 @@ USA.
    system-global-environment))
 
 (define cond-clause-pattern
-  '(elt (cons (and (not (noise-keyword else))
-		   any)
-	      (if (noise-keyword =>)
-		  (list (values =>)
-			any)
-		  (cons (values begin)
-			(* any))))))
+  '(subform (cons (and (not (noise-keyword else))
+		       any)
+		  (if (noise-keyword =>)
+		      (list (values =>)
+			    any)
+		      (cons (values begin)
+			    (* any))))))
 
 (define (expand-cond-clause clause rest)
   (let ((predicate (car clause))
@@ -490,7 +490,7 @@ USA.
   (spar-transformer->runtime
    (delay
      (scons-rule
-	 `((elt (* (elt (list id any (? any)))))
+	 `((subform (* (subform (list id any (? any)))))
 	   ,cond-clause-pattern
 	   (* any))
        (lambda (bindings test-clause actions)
@@ -604,7 +604,7 @@ USA.
   (spar-transformer->runtime
    (delay
      (scons-rule
-	 `((elt (* (list (or id (elt any) (elt id any)))))
+	 `((subform (* (list (or id (subform any) (subform id any)))))
 	   (* any))
        (lambda (clauses body-exprs)
 	 (let recur1 ((conjunct #t) (clauses clauses))
diff --git a/src/runtime/syntax-parser.scm b/src/runtime/syntax-parser.scm
index c123d0fd2..21eb56463 100644
--- a/src/runtime/syntax-parser.scm
+++ b/src/runtime/syntax-parser.scm
@@ -516,7 +516,7 @@ USA.
 		  (apply $call cons (map loop (cdr pattern))))
 		 ('('call + form)
 		  (apply $call (cadr pattern) (map loop (cddr pattern))))
-		 ('('elt * form)
+		 ('('subform * form)
 		  ($subform (apply $and (map loop (cdr pattern)))
 			    ($match-null))))))