diff --git a/src/init.c b/src/init.c index b11bd0d7..07fac1e3 100644 --- a/src/init.c +++ b/src/init.c @@ -32,6 +32,7 @@ void pic_init_write(pic_state *); void pic_init_read(pic_state *); void pic_init_dict(pic_state *); void pic_init_eval(pic_state *); +void pic_init_lib(pic_state *); void pic_init_contrib(pic_state *); void pic_load_piclib(pic_state *); @@ -94,6 +95,7 @@ pic_init_core(pic_state *pic) pic_init_read(pic); DONE; pic_init_dict(pic); DONE; pic_init_eval(pic); DONE; + pic_init_lib(pic); DONE; pic_load_piclib(pic); DONE; diff --git a/src/lib.c b/src/lib.c index 7a197c87..9061afbc 100644 --- a/src/lib.c +++ b/src/lib.c @@ -6,6 +6,7 @@ #include "picrin/lib.h" #include "picrin/pair.h" #include "picrin/macro.h" +#include "picrin/error.h" struct pic_lib * pic_make_library(pic_state *pic, pic_value name) @@ -113,3 +114,41 @@ pic_export_as(pic_state *pic, pic_sym sym, pic_sym as) xh_put_int(&pic->lib->exports, as, &rename); } + +static pic_value +pic_lib_define_library(pic_state *pic) +{ + struct pic_lib *prev = pic->lib; + size_t argc, i; + pic_value spec, *argv; + + pic_get_args(pic, "o*", &spec, &argc, &argv); + + pic_make_library(pic, spec); + + pic_try { + pic_in_library(pic, spec); + + for (i = 0; i < argc; ++i) { + pic_void(pic_eval(pic, argv[i], pic->lib)); + } + + pic_in_library(pic, prev->name); + } + pic_catch { + pic_in_library(pic, prev->name); /* restores pic->lib even if an error occurs */ + pic_throw_error(pic, pic->err); + } + + return pic_none_value(); +} + +void +pic_init_lib(pic_state *pic) +{ + void pic_defmacro(pic_state *, pic_sym, pic_sym, pic_func_t); + + /* pic_define_library_syntax(pic, "import", pic_lib_import); */ + /* pic_define_library_syntax(pic, "export", pic_lib_export); */ + pic_defmacro(pic, pic->sDEFINE_LIBRARY, pic->rDEFINE_LIBRARY, pic_lib_define_library); +} diff --git a/src/macro.c b/src/macro.c index 0603d232..191df9a0 100644 --- a/src/macro.c +++ b/src/macro.c @@ -152,35 +152,6 @@ macroexpand_export(pic_state *pic, pic_value expr) return pic_none_value(); } -static pic_value -macroexpand_deflibrary(pic_state *pic, pic_value expr) -{ - struct pic_lib *prev = pic->lib; - pic_value v; - - if (pic_length(pic, expr) < 2) { - pic_error(pic, "syntax error"); - } - - pic_make_library(pic, pic_cadr(pic, expr)); - - pic_try { - pic_in_library(pic, pic_cadr(pic, expr)); - - pic_for_each (v, pic_cddr(pic, expr)) { - pic_void(pic_eval(pic, v, pic->lib)); - } - - pic_in_library(pic, prev->name); - } - pic_catch { - pic_in_library(pic, prev->name); /* restores pic->lib even if an error occurs */ - pic_throw_error(pic, pic->err); - } - - return pic_none_value(); -} - static pic_value macroexpand_list(pic_state *pic, pic_value obj, struct pic_senv *senv) { @@ -359,10 +330,7 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv) if (pic_sym_p(car)) { pic_sym tag = pic_sym(car); - if (tag == pic->rDEFINE_LIBRARY) { - return macroexpand_deflibrary(pic, expr); - } - else if (tag == pic->rIMPORT) { + if (tag == pic->rIMPORT) { return macroexpand_import(pic, expr); } else if (tag == pic->rEXPORT) { @@ -519,17 +487,15 @@ pic_define_syntactic_keyword(pic_state *pic, struct pic_senv *senv, pic_sym sym, } void -pic_defmacro(pic_state *pic, const char *name, struct pic_proc *macro) +pic_defmacro(pic_state *pic, pic_sym name, pic_sym id, pic_func_t func) { - pic_sym sym, rename; + pic_put_rename(pic, pic->lib->env, name, id); /* symbol registration */ - sym = pic_intern_cstr(pic, name); - rename = pic_add_rename(pic, pic->lib->env, sym); - define_macro(pic, rename, macro, NULL); + define_macro(pic, id, pic_proc_new(pic, func, pic_symbol_name(pic, name)), NULL); /* auto export! */ - pic_export(pic, sym); + pic_export(pic, name); } bool