conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

add include

This commit is contained in:
Yuichi Nishiwaki 2017-04-29 01:03:08 +09:00
parent 5e3072cfcc
commit 4663a75e96
6 changed files with 4306 additions and 4244 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
contrib/20.r7rs/scheme/base.scm
View File

@ -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

8508
lib/ext/eval.c
View File

File diff suppressed because it is too large Load Diff

2
lib/ext/file.c
View File

@ -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);

6
lib/port.c
View File

@ -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);

17
piclib/eval.scm
View File

@ -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

2
piclib/library.scm
View File

@ -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)))