add pic_sc (syntactic closure) structure

This commit is contained in:
Yuichi Nishiwaki 2013-11-27 15:04:02 +09:00
parent 4b2534e2bd
commit ab74920a6f
6 changed files with 31 additions and 2 deletions

View File

@ -25,6 +25,15 @@ struct pic_syntax {
struct pic_proc *macro;
};
struct pic_sc {
PIC_OBJECT_HEADER
pic_value expr;
struct pic_senv *senv;
};
#define pic_sc(v) ((struct pic_sc *)pic_ptr(v))
#define pic_sc_p(v) (pic_type(v) == PIC_TT_SC)
#define pic_syntax(v) ((struct pic_syntax *)pic_ptr(v))
#define pic_syntax_p(v) (pic_type(v) == PIC_TT_SYNTAX)

View File

@ -91,7 +91,8 @@ enum pic_tt {
PIC_TT_ENV,
PIC_TT_CONT,
PIC_TT_SENV,
PIC_TT_SYNTAX
PIC_TT_SYNTAX,
PIC_TT_SC
};
#define PIC_OBJECT_HEADER \

View File

@ -663,7 +663,8 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
case PIC_TT_PORT:
case PIC_TT_ERROR:
case PIC_TT_SENV:
case PIC_TT_SYNTAX: {
case PIC_TT_SYNTAX:
case PIC_TT_SC: {
pic_error(pic, "invalid expression given");
}
}

View File

@ -284,6 +284,12 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
}
break;
}
case PIC_TT_SC: {
struct pic_sc *sc = (struct pic_sc *)obj;
gc_mark(pic, sc->expr);
gc_mark_object(pic, (struct pic_object *)sc->senv);
break;
}
case PIC_TT_NIL:
case PIC_TT_BOOL:
case PIC_TT_FLOAT:
@ -420,6 +426,9 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
case PIC_TT_SYNTAX: {
break;
}
case PIC_TT_SC: {
break;
}
case PIC_TT_NIL:
case PIC_TT_BOOL:
case PIC_TT_FLOAT:

View File

@ -111,6 +111,12 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
int ai = pic_gc_arena_preserve(pic);
switch (pic_type(expr)) {
case PIC_TT_SC: {
struct pic_sc *sc;
sc = pic_sc(expr);
return macroexpand(pic, sc->expr, sc->senv);
}
case PIC_TT_SYMBOL: {
struct xh_entry *e;
while (senv) {

View File

@ -103,6 +103,9 @@ write(pic_state *pic, pic_value obj)
case PIC_TT_SYNTAX:
printf("#<senv %p>", pic_ptr(obj));
break;
case PIC_TT_SC:
printf("#<sc %p>", pic_ptr(obj));
break;
}
}