diff --git a/include/picrin/var.h b/include/picrin/var.h index 69eac2ca..d3bbaf4e 100644 --- a/include/picrin/var.h +++ b/include/picrin/var.h @@ -12,12 +12,13 @@ extern "C" { struct pic_var { PIC_OBJECT_HEADER pic_value stack; + struct pic_proc *conv; }; #define pic_var_p(o) (pic_type(o) == PIC_TT_VAR) #define pic_var_ptr(o) ((struct pic_var *)pic_ptr(o)) -struct pic_var *pic_var_new(pic_state *, pic_value); +struct pic_var *pic_var_new(pic_state *, pic_value, struct pic_proc * /* = NULL */); pic_value pic_var_ref(pic_state *, struct pic_var *); void pic_var_set(pic_state *, struct pic_var *, pic_value); diff --git a/src/gc.c b/src/gc.c index e673f045..3d28aa96 100644 --- a/src/gc.c +++ b/src/gc.c @@ -469,6 +469,9 @@ gc_mark_object(pic_state *pic, struct pic_object *obj) case PIC_TT_VAR: { struct pic_var *var = (struct pic_var *)obj; gc_mark(pic, var->stack); + if (var->conv) { + gc_mark_object(pic, (struct pic_object *)var->conv); + } break; } case PIC_TT_IREP: { diff --git a/src/var.c b/src/var.c index 5bf215b6..a5df8bb0 100644 --- a/src/var.c +++ b/src/var.c @@ -7,12 +7,13 @@ #include "picrin/pair.h" struct pic_var * -pic_var_new(pic_state *pic, pic_value init) +pic_var_new(pic_state *pic, pic_value init, struct pic_proc *conv) { struct pic_var *var; var = (struct pic_var *)pic_obj_alloc(pic, sizeof(struct pic_var), PIC_TT_VAR); var->stack = pic_nil_value(); + var->conv = conv; pic_var_push(pic, var, init); @@ -28,12 +29,18 @@ pic_var_ref(pic_state *pic, struct pic_var *var) void pic_var_set(pic_state *pic, struct pic_var *var, pic_value value) { + if (var->conv != NULL) { + value = pic_apply1(pic, var->conv, value); + } pic_set_car(pic, var->stack, value); } void pic_var_push(pic_state *pic, struct pic_var *var, pic_value value) { + if (var->conv != NULL) { + value = pic_apply1(pic, var->conv, value); + } var->stack = pic_cons(pic, value, var->stack); } @@ -46,11 +53,12 @@ pic_var_pop(pic_state *pic, struct pic_var *var) static pic_value pic_var_make_var(pic_state *pic) { + struct pic_proc *conv = NULL; pic_value init; - pic_get_args(pic, "o", &init); + pic_get_args(pic, "o|l", &init, &conv); - return pic_obj_value(pic_var_new(pic, init)); + return pic_obj_value(pic_var_new(pic, init, conv)); } static pic_value