Simplify how runtime syntactic environments are created.

No more layering of top-level environments over one another, or of top-level
environments over runtime environments -- a top-level environment IS a runtime
environment.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index bb0033b745c9d336bb49a80194a595f91c027e17..7c04ffdeadc11cb25e235edcdd46533d6b1f505b 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4460,7 +4460,6 @@ USA.
          make-internal-syntactic-environment
          make-keyword-syntactic-environment
          make-partial-syntactic-environment
-         make-top-level-syntactic-environment
          syntactic-environment->environment
          syntactic-environment/bind-keyword
          syntactic-environment/bind-variable

diff --git a/src/runtime/syntax-environment.scm b/src/runtime/syntax-environment.scm
index 6f8b8567f80a9def5047798c3473beac3ec2723a..af5e5d8735c818d6a25efb858df919cdebd98a2e 100644 (file)
--- a/src/runtime/syntax-environment.scm
+++ b/src/runtime/syntax-environment.scm
@@ -41,7 +41,7 @@ USA.
   ((senv-get-type senv)))
 
 (define (syntactic-environment/top-level? senv)
-  (memq (senv-type senv) '(top-level runtime-top-level)))
+  (eq? 'top-level (senv-type senv)))
 
 (define (syntactic-environment->environment senv)
   ((senv-get-runtime senv)))
@@ -68,76 +68,48 @@ USA.
 (define (->syntactic-environment object #!optional caller)
   (declare (ignore caller))
   (cond ((syntactic-environment? object) object)
-       ((environment? object) (%make-runtime-syntactic-environment object))
+       ((interpreter-environment? object) (%top-level-runtime-senv object))
+       ((environment? object) (%internal-runtime-senv object))
        (else (error "Unable to convert to a syntactic environment:" object))))
-
+\f
 ;;; Runtime syntactic environments are wrappers around runtime environments.
-;;; They maintain their own bindings, but can defer lookups of syntactic
-;;; keywords to the given runtime environment.
 
-(define (%make-runtime-syntactic-environment env)
+(define (%internal-runtime-senv env)
 
   (define (get-type)
-    (if (interpreter-environment? env) 'runtime-top-level 'runtime))
+    'runtime)
 
   (define (get-runtime)
     env)
 
   (define (lookup identifier)
-    (and (symbol? identifier)
-        (environment-lookup-macro env identifier)))
+    (environment-lookup-macro env identifier))
 
   (define (store identifier item)
-    (environment-define-macro env identifier item))
+    (error "Can't bind in non-top-level runtime environment:" identifier item))
 
   (define (rename identifier)
-    identifier)
+    (error "Can't rename in non-top-level runtime environment:" identifier))
 
   (make-senv get-type get-runtime lookup store rename))
-\f
-;;; Keyword environments are used to make keywords that represent items.
-
-(define (make-keyword-syntactic-environment name item)
-
-  (define (get-type)
-    'keyword)
-
-  (define (get-runtime)
-    (error "Can't evaluate in keyword environment."))
-
-  (define (lookup identifier)
-    (and (eq? name identifier)
-        item))
-
-  (define (store identifier item)
-    (error "Can't bind in keyword environment:" identifier item))
-
-  (define (rename identifier)
-    (error "Can't rename in keyword environment:" identifier))
-
-  (guarantee raw-identifier? name 'make-keyword-environment)
-  (guarantee keyword-item? item 'make-keyword-environment)
-  (make-senv get-type get-runtime lookup store rename))
 
 ;;; Top-level syntactic environments represent top-level environments.
-;;; They are always layered over a runtime syntactic environment.
+;;; They are always associated with a given runtime environment.
 
-(define (make-top-level-syntactic-environment parent)
-  (guarantee syntactic-environment? parent
-            'make-top-level-syntactic-environment)
-  (if (not (memq (senv-type parent) '(runtime-top-level top-level)))
-      (error:bad-range-argument parent 'make-top-level-syntactic-environment))
-  (let ((bound '())
-       (get-runtime (senv-get-runtime parent)))
+(define (%top-level-runtime-senv env)
+  (let ((bound '()))
 
     (define (get-type)
       'top-level)
 
+    (define (get-runtime)
+      env)
+
     (define (lookup identifier)
       (let ((binding (assq identifier bound)))
        (if binding
            (cdr binding)
-           ((senv-lookup parent) identifier))))
+           (environment-lookup-macro env identifier))))
 
     (define (store identifier item)
       (let ((binding (assq identifier bound)))
@@ -152,6 +124,30 @@ USA.
 
     (make-senv get-type get-runtime lookup store rename)))
 \f
+;;; Keyword environments are used to make keywords that represent items.
+
+(define (make-keyword-syntactic-environment name item)
+
+  (define (get-type)
+    'keyword)
+
+  (define (get-runtime)
+    (error "Can't evaluate in keyword environment."))
+
+  (define (lookup identifier)
+    (and (eq? name identifier)
+        item))
+
+  (define (store identifier item)
+    (error "Can't bind in keyword environment:" identifier item))
+
+  (define (rename identifier)
+    (error "Can't rename in keyword environment:" identifier))
+
+  (guarantee raw-identifier? name 'make-keyword-environment)
+  (guarantee keyword-item? item 'make-keyword-environment)
+  (make-senv get-type get-runtime lookup store rename))
+
 ;;; Internal syntactic environments represent environments created by
 ;;; procedure application.
 
@@ -189,7 +185,7 @@ USA.
             unspecific)))
 
     (make-senv get-type get-runtime lookup store rename)))
-
+\f
 ;;; Partial syntactic environments are used to implement syntactic
 ;;; closures that have free names.
 

diff --git a/src/runtime/syntax.scm b/src/runtime/syntax.scm
index 2305828aa0d16a3d30163bb76603a9154e4d8148..5ca951cb19627b63f91fbf8992020354c6ff7c70 100644 (file)
--- a/src/runtime/syntax.scm
+++ b/src/runtime/syntax.scm
@@ -52,8 +52,7 @@ USA.
     (with-identifier-renaming
      (lambda ()
        (if (syntactic-environment/top-level? senv)
-          (compile-body-item/top-level
-           (classify/body forms (make-top-level-syntactic-environment senv)))
+          (compile-body-item/top-level (classify/body forms senv))
           (output/sequence (compile/expressions forms senv)))))))
 
 (define (compile/expression expression environment)