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

define 'import' and 'export' as macros

This commit is contained in:
Yuichi Nishiwaki 2014-07-28 01:02:48 +09:00
parent 9c1a397ead
commit d31e20c25c
2 changed files with 53 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
src/lib.c
View File

@ -115,6 +115,56 @@ 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_import(pic_state *pic)
{
size_t argc, i;
pic_value *argv;
pic_get_args(pic, "*", &argc, &argv);
for (i = 0; i < argc; ++i) {
pic_import(pic, argv[i]);
}
return pic_none_value();
}
static pic_value
pic_lib_export(pic_state *pic)
{
const pic_sym sRENAME = pic_intern_cstr(pic, "rename");
size_t argc, i;
pic_value *argv, spec, a, b;
pic_get_args(pic, "*", &argc, &argv);
for (i = 0; i < argc; ++i) {
spec = argv[i];
if (pic_sym_p(spec)) { /* (export a) */
pic_export(pic, pic_sym(spec));
}
else { /* (export (rename a b)) */
if (! pic_list_p(spec))
goto fail;
if (! pic_length(pic, spec) == 3)
goto fail;
if (! pic_eq_p(pic_car(pic, spec), pic_sym_value(sRENAME)))
goto fail;
if (! pic_sym_p(a = pic_list_ref(pic, spec, 1)))
goto fail;
if (! pic_sym_p(b = pic_list_ref(pic, spec, 2)))
goto fail;
pic_export_as(pic, pic_sym(a), pic_sym(b));
}
}
return pic_none_value();
fail:
pic_errorf(pic, "illegal export spec: ~s", spec);
}
static pic_value
pic_lib_define_library(pic_state *pic)
{
@ -148,7 +198,7 @@ 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->sIMPORT, pic->rIMPORT, pic_lib_import);
pic_defmacro(pic, pic->sEXPORT, pic->rEXPORT, pic_lib_export);
pic_defmacro(pic, pic->sDEFINE_LIBRARY, pic->rDEFINE_LIBRARY, pic_lib_define_library);
}

56
src/macro.c
View File

@ -104,54 +104,6 @@ macroexpand_quote(pic_state *pic, pic_value expr)
return pic_cons(pic, pic_sym_value(pic->rQUOTE), pic_cdr(pic, expr));
}
static pic_value
macroexpand_import(pic_state *pic, pic_value expr)
{
pic_value spec;
pic_for_each (spec, pic_cdr(pic, expr)) {
pic_import(pic, spec);
}
return pic_none_value();
}
static pic_value
macroexpand_export(pic_state *pic, pic_value expr)
{
extern pic_value pic_export_as(pic_state *, pic_sym, pic_sym);
pic_value spec;
pic_sym sRENAME, sym, as;
sRENAME = pic_intern_cstr(pic, "rename");
pic_for_each (spec, pic_cdr(pic, expr)) {
if (pic_sym_p(spec)) {
sym = as = pic_sym(spec);
}
else if (pic_list_p(spec) && pic_eq_p(pic_car(pic, spec), pic_sym_value(sRENAME))) {
if (pic_length(pic, spec) != 3) {
pic_error(pic, "syntax error");
}
if (! pic_sym_p(pic_list_ref(pic, spec, 1))) {
pic_error(pic, "syntax error");
}
sym = pic_sym(pic_list_ref(pic, spec, 1));
if (! pic_sym_p(pic_list_ref(pic, spec, 2))) {
pic_error(pic, "syntax error");
}
as = pic_sym(pic_list_ref(pic, spec, 2));
}
else {
pic_error(pic, "syntax error");
}
/* TODO: warn if symbol is shadowed by local variable */
pic_export_as(pic, sym, as);
}
return pic_none_value();
}
static pic_value
macroexpand_list(pic_state *pic, pic_value obj, struct pic_senv *senv)
{
@ -330,13 +282,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->rIMPORT) {
return macroexpand_import(pic, expr);
}
else if (tag == pic->rEXPORT) {
return macroexpand_export(pic, expr);
}
else if (tag == pic->rDEFINE_SYNTAX) {
if (tag == pic->rDEFINE_SYNTAX) {
return macroexpand_defsyntax(pic, expr, senv);
}
else if (tag == pic->rLAMBDA) {