From 4d108ac2995b88eb386b4cfa48f9a5022a756859 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 22 Jul 2014 14:34:39 +0900
Subject: [PATCH] move include syntax to core-syntax library

---
 piclib/prelude.scm | 45 +++++++++++++++++++++++----------------------
 1 file changed, 23 insertions(+), 22 deletions(-)

diff --git a/piclib/prelude.scm b/piclib/prelude.scm
index 7367d593..d31363a2 100644
--- a/piclib/prelude.scm
+++ b/piclib/prelude.scm
@@ -260,12 +260,34 @@
      (lambda (form r c)
        `(,(r 'letrec-syntax) ,@(cdr form)))))
 
+  (import (scheme read) (scheme file))
+
+  (define-syntax include
+    (letrec ((read-file
+              (lambda (filename)
+                (let ((port (open-input-file filename)))
+                  (dynamic-wind
+                      (lambda () #f)
+                      (lambda ()
+                        (let loop ((expr (read port)) (exprs '()))
+                          (if (eof-object? expr)
+                              (reverse exprs)
+                              (loop (read port) (cons expr exprs)))))
+                      (lambda ()
+                        (close-port port)))))))
+      (er-macro-transformer
+       (lambda (form rename compare)
+         (let ((filenames (cdr form)))
+           (let ((exprs (apply append (map read-file filenames))))
+             `(,(rename 'begin) ,@exprs)))))))
+
   (export let let* letrec letrec*
           quasiquote unquote unquote-splicing
           and or
           cond case else =>
           do when unless
           let-syntax letrec-syntax
+          include
           _ ... syntax-error))
 
 (import (picrin core-syntax))
@@ -276,6 +298,7 @@
         cond case else =>
         do when unless
         let-syntax letrec-syntax
+        include
         _ ... syntax-error)
 
 ;;; multiple value
@@ -737,28 +760,6 @@
 
 (export call-with-port)
 
-;;; include syntax
-
-(import (scheme read)
-        (scheme file))
-
-(define (read-many filename)
-  (call-with-port (open-input-file filename)
-    (lambda (port)
-      (let loop ((expr (read port)) (exprs '()))
-        (if (eof-object? expr)
-            (reverse exprs)
-            (loop (read port) (cons expr exprs)))))))
-
-(define-syntax include
-  (er-macro-transformer
-   (lambda (form rename compare)
-     (let ((filenames (cdr form)))
-       (let ((exprs (apply append (map read-many filenames))))
-         `(,(rename 'begin) ,@exprs))))))
-
-(export include)
-
 ;;; syntax-rules
 (define-library (picrin syntax-rules)
   (import (scheme base)