Eliminate redundant argument to senv-store.

(cherry picked from commit 30166b4fd697a329b8fe4ad565b300bb570d5c6a)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 1acbd123a329372bb1aad9def2a7269e064efc85..cf61ef2424f8b66bceeb7ee029ea75804057d714 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5061,6 +5061,7 @@ USA.
          flatten-items
          item->list
          keyword-item?
+         keywordish-item?
          render-item
          reserved-name-item
          reserved-name-item?

diff --git a/src/runtime/syntax-environment.scm b/src/runtime/syntax-environment.scm
index 02202017380ff2d01c45516efe3936ef7c563c52..c701fbd3d9ca0c897af19bb37fd823501b7e6454 100644 (file)
--- a/src/runtime/syntax-environment.scm
+++ b/src/runtime/syntax-environment.scm
@@ -84,17 +84,17 @@ USA.
 
 (define (reserve-keyword identifier senv)
   (guarantee identifier? identifier 'reserve-keyword)
-  ((senv-store senv) identifier #t (reserved-name-item)))
+  ((senv-store senv) identifier (reserved-name-item)))
 
 (define (bind-keyword identifier senv item)
   (guarantee identifier? identifier 'bind-keyword)
   (guarantee keyword-item? item 'bind-keyword)
-  ((senv-store senv) identifier #t item))
+  ((senv-store senv) identifier item))
 
 (define (bind-variable identifier senv)
   (guarantee identifier? identifier 'bind-variable)
   (let ((rename ((senv-rename senv) identifier)))
-    ((senv-store senv) identifier #f (var-item rename))
+    ((senv-store senv) identifier (var-item rename))
     rename))
 
 (define-record-type <syntactic-environment>
@@ -134,8 +134,7 @@ USA.
            (cdr binding)
            (runtime-lookup identifier env))))
 
-    (define (store identifier keyword? item)
-      (declare (ignore keyword?))
+    (define (store identifier item)
       (let ((binding (assq identifier bound)))
        (if binding
            (set-cdr! binding item)
@@ -164,8 +163,7 @@ USA.
   (define (lookup identifier)
     (runtime-lookup identifier env))
 
-  (define (store identifier keyword? item)
-    (declare (ignore keyword?))
+  (define (store identifier item)
     (error "Can't bind in non-top-level runtime environment:" identifier item))
 
   (define (rename identifier)
@@ -190,8 +188,7 @@ USA.
     (and (eq? name identifier)
         item))
 
-  (define (store identifier keyword? item)
-    (declare (ignore keyword?))
+  (define (store identifier item)
     (error "Can't bind in keyword environment:" identifier item))
 
   (define (rename identifier)
@@ -223,8 +220,7 @@ USA.
            (cdr binding)
            ((senv-lookup parent) identifier))))
 
-    (define (store identifier keyword? item)
-      (declare (ignore keyword?))
+    (define (store identifier item)
       (cond ((assq identifier bound)
             => (lambda (binding)
                  (set-cdr! binding item)))
@@ -256,15 +252,15 @@ USA.
            (cdr binding)
            ((senv-lookup parent) identifier))))
 
-    (define (store identifier keyword? item)
-      (if keyword?
+    (define (store identifier item)
+      (if (keywordish-item? item)
          (cond ((assq identifier bound)
                 => (lambda (binding)
                      (set-cdr! binding item)))
                (else
                 (set! bound (cons (cons identifier item) bound))
                 unspecific))
-         ((senv-store parent) identifier keyword? item)))
+         ((senv-store parent) identifier item)))
 
     (define (describe)
       `((bound ,bound)
@@ -295,8 +291,7 @@ USA.
        (define (lookup identifier)
          ((senv-lookup (select-env identifier)) identifier))
 
-       (define (store identifier keyword? item)
-         (declare (ignore keyword?))
+       (define (store identifier item)
          ;; **** Shouldn't this be a syntax error?  It can happen as the
          ;; result of a misplaced definition.  ****
          (error "Can't bind identifier in partial syntactic environment:"
@@ -345,8 +340,7 @@ USA.
               (set! free (cons (cons identifier item) free))
               item))))
 
-    (define (store identifier keyword? item)
-      (declare (ignore keyword?))
+    (define (store identifier item)
       (cond ((assq identifier bound)
             => (lambda (binding)
                  (set-cdr! binding item)))

diff --git a/src/runtime/syntax-items.scm b/src/runtime/syntax-items.scm
index ec8b67aa35e98ea5c2891779131fed236087d00a..35822483c7a90cd20c30f621bfd881290a66ce00 100644 (file)
--- a/src/runtime/syntax-items.scm
+++ b/src/runtime/syntax-items.scm
@@ -116,6 +116,9 @@ USA.
 
 (define-item-compiler reserved-name-item?
   (illegal-expression-compiler "Reserved name"))
+
+(define-deferred keywordish-item?
+  (disjoin keyword-item? reserved-name-item?))
 \f
 ;;; These items can't be stored in a syntactic environment.