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

[bugfix] syntax objects should be brought to imported library's 

senv->stx holder
This commit is contained in:
Yuichi Nishiwaki 2013-12-08 00:52:34 -08:00
parent dda8ad367c
commit 5035831d84
2 changed files with 28 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
include/picrin.h
View File

@ -137,7 +137,6 @@ struct pic_lib *pic_find_library(pic_state *, pic_value);
} }
void pic_export(pic_state *, pic_sym); void pic_export(pic_state *, pic_sym);
void pic_export_as(pic_state *, pic_sym, pic_sym);
void pic_abort(pic_state *, const char *); void pic_abort(pic_state *, const char *);
void pic_raise(pic_state *, pic_value); void pic_raise(pic_state *, pic_value);

43
src/macro.c
View File

@ -179,13 +179,13 @@ pic_identifier_p(pic_value obj)
void void
pic_export(pic_state *pic, pic_sym sym) pic_export(pic_state *pic, pic_sym sym)
{ {
pic_export_as(pic, sym, sym); struct xh_entry *e;
}
void e = xh_get(pic->lib->senv->tbl, pic_symbol_name(pic, sym));
pic_export_as(pic_state *pic, pic_sym sym, pic_sym alias) if (! e) {
{ pic_error(pic, "symbol not defined");
xh_put(pic->lib->exports, pic_symbol_name(pic, sym), (int)alias); }
xh_put(pic->lib->exports, e->key, e->val);
} }
static void static void
@ -274,21 +274,34 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
#if DEBUG #if DEBUG
printf("* importing %s as %s\n", it.e->key, pic_symbol_name(pic, (pic_sym)it.e->val)); printf("* importing %s as %s\n", it.e->key, pic_symbol_name(pic, (pic_sym)it.e->val));
#endif #endif
xh_put(pic->lib->senv->tbl, it.e->key, it.e->val); if (it.e->val >= 0) {
xh_put(pic->lib->senv->tbl, it.e->key, it.e->val);
}
else { /* syntax object */
int idx;
struct pic_senv *senv = pic->lib->senv;
idx = senv->xlen;
if (idx >= senv->xcapa) {
pic_abort(pic, "macro table overflow");
}
/* bring macro object from imported lib */
senv->stx[idx] = lib->senv->stx[~it.e->val];
xh_put(senv->tbl, it.e->key, ~idx);
senv->xlen++;
}
xh_next(lib->exports, &it); xh_next(lib->exports, &it);
} }
return pic_false_value(); return pic_false_value();
} }
case PIC_STX_EXPORT: { case PIC_STX_EXPORT: {
pic_sym orig, ren; v = pic_cadr(pic, expr);
pic_value v; if (! pic_symbol_p(v)) {
pic_error(pic, "syntax error");
orig = ren = pic_sym(pic_cadr(pic, expr));
v = macroexpand(pic, pic_cadr(pic, expr), senv);
if (pic_symbol_p(v)) {
ren = pic_sym(v);
} }
pic_export_as(pic, orig, ren); /* TODO: warn if symbol is shadowed by local variable */
pic_export(pic, pic_sym(v));
return pic_false_value(); return pic_false_value();
} }
case PIC_STX_DEFSYNTAX: { case PIC_STX_DEFSYNTAX: {