From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 20 May 2018 05:30:49 +0000 (-0700)
Subject: Implement include and include-ci for R7RS.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~23
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=70bf1e80dc3a70e2017bacd490516add36c5a8d6;p=mit-scheme.git

Implement include and include-ci for R7RS.
---

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index 41dfb69de..5c04886e9 100644
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -426,6 +426,25 @@ USA.
 		  (scons-call 'raise-continuable condition)
 		  clauses)))
 
+(define $include
+  (spar-transformer->runtime
+   (delay
+     (scons-rule `((+ ,string?))
+       (lambda (filenames)
+	 (apply scons-begin (read-files filenames #f)))))))
+
+(define $include-ci
+  (spar-transformer->runtime
+   (delay
+     (scons-rule `((+ ,string?))
+       (lambda (filenames)
+	 (apply scons-begin (read-files filenames #t)))))))
+
+(define (read-files filenames fold-case?)
+  (parameterize* (list (cons param:reader-fold-case? fold-case?))
+    (lambda ()
+      (append-map read-file filenames))))
+
 (define $define-values
   (spar-transformer->runtime
    (delay
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index f6a787a5e..3514fc6a5 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4776,6 +4776,8 @@ USA.
 	  (do $do)			;R7RS
 	  (fluid-let $fluid-let)
 	  (guard $guard)		;R7RS
+	  (include $include)		;R7RS
+	  (include-ci $include-ci)	;R7RS
 	  (let $let)			;R7RS
 	  (let* $let*)			;R7RS
 	  (let*-syntax $let*-syntax)	;R7RS