From 076698c84a232af58e951f32e345448120493bf3 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 27 Jul 2014 14:29:08 +0900
Subject: [PATCH] add null-environment and scheme-report-environment

---
 piclib/CMakeLists.txt  |  2 ++
 piclib/prelude.scm     | 17 +++++++++++++++++
 piclib/scheme/file.scm | 16 +++++++++++++++-
 3 files changed, 34 insertions(+), 1 deletion(-)

diff --git a/piclib/CMakeLists.txt b/piclib/CMakeLists.txt
index 9d81aae3..9e87e251 100644
--- a/piclib/CMakeLists.txt
+++ b/piclib/CMakeLists.txt
@@ -8,6 +8,8 @@ list(APPEND PICLIB_SCHEME_LIBS
   ${PROJECT_SOURCE_DIR}/piclib/scheme/file.scm
   ${PROJECT_SOURCE_DIR}/piclib/scheme/case-lambda.scm
   ${PROJECT_SOURCE_DIR}/piclib/scheme/lazy.scm
+  ${PROJECT_SOURCE_DIR}/piclib/scheme/r5rs.scm
+  ${PROJECT_SOURCE_DIR}/piclib/scheme/null.scm
   ${PROJECT_SOURCE_DIR}/piclib/srfi/1.scm
   ${PROJECT_SOURCE_DIR}/piclib/srfi/8.scm
   ${PROJECT_SOURCE_DIR}/piclib/srfi/26.scm
diff --git a/piclib/prelude.scm b/piclib/prelude.scm
index feef5c0c..b393ead7 100644
--- a/piclib/prelude.scm
+++ b/piclib/prelude.scm
@@ -1073,3 +1073,20 @@
                    (apply values args)))))))))))))
 
 (export guard)
+
+(define-library (scheme eval)
+  (import (scheme base))
+
+  (define (null-environment n)
+    (if (not (= n 5))
+        (error "unsupported environment version" n)
+        '(scheme null)))
+
+  (define (scheme-report-environment n)
+    (if (not (= n 5))
+        (error "unsupported environment version" n)
+        '(scheme r5rs)))
+
+  (export null-environment
+          scheme-report-environment
+          ))
diff --git a/piclib/scheme/file.scm b/piclib/scheme/file.scm
index 75c8bdd9..b449e49d 100644
--- a/piclib/scheme/file.scm
+++ b/piclib/scheme/file.scm
@@ -7,5 +7,19 @@
   (define (call-with-output-file filename callback)
     (call-with-port (open-output-file filename) callback))
 
+  (define (with-input-from-file filename thunk)
+    (call-with-input-file filename
+      (lambda (port)
+        (parameterize ((current-input-port port))
+          (thunk)))))
+
+  (define (with-output-to-file filename thunk)
+    (call-with-output-file filename
+      (lambda (port)
+        (parameterize ((current-output-port port))
+          (thunk)))))
+
   (export call-with-input-file
-          call-with-output-file))
+          call-with-output-file
+          with-input-from-file
+          with-output-to-file))