add include

contrib/20.r7rs/scheme/base.scm

@@ -32,21 +32,6 @@
 
   ;; 4.1.7. Inclusion
 
-  (define-macro include
-    (letrec ((read-file
-              (lambda (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)))))))))
-      (er-macro-transformer
-       (lambda (form rename compare)
-         (let ((filenames (cdr form)))
-           (let ((exprs (apply append (map read-file filenames))))
-             `(,(rename 'begin) ,@exprs)))))))
-
   (export include)
 
   ;; 4.2.1. Conditionals

lib/ext/file.c

@@ -145,6 +145,8 @@ pic_init_file(pic_state *pic)
   pic_defvar(pic, "current-input-port", pic_fopen(pic, stdin, "r"));
   pic_defvar(pic, "current-output-port", pic_fopen(pic, stdout, "w"));
   pic_defvar(pic, "current-error-port", pic_fopen(pic, stdout, "w"));
+  pic_defun(pic, "open-input-file", pic_file_open_input_file);
+  pic_defun(pic, "open-output-file", pic_file_open_output_file);
   pic_defun(pic, "open-binary-input-file", pic_file_open_input_file);
   pic_defun(pic, "open-binary-output-file", pic_file_open_output_file);
   pic_defun(pic, "file-exists?", pic_file_exists_p);

lib/port.c

@@ -769,6 +769,12 @@ pic_port_flush(pic_state *pic)
 void
 pic_init_port(pic_state *pic)
 {
+#if !PIC_USE_FILE
+  pic_defvar(pic, "current-input-port", pic_false_value(pic));
+  pic_defvar(pic, "current-output-port", pic_false_value(pic));
+  pic_defvar(pic, "current-error-port", pic_false_value(pic));
+#endif
+
   pic_defun(pic, "port?", pic_port_port_p);
   pic_defun(pic, "input-port?", pic_port_input_port_p);
   pic_defun(pic, "output-port?", pic_port_output_port_p);

piclib/eval.scm

@@ -624,7 +624,22 @@
                                                              (,the-if (,pred obj)
                                                                       (,(the 'vector-set!) (,(the 'record-datum) obj) ,pos value)
                                                                       (,(the 'error) "record type mismatch" obj ',type))))))))
-                           (loop (cdr fields) (+ pos 1) `(,@defs . ,acc))))))))))))
+                           (loop (cdr fields) (+ pos 1) `(,@defs . ,acc))))))))))
+
+      (define-transformer 'include
+        (letrec ((read-file
+                  (lambda (filename)
+                    (let ((port (open-input-file filename)))
+                      (let loop ((expr (read port)) (exprs '()))
+                        (if (eof-object? expr)
+                            (begin
+                              (close-port port)
+                              (reverse exprs))
+                            (loop (read port) (cons expr exprs))))))))
+          (lambda (form env)
+            (let ((filenames (cdr form)))
+              (let ((exprs (apply append (map read-file filenames))))
+                `(,the-begin . ,exprs))))))))
 
   ;; compile
 

piclib/library.scm

@@ -221,7 +221,7 @@
                      and or
                      cond case else =>
                      do when unless
-                     parameterize define-record-type))
+                     parameterize define-record-type include))
         (dictionary-for-each export-keyword (global-objects)))
       (make-library '(picrin user)))