Rename spar*elt* to spar*subform*.

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index fa76f96c58e0c958d44232b20ccf5f017a90b2eb..66da99d40495950e93c9d7142b338fe2c51450d9 100644 (file)
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -39,17 +39,17 @@ USA.
   (define clause-pattern
     (let ((clause-pattern* (lambda args (apply clause-pattern args))))
       (spar-or
-       (spar-push-elt-if identifier? spar-arg:form)
-       (spar-elt
+       (spar-push-subform-if identifier? spar-arg:form)
+       (spar-subform
          (spar-call-with-values list
            (spar-or
-             (spar-and (spar-push-elt-if spar-arg:compare 'or spar-arg:form)
+             (spar-and (spar-push-subform-if spar-arg:compare 'or spar-arg:form)
                        (spar* clause-pattern*)
                        (spar-match-null))
-             (spar-and (spar-push-elt-if spar-arg:compare 'and spar-arg:form)
+             (spar-and (spar-push-subform-if spar-arg:compare 'and spar-arg:form)
                        (spar* clause-pattern*)
                        (spar-match-null))
-             (spar-and (spar-push-elt-if spar-arg:compare 'not spar-arg:form)
+             (spar-and (spar-push-subform-if spar-arg:compare 'not spar-arg:form)
                        clause-pattern*
                        (spar-match-null))))))))
   `((values compare)
@@ -236,8 +236,8 @@ USA.
           (scons-call keyword:define name value)))
        (scons-rule
           `((spar
-             ,(spar-elt
-                (spar-push-elt-if identifier? spar-arg:form)
+             ,(spar-subform
+                (spar-push-subform-if identifier? spar-arg:form)
                 (spar-push-form-if mit-lambda-list? spar-arg:form)))
             (+ any))
         (lambda (name bvl body-forms)
@@ -245,8 +245,8 @@ USA.
             (apply scons-named-lambda (cons name bvl) body-forms))))
        (scons-rule
           `((spar
-             ,(spar-elt
-                (spar-push-elt)
+             ,(spar-subform
+                (spar-push-subform)
                 (spar-push-form-if mit-lambda-list? spar-arg:form)))
             (+ any))
         (lambda (nested bvl body-forms)

diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm
index f9273a8262b305b5295dab12e7f6e6702aadead3..678b5479e08dd4d44013cbcc30056b243d17649e 100644 (file)
--- a/src/runtime/mit-syntax.scm
+++ b/src/runtime/mit-syntax.scm
@@ -81,20 +81,20 @@ USA.
           (seq-item ctx
             (map-in-order (lambda (p) (p))
                           deferred-items)))
-       (spar-elt)
+       (spar-subform)
        (spar-push spar-arg:ctx)
-       (spar* (spar-elt spar-push-deferred-classified))
+       (spar* (spar-subform spar-push-deferred-classified))
        (spar-match-null)))))
 
 (define :if
   (spar-classifier->runtime
    (delay
      (spar-call-with-values if-item
-       (spar-elt)
+       (spar-subform)
        (spar-push spar-arg:ctx)
-       (spar-elt spar-push-classified)
-       (spar-elt spar-push-classified)
-       (spar-or (spar-elt spar-push-classified)
+       (spar-subform spar-push-classified)
+       (spar-subform spar-push-classified)
+       (spar-or (spar-subform spar-push-classified)
                (spar-push-value unspecific-item spar-arg:ctx))
        (spar-match-null)))))
 
@@ -102,18 +102,18 @@ USA.
   (spar-classifier->runtime
    (delay
      (spar-call-with-values constant-item
-       (spar-elt)
+       (spar-subform)
        (spar-push spar-arg:ctx)
-       (spar-elt (spar-push-value strip-syntactic-closures spar-arg:form))
+       (spar-subform (spar-push-value strip-syntactic-closures spar-arg:form))
        (spar-match-null)))))
 
 (define :quote-identifier
   (spar-classifier->runtime
    (delay
      (spar-call-with-values quoted-id-item
-       (spar-elt)
+       (spar-subform)
        (spar-push spar-arg:ctx)
-       (spar-elt
+       (spar-subform
         (spar-match identifier? spar-arg:form)
         (spar-push-value lookup-identifier spar-arg:form spar-arg:senv)
         (spar-or (spar-match var-item? spar-arg:value)
@@ -132,9 +132,9 @@ USA.
                                       (access-item-name lhs-item)
                                       (access-item-env lhs-item)
                                       rhs-item)))
-       (spar-elt)
+       (spar-subform)
        (spar-push spar-arg:ctx)
-       (spar-elt
+       (spar-subform
         spar-push-classified
         (spar-or (spar-match (lambda (lhs-item)
                                (or (var-item? lhs-item)
@@ -142,7 +142,7 @@ USA.
                              spar-arg:value)
                  (spar-error "Variable required in this context:"
                              spar-arg:form)))
-       (spar-or (spar-elt spar-push-classified)
+       (spar-or (spar-subform spar-push-classified)
                (spar-push-value unassigned-item spar-arg:ctx))
        (spar-match-null)))))
 
@@ -154,18 +154,18 @@ USA.
   (spar-classifier->runtime
    (delay
      (spar-call-with-values or-item
-       (spar-elt)
+       (spar-subform)
        (spar-push spar-arg:ctx)
-       (spar* (spar-elt spar-push-classified))
+       (spar* (spar-subform spar-push-classified))
        (spar-match-null)))))
 
 (define :delay
   (spar-classifier->runtime
    (delay
      (spar-call-with-values delay-item
-       (spar-elt)
+       (spar-subform)
        (spar-push spar-arg:ctx)
-       (spar-elt spar-push-deferred-classified)
+       (spar-subform spar-push-deferred-classified)
        (spar-match-null)))))
 \f
 ;;;; Definitions
@@ -174,12 +174,12 @@ USA.
   (spar-classifier->keyword
    (delay
      (spar-call-with-values defn-item
-       (spar-elt)
+       (spar-subform)
        (spar-push spar-arg:ctx)
-       (spar-elt
+       (spar-subform
         (spar-match identifier? spar-arg:form)
         (spar-push-value bind-variable spar-arg:form spar-arg:senv))
-       (spar-elt spar-push-classified)
+       (spar-subform spar-push-classified)
        (spar-match-null)))))
 
 (define :define-syntax
@@ -198,10 +198,10 @@ USA.
                      (senv-top-level? senv))
                 (syntax-defn-item ctx id (keyword-item-expr item))
                 (seq-item ctx '()))))
-       (spar-elt)
+       (spar-subform)
        (spar-push spar-arg:ctx)
-       (spar-push-elt-if identifier? spar-arg:form)
-       (spar-elt
+       (spar-push-subform-if identifier? spar-arg:form)
+       (spar-subform
         spar-push-classified
         (spar-or (spar-match keyword-item? spar-arg:value)
                  (spar-error "Keyword binding value must be a keyword:"
@@ -217,9 +217,9 @@ USA.
         (lambda (ctx bvl body-ctx body)
           (assemble-lambda-item ctx scode-lambda-name:unnamed bvl
                                 body-ctx body))
-       (spar-elt)
+       (spar-subform)
        (spar-push spar-arg:ctx)
-       (spar-push-elt-if mit-lambda-list? spar-arg:form)
+       (spar-push-subform-if mit-lambda-list? spar-arg:form)
        (spar-push-body)))))
 
 (define :named-lambda
@@ -229,10 +229,10 @@ USA.
         (lambda (ctx name bvl body-ctx body)
           (assemble-lambda-item ctx (identifier->symbol name) bvl
                                 body-ctx body))
-       (spar-elt)
+       (spar-subform)
        (spar-push spar-arg:ctx)
-       (spar-elt
-        (spar-push-elt-if identifier? spar-arg:form)
+       (spar-subform
+        (spar-push-subform-if identifier? spar-arg:form)
         (spar-push-form-if mit-lambda-list? spar-arg:form))
        (spar-push-body)))))
 
@@ -245,7 +245,7 @@ USA.
            (let ((body-senv (make-internal-senv frame-senv)))
              (map-in-order (lambda (elt) (elt body-senv))
                            elts))))
-      (spar+ (spar-elt spar-push-open-classified))
+      (spar+ (spar-subform spar-push-open-classified))
       (spar-match-null))))
 
 (define (assemble-lambda-item ctx name bvl body-ctx body)
@@ -269,15 +269,15 @@ USA.
                        (bind-keyword (car binding) frame-senv (cdr binding)))
                      bindings)
            (seq-item body-ctx (body frame-senv))))
-      (spar-elt)
+      (spar-subform)
       (spar-push spar-arg:ctx)
-      (spar-elt
+      (spar-subform
        (spar-call-with-values list
         (spar*
           (spar-call-with-values cons
-            (spar-elt (spar-push-elt-if identifier? spar-arg:form)
-                      (spar-elt spar-push-classified)
-                      (spar-match-null)))))
+            (spar-subform (spar-push-subform-if identifier? spar-arg:form)
+                          (spar-subform spar-push-classified)
+                          (spar-match-null)))))
        (spar-match-null))
        (spar-push-body))))
 
@@ -304,15 +304,15 @@ USA.
                             ((cdr binding) frame-senv))
                           bindings))
            (seq-item body-ctx (body frame-senv))))
-      (spar-elt)
+      (spar-subform)
       (spar-push spar-arg:ctx)
-      (spar-elt
+      (spar-subform
         (spar-call-with-values list
           (spar*
             (spar-call-with-values cons
-              (spar-elt (spar-push-elt-if identifier? spar-arg:form)
-                        (spar-elt spar-push-open-classified)
-                        (spar-match-null)))))
+              (spar-subform (spar-push-subform-if identifier? spar-arg:form)
+                            (spar-subform spar-push-open-classified)
+                            (spar-match-null)))))
         (spar-match-null))
        (spar-push-body)))))
 \f
@@ -329,10 +329,10 @@ USA.
   (spar-classifier->keyword
    (delay
      (spar-call-with-values access-item
-       (spar-elt)
+       (spar-subform)
        (spar-push spar-arg:ctx)
-       (spar-push-elt-if identifier? spar-arg:form)
-       (spar-elt spar-push-classified)
+       (spar-push-subform-if identifier? spar-arg:form)
+       (spar-subform spar-push-classified)
        (spar-match-null)))))
 
 (define-expr-item-compiler access-item?
@@ -347,7 +347,7 @@ USA.
        (spar-or (spar-match senv-top-level? spar-arg:senv)
                (spar-error "This form allowed only at top level:"
                            spar-arg:form spar-arg:senv))
-       (spar-elt)
+       (spar-subform)
        (spar-match-null)
        (spar-push-value the-environment-item spar-arg:ctx)))))
 
@@ -355,7 +355,7 @@ USA.
   (spar-classifier->keyword
    (delay
      (spar-and
-       (spar-elt)
+       (spar-subform)
        (spar-match-null)
        (spar-push-value unspecific-item spar-arg:ctx)))))
 
@@ -363,7 +363,7 @@ USA.
   (spar-classifier->keyword
    (delay
      (spar-and
-       (spar-elt)
+       (spar-subform)
        (spar-match-null)
        (spar-push-value unassigned-item spar-arg:ctx)))))
 \f
@@ -387,15 +387,15 @@ USA.
                                       decl))
                       decls
                       (hist-cadr hist))))))
-       (spar-elt)
+       (spar-subform)
        (spar-push spar-arg:ctx)
        (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-push-subform-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 25a1723a6d383cfcea19b86d53d72e916077b6a3..322738e95a2bbaee4a58111e126ea7cde50da2a6 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4559,7 +4559,6 @@ USA.
          spar-arg:values
          spar-call-with-values
          spar-discard-form
-         spar-elt
          spar-encapsulate-values
          spar-error
          spar-fail
@@ -4567,18 +4566,19 @@ USA.
          spar-if
          spar-map-values
          spar-match
-         spar-match-elt
          spar-match-null
+         spar-match-subform
          spar-not
          spar-opt
          spar-or
          spar-push
-         spar-push-elt
-         spar-push-elt-if
          spar-push-form-if
+         spar-push-subform
+         spar-push-subform-if
          spar-push-value
          spar-repeat
          spar-and
+         spar-subform
          spar-succeed
          spar-transform-values
          spar-with-mapped-senv)

diff --git a/src/runtime/syntax-constructor.scm b/src/runtime/syntax-constructor.scm
index 76d82c796b0c599126e3ea911cbb357d2d46f2e5..c118e15719f585cdb408653843ca441babd921f9 100644 (file)
--- a/src/runtime/syntax-constructor.scm
+++ b/src/runtime/syntax-constructor.scm
@@ -33,7 +33,7 @@ USA.
   (spar-call-with-values
       (lambda (close . args)
        (close-part close (apply procedure args)))
-    (spar-elt)
+    (spar-subform)
     (spar-push spar-arg:close)
     (pattern->spar pattern)))
 

diff --git a/src/runtime/syntax-parser.scm b/src/runtime/syntax-parser.scm
index 84bebe1d8d49f581c7a88aa84d379029e6f477a7..c123d0fd2a441b4a92c1d987fc35ce8e7d605127 100644 (file)
--- a/src/runtime/syntax-parser.scm
+++ b/src/runtime/syntax-parser.scm
@@ -352,7 +352,7 @@ USA.
 \f
 ;;;; Element combinators
 
-(define (spar-elt . spars)
+(define (spar-subform . spars)
   (let ((spar (%and spars)))
     (lambda (input senv output success failure)
       (if (%input-pair? input)
@@ -365,14 +365,14 @@ USA.
                failure)
          (failure)))))
 
-(define (spar-match-elt predicate . args)
-  (spar-elt (apply spar-match predicate args)))
+(define (spar-match-subform predicate . args)
+  (spar-subform (apply spar-match predicate args)))
 
-(define (spar-push-elt)
-  (spar-elt (spar-push spar-arg:form)))
+(define (spar-push-subform)
+  (spar-subform (spar-push spar-arg:form)))
 
-(define (spar-push-elt-if predicate . args)
-  (spar-elt (apply spar-push-form-if predicate args)))
+(define (spar-push-subform-if predicate . args)
+  (spar-subform (apply spar-push-form-if predicate args)))
 
 (define (spar-match-null)
   (spar-match null? spar-arg:form))
@@ -468,8 +468,8 @@ USA.
 
 (define (make-pattern-compiler expr? caller)
   (call-with-constructors expr?
-    (lambda ($* $+ $and $call $elt $if $match-elt $match-null $not $opt $or
-               $push $push-elt $push-elt-if $push-value)
+    (lambda ($* $+ $and $call $if $match-null $match-subform $not $opt $or $push
+               $push-subform $push-subform-if $push-value $subform)
 
       (define (loop pattern)
        (let-syntax
@@ -482,11 +482,11 @@ USA.
                                   ,@(cdr rule)))
                               (cdr form))
                        (else (bad-pattern pattern)))))))
-         (rules (''ignore ($elt))
-                (''any ($push-elt))
-                (''id ($push-elt-if identifier? spar-arg:form))
-                (''symbol ($push-elt-if symbol? spar-arg:form))
-                (procedure? ($push-elt-if pattern spar-arg:form))
+         (rules (''ignore ($subform))
+                (''any ($push-subform))
+                (''id ($push-subform-if identifier? spar-arg:form))
+                (''symbol ($push-subform-if symbol? spar-arg:form))
+                (procedure? ($push-subform-if pattern spar-arg:form))
                 ('('spar form) (cadr pattern))
                 ('('* * form) ($call list (apply $* (map loop (cdr pattern)))))
                 ('('+ * form) ($call list (apply $+ (map loop (cdr pattern)))))
@@ -496,13 +496,15 @@ USA.
                 ('('and * form) (apply $and (map loop (cdr pattern))))
                 ('('not form) ($not (loop (cadr pattern))))
                 ('('noise form)
-                 ($match-elt eqv? (cadr pattern) spar-arg:form))
+                 ($match-subform eqv? (cadr pattern) spar-arg:form))
                 ('('noise-keyword identifier)
-                 ($match-elt spar-arg:compare (cadr pattern) spar-arg:form))
+                 ($match-subform spar-arg:compare
+                                 (cadr pattern)
+                                 spar-arg:form))
                 ('('keyword identifier)
-                 ($and ($match-elt spar-arg:compare
-                                   (cadr pattern)
-                                   spar-arg:form)
+                 ($and ($match-subform spar-arg:compare
+                                       (cadr pattern)
+                                       spar-arg:form)
                        ($push (cadr pattern))))
                 ('('values * form)
                  (apply $push (map convert-spar-arg (cdr pattern))))
@@ -515,8 +517,8 @@ USA.
                 ('('call + form)
                  (apply $call (cadr pattern) (map loop (cddr pattern))))
                 ('('elt * form)
-                 ($elt (apply $and (map loop (cdr pattern)))
-                       ($match-null))))))
+                 ($subform (apply $and (map loop (cdr pattern)))
+                           ($match-null))))))
 
       (define (convert-spar-arg arg)
        (case arg
@@ -561,17 +563,17 @@ USA.
             (flat-proc 'spar+ spar+)
             (flat-proc 'spar-and spar-and)
             (flat-proc 'spar-call-with-values spar-call-with-values)
-            (flat-proc 'spar-elt spar-elt)
             (proc 'spar-if spar-if)
-            (proc 'spar-match-elt spar-match-elt)
             (proc 'spar-match-null spar-match-null)
+            (proc 'spar-match-subform spar-match-subform)
             (proc 'spar-not spar-not)
             (flat-proc 'spar-opt spar-opt)
             (proc 'spar-or spar-or)
             (proc 'spar-push spar-push)
-            (proc 'spar-push-elt spar-push-elt)
-            (proc 'spar-push-elt-if spar-push-elt-if)
-            (proc 'spar-push-value spar-push-value)))
+            (proc 'spar-push-subform spar-push-subform)
+            (proc 'spar-push-subform-if spar-push-subform-if)
+            (proc 'spar-push-value spar-push-value)
+            (flat-proc 'spar-subform spar-subform)))
 
 (define-deferred pattern->spar
   (make-pattern-compiler #f 'pattern->spar))