Introduce syntactic-environment/reserve to handle common case.

This also means that syntactic-environment/define is only used for keyword
items.

diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm
index e508e0a7242233a23e6b4fb175adffaf71cea6dc..ba8b33b2e6388eee712c0514380959c9000d278d 100644 (file)
--- a/src/runtime/mit-syntax.scm
+++ b/src/runtime/mit-syntax.scm
@@ -144,9 +144,7 @@ USA.
    (lambda (form environment)
      (let ((name (cadr form)))
        (if (not (syntactic-environment/top-level? environment))
-          (syntactic-environment/define environment
-                                        name
-                                        (make-reserved-name-item)))
+          (syntactic-environment/reserve environment name))
        (variable-binder environment name
                        (classify/expression (caddr form) environment))))))
 
@@ -217,11 +215,8 @@ USA.
   (let ((bindings (cadr form))
        (body (cddr form))
        (binding-env (make-internal-syntactic-environment env)))
-    (for-each (let ((item (make-reserved-name-item)))
-               (lambda (binding)
-                 (syntactic-environment/define binding-env
-                                               (car binding)
-                                               item)))
+    (for-each (lambda (binding)
+               (syntactic-environment/reserve binding-env (car binding)))
              bindings)
     ;; Classify right-hand sides first, in order to catch references to
     ;; reserved names.  Then bind names prior to classifying body.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 2f5c91754927ae54010370ece6cfb1bc33bef2e4..a9341e35a776d1cad8ecd8ddefff124ae4bab6d1 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4471,6 +4471,7 @@ USA.
          syntactic-environment->environment
          syntactic-environment/define
          syntactic-environment/lookup
+         syntactic-environment/reserve
          syntactic-environment/top-level?
          syntactic-environment?))
 

diff --git a/src/runtime/syntax-environment.scm b/src/runtime/syntax-environment.scm
index 827a55627c8d29947d97d8cb76ac46f2ec6f51fb..a56ec2b0deda9421807aae392c52e77d7d65c98a 100644 (file)
--- a/src/runtime/syntax-environment.scm
+++ b/src/runtime/syntax-environment.scm
@@ -51,21 +51,15 @@ USA.
   (guarantee identifier? identifier 'syntactic-environment/lookup)
   ((senv-lookup senv) identifier))
 
+(define (syntactic-environment/reserve senv identifier)
+  (guarantee identifier? identifier 'syntactic-environment/reserve)
+  ((senv-store senv) identifier (make-reserved-name-item)))
+
 (define (syntactic-environment/define senv identifier item)
   (guarantee identifier? identifier 'syntactic-environment/define)
-  (guarantee senv-value-item? item 'syntactic-environment/define)
+  (guarantee keyword-item? item 'syntactic-environment/define)
   ((senv-store senv) identifier item))
 
-(define (senv-value-item? object)
-  (or (reserved-name-item? object)
-      (keyword-item? object)
-      (variable-item? object)))
-(register-predicate! senv-value-item? 'syntactic-environment-value-item)
-
-(define (syntactic-environment/rename senv identifier)
-  (guarantee identifier? identifier 'syntactic-environment/rename)
-  ((senv-rename senv) identifier))
-
 (define (bind-variable! senv identifier)
   (guarantee identifier? identifier 'bind-variable!)
   (let ((rename ((senv-rename senv) identifier)))