Rewrite environment implementation to clear up ambiguities.

See the extensive note at the beginning for details.

diff --git a/src/runtime/syntax-environment.scm b/src/runtime/syntax-environment.scm
index 2ac7e941b631fd3b17dff45014081a5ab9a9c744..735f02885f2a123864dadd28f09b69cef3903d23 100644 (file)
--- a/src/runtime/syntax-environment.scm
+++ b/src/runtime/syntax-environment.scm
@@ -26,6 +26,34 @@ USA.
 
 ;;;; Syntactic Environments
 
+;; A note on lookup:
+
+;; Identifiers renamed by syntax-rules have a fundamental ambiguity in the
+;; context of syntactic environments.  The underlying problem is that
+;; syntax-rules uniformly "renames" all identifiers in the template (except
+;; those bound by the pattern), and that the meaning of a "renamed" identifier
+;; is ambiguous depending on whether the name is used in a binding.  If it is
+;; used in a binding, then in effect it introduces a new identifier different
+;; from that in the template, and expressions using that identifier must match.
+;; If it isn't used in a binding, then it's just an ordinary identifier that's
+;; closed in the usage environment of the macro.
+
+;; The ambiguity is resolved in two parts: first, any ambiguous identifier
+;; appearing in a binding is bound just like any other identifier.  Second, when
+;; an ambiguous identifier appears in an expression context, it is first looked
+;; up in the expression's environment, to see if there's an existing binding; if
+;; so, then it's a "new identifier", otherwise it's a closure of an "ordinary
+;; identifier".
+
+;; Right now these "ambiguous identifiers" are created by any use of
+;; er-macro-transformer.  It would be better if they were only generated by
+;; syntax-rules, since it's not necessary to have ambiguous meaning with other
+;; macros.  This could be done by introducing a special data structure to
+;; represent the ambiguity.  But transitioning to this design is tricky since
+;; the widespread use of syntax-rules means that, during the transition, some
+;; expansions must use the old design and some must use the new design and it's
+;; not obvious which is which.  For now we punt.
+
 (declare (usual-integrations))
 \f
 (define (runtime-environment->syntactic env)
@@ -33,46 +61,41 @@ USA.
        ((environment? env) (%internal-runtime-senv env))
        (else (error:not-a environment? env 'runtime-environment->syntactic))))
 
+(define (runtime-lookup identifier env)
+  (if (syntactic-closure? identifier)
+      ;; If we reached here, fail and continue the search in lookup-identifier.
+      #f
+      (environment-lookup-macro env identifier)))
+
 (define (senv->runtime senv)
   ((senv-get-runtime senv)))
 
 (define (senv-top-level? senv)
   (eq? 'top-level ((senv-get-type senv))))
 
-(define ((id-dispatcher handle-raw caller) identifier senv)
-  (cond ((raw-identifier? identifier)
-        (handle-raw identifier senv))
-       ((closed-identifier? identifier)
-        (handle-raw (syntactic-closure-form identifier)
-                    (syntactic-closure-senv identifier)))
-       (else
-        (error:not-a identifier? identifier caller))))
-
-(define lookup-identifier
-  (id-dispatcher (lambda (identifier senv)
-                  (or ((senv-lookup senv) identifier)
-                      (var-item identifier)))
-                'lookup-identifier))
-
-(define reserve-identifier
-  (id-dispatcher (lambda (identifier senv)
+(define (lookup-identifier identifier senv)
+  (guarantee identifier? identifier 'lookup-identifier)
+  (let loop ((id identifier) (senv senv))
+    (or ((senv-lookup senv) id)
+       (if (syntactic-closure? id)
+           (loop (syntactic-closure-form id)
+                 (syntactic-closure-senv id))
+           (var-item id)))))
+
+(define (reserve-identifier identifier senv)
+  (guarantee identifier? identifier 'reserve-identifier)
                   ((senv-store senv) identifier (reserved-name-item)))
-                'reserve-identifier))
 
 (define (bind-keyword identifier senv item)
+  (guarantee identifier? identifier 'bind-keyword)
   (guarantee keyword-item? item 'bind-keyword)
-  ((id-dispatcher (lambda (identifier senv)
                    ((senv-store senv) identifier item))
-                 'bind-keyword)
-   identifier
-   senv))
 
-(define bind-variable
-  (id-dispatcher (lambda (identifier senv)
+(define (bind-variable identifier senv)
+  (guarantee identifier? identifier 'bind-variable)
                   (let ((rename ((senv-rename senv) identifier)))
                     ((senv-store senv) identifier (var-item rename))
                     rename))
-                'bind-variable))
 
 (define-record-type <syntactic-environment>
     (make-senv get-type get-runtime lookup store rename describe)
@@ -109,7 +132,7 @@ USA.
       (let ((binding (assq identifier bound)))
        (if binding
            (cdr binding)
-           (environment-lookup-macro env identifier))))
+           (runtime-lookup identifier env))))
 
     (define (store identifier item)
       (let ((binding (assq identifier bound)))
@@ -138,7 +161,7 @@ USA.
     env)
 
   (define (lookup identifier)
-    (environment-lookup-macro env identifier))
+    (runtime-lookup identifier env))
 
   (define (store identifier item)
     (error "Can't bind in non-top-level runtime environment:" identifier item))
@@ -175,7 +198,7 @@ USA.
     `((name ,name)
       (item ,item)))
 
-  (guarantee raw-identifier? name 'make-keyword-environment)
+  (guarantee identifier? name 'make-keyword-environment)
   (guarantee keyword-item? item 'make-keyword-environment)
   (make-senv get-type get-runtime lookup store rename describe))
 
@@ -281,6 +304,7 @@ USA.
       (cond ((or (assq identifier bound)
                 (assq identifier free))
             => cdr)
+           ((syntactic-closure? identifier) #f)
            ((environment-lookup-macro env identifier))
            (else
             (if (not (environment-bound? env identifier))