support macroexpansion of inter-referential definitions
This commit is contained in:
parent
654bc2c2d6
commit
ff82e59066
1
gc.c
1
gc.c
|
@ -453,6 +453,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
|
||||||
if (senv->up) {
|
if (senv->up) {
|
||||||
gc_mark_object(pic, (struct pic_object *)senv->up);
|
gc_mark_object(pic, (struct pic_object *)senv->up);
|
||||||
}
|
}
|
||||||
|
gc_mark(pic, senv->defer);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case PIC_TT_LIB: {
|
case PIC_TT_LIB: {
|
||||||
|
|
|
@ -12,6 +12,7 @@ extern "C" {
|
||||||
struct pic_senv {
|
struct pic_senv {
|
||||||
PIC_OBJECT_HEADER
|
PIC_OBJECT_HEADER
|
||||||
xhash map;
|
xhash map;
|
||||||
|
pic_value defer;
|
||||||
struct pic_senv *up;
|
struct pic_senv *up;
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
39
macro.c
39
macro.c
|
@ -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(pic_state *, pic_value, struct pic_senv *);
|
||||||
|
static pic_value macroexpand_lambda(pic_state *, pic_value, struct pic_senv *);
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv)
|
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;
|
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
|
static pic_value
|
||||||
macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
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);
|
formal = macroexpand_list(pic, pic_cadr(pic, expr), in);
|
||||||
body = macroexpand_list(pic, pic_cddr(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));
|
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);
|
return macroexpand_defsyntax(pic, expr, senv);
|
||||||
}
|
}
|
||||||
else if (tag == pic->rLAMBDA) {
|
else if (tag == pic->rLAMBDA) {
|
||||||
return macroexpand_lambda(pic, expr, senv);
|
return macroexpand_defer(pic, expr, senv);
|
||||||
}
|
}
|
||||||
else if (tag == pic->rDEFINE) {
|
else if (tag == pic->rDEFINE) {
|
||||||
return macroexpand_define(pic, expr, senv);
|
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;
|
struct pic_lib *prev;
|
||||||
pic_value v;
|
pic_value v;
|
||||||
|
|
||||||
|
assert(pic_eq_p(lib->env->defer, pic_nil_value()));
|
||||||
|
|
||||||
#if DEBUG
|
#if DEBUG
|
||||||
puts("before expand:");
|
puts("before expand:");
|
||||||
pic_debug(pic, expr);
|
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);
|
v = macroexpand(pic, expr, lib->env);
|
||||||
|
|
||||||
|
macroexpand_deferred(pic, lib->env);
|
||||||
|
|
||||||
pic->lib = prev;
|
pic->lib = prev;
|
||||||
|
|
||||||
#if DEBUG
|
#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 = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
|
||||||
senv->up = up;
|
senv->up = up;
|
||||||
|
senv->defer = pic_nil_value();
|
||||||
xh_init_int(&senv->map, sizeof(pic_sym));
|
xh_init_int(&senv->map, sizeof(pic_sym));
|
||||||
|
|
||||||
return senv;
|
return senv;
|
||||||
|
|
Loading…
Reference in New Issue