Implement ENVIRONMENT-DEFINE and ENVIRONMENT-ASSIGNED?. Change

ENVIRONMENT-LOOKUP to signal an error if the variable is unassigned.
Move ENVIRONMENT-SYNTAX-TABLE and SET-ENVIRONMENT-SYNTAX-TABLE! into
the syntax-table abstraction.

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 75e9d2e33db1f1ea9887f497a81bb84fe74caa4e..64bd263bf10a247f5fdc6229fa3a1e8b9a552655 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.387 2001/12/18 20:51:05 cph Exp $
+$Id: runtime.pkg,v 14.388 2001/12/19 01:39:36 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -1321,9 +1321,11 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
          environment-arguments
          environment-assign!
          environment-assignable?
+         environment-assigned?
          environment-bindings
          environment-bound-names
          environment-bound?
+         environment-define
          environment-has-parent?
          environment-lambda
          environment-lookup
@@ -3738,8 +3740,10 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
   (files "syntab")
   (parent (runtime))
   (export ()
+         environment-syntax-table
          guarantee-syntax-table
          make-syntax-table
+         set-environment-syntax-table!
          syntax-table-define
          syntax-table-ref
          syntax-table/copy
@@ -3748,20 +3752,20 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
          syntax-table/extend
          syntax-table/parent
          syntax-table/ref
-         syntax-table?))
+         syntax-table?)
+  (export (runtime environment)
+         syntax-table-tag))
 
 (define-package (runtime syntaxer)
   (files "syntax")
   (parent (runtime))
   (export ()
-         environment-syntax-table
          hook/syntax-expression
          lambda-tag:fluid-let
          lambda-tag:let
          lambda-tag:make-environment
          lambda-tag:unnamed
          make-syntax-closure
-         set-environment-syntax-table!
          syntax
          syntax*
          syntax-closure/expression
@@ -3771,8 +3775,6 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
          user-initial-syntax-table)
   (export (runtime defstruct)
          parse-lambda-list)
-  (export (runtime environment)
-         syntax-table-tag)
   (initialization (initialize-package!)))
 
 (define-package (runtime illegal-definitions)

diff --git a/v7/src/runtime/syntab.scm b/v7/src/runtime/syntab.scm
index 182ac58e91d6365582c3332d4af783e5791de197..e27535d7eb17c2b3887e24e299d9ff55d3ce2fbc 100644 (file)
--- a/v7/src/runtime/syntab.scm
+++ b/v7/src/runtime/syntab.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: syntab.scm,v 14.6 2001/12/18 20:47:46 cph Exp $
+$Id: syntab.scm,v 14.7 2001/12/19 01:39:41 cph Exp $
 
 Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
 
@@ -85,4 +85,17 @@ USA.
 
 (define (syntax-table/extend table alist)
   (%make-syntax-table (alist-copy alist)
-                     (guarantee-syntax-table table 'SYNTAX-TABLE/EXTEND)))
\ No newline at end of file
+                     (guarantee-syntax-table table 'SYNTAX-TABLE/EXTEND)))
+
+(define (environment-syntax-table environment)
+  (environment-lookup environment syntax-table-tag))
+
+(define (set-environment-syntax-table! environment table)
+  (environment-define environment
+                     syntax-table-tag
+                     (guarantee-syntax-table table
+                                             'SET-ENVIRONMENT-SYNTAX-TABLE!)))
+
+(define-integrable syntax-table-tag
+  ((ucode-primitive string->symbol)
+   "#[(runtime syntax-table)syntax-table-tag]"))
\ No newline at end of file

diff --git a/v7/src/runtime/syntax.scm b/v7/src/runtime/syntax.scm
index 7e2287b60276b3dfd2158d1fa8563faebf4fe449..7a67ab762686eed98d2d70ca6e9b1f97110c9d7a 100644 (file)
--- a/v7/src/runtime/syntax.scm
+++ b/v7/src/runtime/syntax.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: syntax.scm,v 14.35 2001/12/18 20:47:18 cph Exp $
+$Id: syntax.scm,v 14.36 2001/12/19 01:39:46 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -113,20 +113,6 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 (define (syntax/top-level?)
   *syntax-top-level?*)
 
-(define (environment-syntax-table environment)
-  (environment-lookup environment syntax-table-tag))
-
-(define (set-environment-syntax-table! environment table)
-  (if (not (interpreter-environment? environment))
-      (error:wrong-type-argument environment
-                                "interpreter environment"
-                                'SET-ENVIRONMENT-SYNTAX-TABLE!))
-  (local-assignment environment syntax-table-tag table))
-
-(define-integrable syntax-table-tag
-  ((ucode-primitive string->symbol)
-   "#[(runtime syntax-table)syntax-table-tag]"))
-\f
 (define-integrable (syntax-subsequence expressions)
   (syntax-sequence #f expressions))
 

diff --git a/v7/src/runtime/uenvir.scm b/v7/src/runtime/uenvir.scm
index e0bd9073c8a5308c52c81966e4a47671aab1c145..8657abf238ffaf9ba247fa0de2c8592b09a5c696 100644 (file)
--- a/v7/src/runtime/uenvir.scm
+++ b/v7/src/runtime/uenvir.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: uenvir.scm,v 14.45 2001/12/18 20:50:59 cph Exp $
+$Id: uenvir.scm,v 14.46 2001/12/19 01:39:52 cph Exp $
 
 Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
 
@@ -119,6 +119,16 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
        (else
         (illegal-environment environment 'ENVIRONMENT-BOUND?))))
 
+(define (environment-assigned? environment name)
+  (cond ((interpreter-environment? environment)
+        (interpreter-environment/assigned? environment name))
+       ((stack-ccenv? environment)
+        (stack-ccenv/assigned? environment name))
+       ((closure-ccenv? environment)
+        (closure-ccenv/assigned? environment name))
+       (else
+        (illegal-environment environment 'ENVIRONMENT-ASSIGNED?))))
+
 (define (environment-lookup environment name)
   (cond ((interpreter-environment? environment)
         (interpreter-environment/lookup environment name))
@@ -149,6 +159,15 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
        (else
         (illegal-environment environment 'ENVIRONMENT-ASSIGN!))))
 
+(define (environment-define environment name value)
+  (cond ((interpreter-environment? environment)
+        (interpreter-environment/define environment name value))
+       ((or (stack-ccenv? environment)
+            (closure-ccenv? environment))
+        (error:bad-range-argument environment 'ENVIRONMENT-DEFINE))
+       (else
+        (illegal-environment environment 'ENVIRONMENT-DEFINE))))
+
 (define (illegal-environment object procedure)
   (error:wrong-type-argument object "environment" procedure))
 \f
@@ -218,15 +237,20 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 (define (interpreter-environment/bound? environment name)
   (not (lexical-unbound? environment name)))
 
+(define (interpreter-environment/assigned? environment name)
+  (not (lexical-unassigned? environment name)))
+
 (define (interpreter-environment/lookup environment name)
-  (if (lexical-unassigned? environment name)
-      (make-unassigned-reference-trap)
-      (lexical-reference environment name)))
+  (lexical-reference environment name))
 
 (define (interpreter-environment/assign! environment name value)
   (lexical-assignment environment name value)
   unspecific)
 
+(define (interpreter-environment/define environment name value)
+  (local-assignment environment name value)
+  unspecific)
+
 (define (ic-environment/bound-names environment)
   (map-ic-environment-bindings map-entry/bound-names environment))
 
@@ -528,6 +552,9 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
        (and parent
             (environment-bound? parent name)))))
 
+(define (stack-ccenv/assigned? environment name)
+  (and (stack-ccenv/lookup environment name) #t))
+
 (define (stack-ccenv/lookup environment name)
   (lookup-dbg-variable (stack-ccenv/block environment)
                       name
@@ -638,6 +665,9 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
        (and parent
             (environment-bound? parent name)))))
 
+(define (closure-ccenv/assigned? environment name)
+  (and (closure-ccenv/lookup environment name) #t))
+
 (define (closure-ccenv/variable-bound? environment variable)
   (or (eq? (dbg-variable/type variable) 'INTEGRATED)
       (vector-find-next-element