New procedure GUARANTEE-ENVIRONMENT.

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 327827c11c2583dfdeaa19f2ce92b7b0a3c87b31..762a5f8f8170666f36bdfbf32ab583e291a4c9e9 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.403 2001/12/23 17:20:59 cph Exp $
+$Id: runtime.pkg,v 14.404 2002/01/04 06:05:13 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -1336,6 +1336,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
          environment-procedure-name
          environment?
          extend-interpreter-environment
+         guarantee-environment
          ic-environment?
          interpreter-environment?
          make-null-interpreter-environment

diff --git a/v7/src/runtime/uenvir.scm b/v7/src/runtime/uenvir.scm
index e1268d0930a7b0dfd1ecba0ec199bffd138b9dea..71d30062e75cac980aa2b860f669df050879411e 100644 (file)
--- a/v7/src/runtime/uenvir.scm
+++ b/v7/src/runtime/uenvir.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: uenvir.scm,v 14.50 2001/12/21 18:22:49 cph Exp $
+$Id: uenvir.scm,v 14.51 2002/01/04 06:05:21 cph Exp $
 
 Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
 
@@ -31,6 +31,13 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
       (stack-ccenv? object)
       (closure-ccenv? object)))
 
+(define (guarantee-environment object name)
+  (if (not (environment? object))
+      (illegal-environment object name)))
+
+(define (illegal-environment object name)
+  (error:wrong-type-argument object "environment" name))
+
 (define (environment-has-parent? environment)
   (cond ((system-global-environment? environment)
         #f)
@@ -197,9 +204,6 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
         (error:bad-range-argument environment 'ENVIRONMENT-DEFINE-MACRO))
        (else
         (illegal-environment environment 'ENVIRONMENT-DEFINE-MACRO))))
-
-(define (illegal-environment object procedure)
-  (error:wrong-type-argument object "environment" procedure))
 \f
 ;;;; Global environment