From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 25 Oct 2018 02:14:01 +0000 (-0700)
Subject: Implement scheme-report-environment and null-environment.
X-Git-Tag: mit-scheme-pucked-10.1.2~16^2~172
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f11e9b8087f5c8552b8f2fef2de898e0f0e0ab0c;p=mit-scheme.git

Implement scheme-report-environment and null-environment.
---

diff --git a/src/runtime/library-loader.scm b/src/runtime/library-loader.scm
index bb1815a75..61b76fe03 100644
--- a/src/runtime/library-loader.scm
+++ b/src/runtime/library-loader.scm
@@ -120,7 +120,10 @@ USA.
 (define (environment . import-sets)
   (let ((parsed (map parse-import-set import-sets))
 	(db host-library-db))
-    (let ((unusable (remove parsed-import-expandable? parsed)))
+    (let ((unusable
+	   (remove (lambda (import)
+		     (parsed-import-expandable? import db))
+		   parsed)))
       (if (pair? unusable)
 	  (error "Imports not usable:" unusable)))
     (let ((imports (expand-parsed-imports parsed db)))
@@ -132,6 +135,19 @@ USA.
 	    (error "Imported libraries unavailable:"
 		   (library-imports-from unavailable))))
       (make-environment-from-imports imports db))))
+
+(define (scheme-report-environment version)
+  (if (not (eqv? version 5))
+      (error "Unsupported version:" version))
+  (environment '(scheme r5rs)))
+
+(define (null-environment version)
+  (if (not (eqv? version 5))
+      (error "Unsupported version:" version))
+  (environment '(only (scheme r5rs)
+		      ... => _ and begin case cond define define-syntax delay do
+		      else if lambda let let* let-syntax letrec letrec-syntax or
+		      quasiquote quote set! syntax-rules)))
 
 ;;;; Evaluation
 
diff --git a/src/runtime/library-standard.scm b/src/runtime/library-standard.scm
index b9b2b1a4b..39114b8b6 100644
--- a/src/runtime/library-standard.scm
+++ b/src/runtime/library-standard.scm
@@ -687,7 +687,7 @@ USA.
     negative?
     newline
     not
-    ;;null-environment
+    null-environment
     null?
     number->string
     number?
@@ -713,7 +713,7 @@ USA.
     remainder
     reverse
     round
-    ;;scheme-report-environment
+    scheme-report-environment
     set!
     set-car!
     set-cdr!
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index a413da278..dc5aa5ae8 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5959,6 +5959,8 @@ USA.
   (parent (runtime library))
   (export ()
 	  environment			;R7RS
+	  null-environment		;R7RS
+	  scheme-report-environment	;R7RS
 	  )
   (export (runtime)
 	  eval-r7rs-scode-file