From e7ff80747023bb9866a6188077a9173b185e8ad0 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 4 Jan 2002 06:05:21 +0000
Subject: [PATCH] New procedure GUARANTEE-ENVIRONMENT.

---
 v7/src/runtime/runtime.pkg |  3 ++-
 v7/src/runtime/uenvir.scm  | 12 ++++++++----
 2 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 327827c11..762a5f8f8 100644
--- 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 e1268d093..71d30062e 100644
--- 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))
 
 ;;;; Global environment
 
-- 
2.25.1