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

support macroexpansion of inter-referential definitions

This commit is contained in:
Yuichi Nishiwaki 2014-09-10 14:42:36 +09:00
parent 654bc2c2d6
commit ff82e59066
3 changed files with 40 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
gc.c
View File

@ -453,6 +453,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
if (senv->up) {
gc_mark_object(pic, (struct pic_object *)senv->up);
}
gc_mark(pic, senv->defer);
break;
}
case PIC_TT_LIB: {

1
include/picrin/macro.h
View File

@ -12,6 +12,7 @@ extern "C" {
struct pic_senv {
PIC_OBJECT_HEADER
xhash map;
pic_value defer;
struct pic_senv *up;
};

39
macro.c
View File

@ -91,6 +91,7 @@ make_identifier(pic_state *pic, pic_sym sym, struct pic_senv *senv)
}
static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *);
static pic_value macroexpand_lambda(pic_state *, pic_value, struct pic_senv *);
static pic_value
macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv)
@ -123,6 +124,35 @@ macroexpand_list(pic_state *pic, pic_value obj, struct pic_senv *senv)
return x;
}
static pic_value
macroexpand_defer(pic_state *pic, pic_value expr, struct pic_senv *senv)
{
pic_value skel = pic_list1(pic, pic_none_value()); /* (#<none>) */
pic_push(pic, pic_cons(pic, expr, skel), senv->defer);
return skel;
}
static void
macroexpand_deferred(pic_state *pic, struct pic_senv *senv)
{
pic_value defer, val, src, dst;
pic_for_each (defer, pic_reverse(pic, senv->defer)) {
src = pic_car(pic, defer);
dst = pic_cdr(pic, defer);
val = macroexpand_lambda(pic, src, senv);
/* copy */
pic_pair_ptr(dst)->car = pic_car(pic, val);
pic_pair_ptr(dst)->cdr = pic_cdr(pic, val);
}
senv->defer = pic_nil_value();
}
static pic_value
macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv)
{
@ -154,6 +184,8 @@ macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv)
formal = macroexpand_list(pic, pic_cadr(pic, expr), in);
body = macroexpand_list(pic, pic_cddr(pic, expr), in);
macroexpand_deferred(pic, in);
return pic_cons(pic, pic_sym_value(pic->rLAMBDA), pic_cons(pic, formal, body));
}
@ -280,7 +312,7 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv)
return macroexpand_defsyntax(pic, expr, senv);
}
else if (tag == pic->rLAMBDA) {
return macroexpand_lambda(pic, expr, senv);
return macroexpand_defer(pic, expr, senv);
}
else if (tag == pic->rDEFINE) {
return macroexpand_define(pic, expr, senv);
@ -326,6 +358,8 @@ pic_macroexpand(pic_state *pic, pic_value expr, struct pic_lib *lib)
struct pic_lib *prev;
pic_value v;
assert(pic_eq_p(lib->env->defer, pic_nil_value()));
#if DEBUG
puts("before expand:");
pic_debug(pic, expr);
@ -338,6 +372,8 @@ pic_macroexpand(pic_state *pic, pic_value expr, struct pic_lib *lib)
v = macroexpand(pic, expr, lib->env);
macroexpand_deferred(pic, lib->env);
pic->lib = prev;
#if DEBUG
@ -356,6 +392,7 @@ pic_senv_new(pic_state *pic, struct pic_senv *up)
senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
senv->up = up;
senv->defer = pic_nil_value();
xh_init_int(&senv->map, sizeof(pic_sym));
return senv;