function reorder
This commit is contained in:
Yuichi Nishiwaki
parent
6d20c0e3e0
commit
631926aa96
207
src/macro.c
207
src/macro.c
|
|
@ -128,41 +128,6 @@ translate(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *c
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
|
||||||
macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv, struct pic_dict *cxt)
|
|
||||||
{
|
|
||||||
size_t ai = pic_gc_arena_preserve(pic);
|
|
||||||
pic_value v, vs;
|
|
||||||
|
|
||||||
/* macroexpand in order */
|
|
||||||
vs = pic_nil_value();
|
|
||||||
while (pic_pair_p(list)) {
|
|
||||||
v = pic_car(pic, list);
|
|
||||||
|
|
||||||
vs = pic_cons(pic, macroexpand(pic, v, senv, cxt), vs);
|
|
||||||
list = pic_cdr(pic, list);
|
|
||||||
|
|
||||||
pic_gc_arena_restore(pic, ai);
|
|
||||||
pic_gc_protect(pic, vs);
|
|
||||||
pic_gc_protect(pic, list);
|
|
||||||
}
|
|
||||||
|
|
||||||
list = macroexpand(pic, list, senv, cxt);
|
|
||||||
|
|
||||||
/* reverse the result */
|
|
||||||
pic_for_each (v, vs) {
|
|
||||||
list = pic_cons(pic, v, list);
|
|
||||||
|
|
||||||
pic_gc_arena_restore(pic, ai);
|
|
||||||
pic_gc_protect(pic, vs);
|
|
||||||
pic_gc_protect(pic, list);
|
|
||||||
}
|
|
||||||
|
|
||||||
pic_gc_arena_restore(pic, ai);
|
|
||||||
pic_gc_protect(pic, list);
|
|
||||||
return list;
|
|
||||||
}
|
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *cxt)
|
macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *cxt)
|
||||||
{
|
{
|
||||||
|
|
@ -170,37 +135,9 @@ macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pi
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand_deflibrary(pic_state *pic, pic_value expr)
|
macroexpand_quote(pic_state *pic, pic_value expr)
|
||||||
{
|
{
|
||||||
struct pic_lib *prev = pic->lib;
|
return pic_cons(pic, pic_sym_value(pic->sQUOTE), pic_cdr(pic, expr));
|
||||||
pic_value v;
|
|
||||||
|
|
||||||
if (pic_length(pic, expr) < 2) {
|
|
||||||
pic_error(pic, "syntax error");
|
|
||||||
}
|
|
||||||
|
|
||||||
pic_make_library(pic, pic_cadr(pic, expr));
|
|
||||||
|
|
||||||
pic_try {
|
|
||||||
pic_in_library(pic, pic_cadr(pic, expr));
|
|
||||||
|
|
||||||
pic_for_each (v, pic_cddr(pic, expr)) {
|
|
||||||
size_t ai = pic_gc_arena_preserve(pic);
|
|
||||||
|
|
||||||
pic_eval(pic, v);
|
|
||||||
|
|
||||||
pic_gc_arena_restore(pic, ai);
|
|
||||||
}
|
|
||||||
|
|
||||||
pic_in_library(pic, prev->name);
|
|
||||||
}
|
|
||||||
pic_catch {
|
|
||||||
/* restores pic->lib even if an error occurs */
|
|
||||||
pic_in_library(pic, prev->name);
|
|
||||||
pic_throw_error(pic, pic->err);
|
|
||||||
}
|
|
||||||
|
|
||||||
return pic_none_value();
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
|
|
@ -251,6 +188,39 @@ macroexpand_export(pic_state *pic, pic_value expr)
|
||||||
return pic_none_value();
|
return pic_none_value();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static pic_value
|
||||||
|
macroexpand_deflibrary(pic_state *pic, pic_value expr)
|
||||||
|
{
|
||||||
|
struct pic_lib *prev = pic->lib;
|
||||||
|
pic_value v;
|
||||||
|
|
||||||
|
if (pic_length(pic, expr) < 2) {
|
||||||
|
pic_error(pic, "syntax error");
|
||||||
|
}
|
||||||
|
|
||||||
|
pic_make_library(pic, pic_cadr(pic, expr));
|
||||||
|
|
||||||
|
pic_try {
|
||||||
|
pic_in_library(pic, pic_cadr(pic, expr));
|
||||||
|
|
||||||
|
pic_for_each (v, pic_cddr(pic, expr)) {
|
||||||
|
size_t ai = pic_gc_arena_preserve(pic);
|
||||||
|
|
||||||
|
pic_eval(pic, v);
|
||||||
|
|
||||||
|
pic_gc_arena_restore(pic, ai);
|
||||||
|
}
|
||||||
|
|
||||||
|
pic_in_library(pic, prev->name);
|
||||||
|
}
|
||||||
|
pic_catch {
|
||||||
|
pic_in_library(pic, prev->name); /* restores pic->lib even if an error occurs */
|
||||||
|
pic_throw_error(pic, pic->err);
|
||||||
|
}
|
||||||
|
|
||||||
|
return pic_none_value();
|
||||||
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
|
macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
|
||||||
{
|
{
|
||||||
|
|
@ -337,6 +307,74 @@ macroexpand_defmacro(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
||||||
return pic_none_value();
|
return pic_none_value();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static pic_value
|
||||||
|
macroexpand_macro(pic_state *pic, struct pic_macro *mac, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
|
||||||
|
{
|
||||||
|
pic_value v, args;
|
||||||
|
|
||||||
|
#if DEBUG
|
||||||
|
puts("before expand-1:");
|
||||||
|
pic_debug(pic, expr);
|
||||||
|
puts("");
|
||||||
|
#endif
|
||||||
|
|
||||||
|
if (mac->senv == NULL) { /* legacy macro */
|
||||||
|
args = pic_cdr(pic, expr);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
args = pic_list3(pic, expr, pic_obj_value(senv), pic_obj_value(mac->senv));
|
||||||
|
}
|
||||||
|
|
||||||
|
pic_try {
|
||||||
|
v = pic_apply(pic, mac->proc, args);
|
||||||
|
} pic_catch {
|
||||||
|
pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
|
||||||
|
}
|
||||||
|
|
||||||
|
#if DEBUG
|
||||||
|
puts("after expand-1:");
|
||||||
|
pic_debug(pic, v);
|
||||||
|
puts("");
|
||||||
|
#endif
|
||||||
|
|
||||||
|
return macroexpand(pic, v, senv, cxt);
|
||||||
|
}
|
||||||
|
|
||||||
|
static pic_value
|
||||||
|
macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv, struct pic_dict *cxt)
|
||||||
|
{
|
||||||
|
size_t ai = pic_gc_arena_preserve(pic);
|
||||||
|
pic_value v, vs;
|
||||||
|
|
||||||
|
/* macroexpand in order */
|
||||||
|
vs = pic_nil_value();
|
||||||
|
while (pic_pair_p(list)) {
|
||||||
|
v = pic_car(pic, list);
|
||||||
|
|
||||||
|
vs = pic_cons(pic, macroexpand(pic, v, senv, cxt), vs);
|
||||||
|
list = pic_cdr(pic, list);
|
||||||
|
|
||||||
|
pic_gc_arena_restore(pic, ai);
|
||||||
|
pic_gc_protect(pic, vs);
|
||||||
|
pic_gc_protect(pic, list);
|
||||||
|
}
|
||||||
|
|
||||||
|
list = macroexpand(pic, list, senv, cxt);
|
||||||
|
|
||||||
|
/* reverse the result */
|
||||||
|
pic_for_each (v, vs) {
|
||||||
|
list = pic_cons(pic, v, list);
|
||||||
|
|
||||||
|
pic_gc_arena_restore(pic, ai);
|
||||||
|
pic_gc_protect(pic, vs);
|
||||||
|
pic_gc_protect(pic, list);
|
||||||
|
}
|
||||||
|
|
||||||
|
pic_gc_arena_restore(pic, ai);
|
||||||
|
pic_gc_protect(pic, list);
|
||||||
|
return list;
|
||||||
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
|
macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
|
||||||
{
|
{
|
||||||
|
|
@ -400,45 +438,6 @@ macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv, struct
|
||||||
return pic_cons(pic, pic_sym_value(pic->sLAMBDA), pic_cons(pic, formal, body));
|
return pic_cons(pic, pic_sym_value(pic->sLAMBDA), pic_cons(pic, formal, body));
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
|
||||||
macroexpand_quote(pic_state *pic, pic_value expr)
|
|
||||||
{
|
|
||||||
return pic_cons(pic, pic_sym_value(pic->sQUOTE), pic_cdr(pic, expr));
|
|
||||||
}
|
|
||||||
|
|
||||||
static pic_value
|
|
||||||
macroexpand_macro(pic_state *pic, struct pic_macro *mac, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
|
|
||||||
{
|
|
||||||
pic_value v, args;
|
|
||||||
|
|
||||||
#if DEBUG
|
|
||||||
puts("before expand-1:");
|
|
||||||
pic_debug(pic, expr);
|
|
||||||
puts("");
|
|
||||||
#endif
|
|
||||||
|
|
||||||
if (mac->senv == NULL) { /* legacy macro */
|
|
||||||
args = pic_cdr(pic, expr);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
args = pic_list3(pic, expr, pic_obj_value(senv), pic_obj_value(mac->senv));
|
|
||||||
}
|
|
||||||
|
|
||||||
pic_try {
|
|
||||||
v = pic_apply(pic, mac->proc, args);
|
|
||||||
} pic_catch {
|
|
||||||
pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
|
|
||||||
}
|
|
||||||
|
|
||||||
#if DEBUG
|
|
||||||
puts("after expand-1:");
|
|
||||||
pic_debug(pic, v);
|
|
||||||
puts("");
|
|
||||||
#endif
|
|
||||||
|
|
||||||
return macroexpand(pic, v, senv, cxt);
|
|
||||||
}
|
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
|
macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
|
||||||
{
|
{
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue