diff --git a/include/picrin.h b/include/picrin.h index d4262b45..fec7bd9d 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -124,6 +124,7 @@ pic_value pic_macroexpand(pic_state *, pic_value); void pic_make_library(pic_state *, const char *); void pic_in_library(pic_state *, const char *); +struct pic_lib *pic_find_library(pic_state *, pic_value); void pic_abort(pic_state *, const char *); void pic_raise(pic_state *, pic_value); diff --git a/src/lib.c b/src/lib.c index 2f7a5dd2..ba7ac212 100644 --- a/src/lib.c +++ b/src/lib.c @@ -42,3 +42,15 @@ pic_in_library(pic_state *pic, const char *name) pic->lib = pic_lib_ptr(pic_cdr(pic, v)); } + +struct pic_lib * +pic_find_library(pic_state *pic, pic_value spec) +{ + pic_value v; + + v = pic_assoc(pic, spec, pic->lib_tbl); + if (pic_false_p(v)) { + return NULL; + } + return pic_lib_ptr(pic_cdr(pic, v)); +} diff --git a/src/macro.c b/src/macro.c index 7dddcf60..807355b2 100644 --- a/src/macro.c +++ b/src/macro.c @@ -238,17 +238,41 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv) pic_value program; struct pic_senv *senv; - /* FIXME: replace it with null-env once import is implemented */ - senv = pic_core_syntactic_env(pic); + senv = pic_minimal_syntactic_env(pic); + if (pic_length(pic, expr) < 2) { + pic_error(pic, "syntax error"); + } program = macroexpand_list(pic, pic_cddr(pic, expr), senv); return pic_cons(pic, pic_symbol_value(pic->sBEGIN), program); } - case PIC_STX_IMPORT: + case PIC_STX_IMPORT: { + struct pic_lib *lib; + struct xh_iterator it; + + lib = pic_find_library(pic, pic_cadr(pic, expr)); + if (! lib) { + pic_error(pic, "library not found"); + } + it = xh_begin(lib->exports); + while (! xh_isend(&it)) { + xh_put(pic->lib->senv->tbl, it.e->key, it.e->val); + xh_next(lib->exports, &it); + } + return pic_false_value(); + } case PIC_STX_EXPORT: { - puts("FIXME: import/export"); - abort(); + pic_sym orig, ren; + pic_value v; + + orig = ren = pic_sym(pic_car(pic, expr)); + v = macroexpand(pic, pic_car(pic, expr), senv); + if (pic_symbol_p(v)) { + ren = pic_sym(v); + } + xh_put(pic->lib->exports, pic_symbol_name(pic, orig), (int)ren); + return pic_false_value(); } case PIC_STX_DEFSYNTAX: { pic_value var, val;