diff --git a/docs/lang.rst b/docs/lang.rst index fe0e60f7..9e787548 100644 --- a/docs/lang.rst +++ b/docs/lang.rst @@ -38,7 +38,7 @@ section status comments 4.1.4 Procedures yes 4.1.5 Conditionals yes In picrin ``(if #f #f)`` returns ``#f`` 4.1.6 Assignments yes -4.1.7 Inclusion incomplete ``include-ci``. TODO: Once ``read`` is implemented rewrite ``include`` macro with it. +4.1.7 Inclusion incomplete ``include-ci`` 4.2.1 Conditionals incomplete TODO: ``cond-expand`` 4.2.2 Binding constructs yes 4.2.3 Sequencing yes diff --git a/piclib/built-in.scm b/piclib/built-in.scm index ca2271fa..a58e0aa8 100644 --- a/piclib/built-in.scm +++ b/piclib/built-in.scm @@ -907,6 +907,31 @@ (export call-with-port) +;;; include syntax + +(import (scheme read) + (scheme file)) + +(define (call-with-input-file filename callback) + (call-with-port (open-input-file filename) callback)) + +(define (read-many filename) + (call-with-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) + ;;; Appendix A. Standard Libraries Lazy (define-library (scheme lazy) (import (scheme base) diff --git a/src/macro.c b/src/macro.c index 7783c0e4..1a0ed192 100644 --- a/src/macro.c +++ b/src/macro.c @@ -599,39 +599,6 @@ pic_macroexpand(pic_state *pic, pic_value expr) return v; } -/* once read.c is implemented move there */ -static pic_value -pic_macro_include(pic_state *pic) -{ - size_t argc, i; - pic_value *argv, exprs, body; - FILE *file; - - pic_get_args(pic, "*", &argc, &argv); - - /* FIXME unhygienic */ - body = pic_list1(pic, pic_sym_value(pic->sBEGIN)); - - for (i = 0; i < argc; ++i) { - const char *filename; - if (! pic_str_p(argv[i])) { - pic_error(pic, "expected string"); - } - filename = pic_str_cstr(pic_str_ptr(argv[i])); - file = fopen(filename, "r"); - if (file == NULL) { - pic_error(pic, "could not open file"); - } - exprs = pic_parse_file(pic, file); - if (pic_undef_p(exprs)) { - pic_error(pic, "parse error"); - } - body = pic_append(pic, body, exprs); - } - - return body; -} - static pic_value pic_macro_gensym(pic_state *pic) { @@ -958,8 +925,6 @@ pic_macro_ir_macro_transformer(pic_state *pic) void pic_init_macro(pic_state *pic) { - pic_defmacro(pic, "include", pic_proc_new(pic, pic_macro_include, "")); - pic_deflibrary ("(picrin macro)") { /* export define-macro syntax */