diff --git a/gc.c b/gc.c index 9e669de4..2d61be7f 100644 --- a/gc.c +++ b/gc.c @@ -15,7 +15,6 @@ #include "picrin/error.h" #include "picrin/macro.h" #include "picrin/lib.h" -#include "picrin/var.h" #include "picrin/data.h" #include "picrin/dict.h" #include "picrin/record.h" @@ -462,14 +461,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj) gc_mark_object(pic, (struct pic_object *)lib->env); break; } - 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: { struct pic_irep *irep = (struct pic_irep *)obj; size_t i; @@ -699,9 +690,6 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj) xh_destroy(&lib->exports); break; } - case PIC_TT_VAR: { - break; - } case PIC_TT_IREP: { struct pic_irep *irep = (struct pic_irep *)obj; pic_free(pic, irep->code); diff --git a/include/picrin.h b/include/picrin.h index 39b55161..8719b79e 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -217,6 +217,8 @@ static inline void pic_warn(pic_state *pic, const char *msg) const char *pic_errmsg(pic_state *); +struct pic_proc *pic_make_var(pic_state *, pic_value, struct pic_proc *); + struct pic_port *pic_stdin(pic_state *); struct pic_port *pic_stdout(pic_state *); struct pic_port *pic_stderr(pic_state *); diff --git a/include/picrin/value.h b/include/picrin/value.h index 18637de1..0523c688 100644 --- a/include/picrin/value.h +++ b/include/picrin/value.h @@ -121,7 +121,6 @@ enum pic_tt { PIC_TT_SENV, PIC_TT_MACRO, PIC_TT_LIB, - PIC_TT_VAR, PIC_TT_IREP, PIC_TT_DATA, PIC_TT_DICT, @@ -266,8 +265,6 @@ pic_type_repr(enum pic_tt tt) return "macro"; case PIC_TT_LIB: return "lib"; - case PIC_TT_VAR: - return "var"; case PIC_TT_IREP: return "irep"; case PIC_TT_DATA: diff --git a/include/picrin/var.h b/include/picrin/var.h deleted file mode 100644 index 793d3724..00000000 --- a/include/picrin/var.h +++ /dev/null @@ -1,30 +0,0 @@ -/** - * See Copyright Notice in picrin.h - */ - -#ifndef PICRIN_VAR_H -#define PICRIN_VAR_H - -#if defined(__cplusplus) -extern "C" { -#endif - -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_make_var(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); - -#if defined(__cplusplus) -} -#endif - -#endif diff --git a/port.c b/port.c index 94641c06..6b27040d 100644 --- a/port.c +++ b/port.c @@ -11,7 +11,6 @@ #include "picrin/port.h" #include "picrin/string.h" #include "picrin/blob.h" -#include "picrin/var.h" pic_value pic_eof_object() diff --git a/var.c b/var.c index a91245ef..e74e0566 100644 --- a/var.c +++ b/var.c @@ -3,53 +3,91 @@ */ #include "picrin.h" -#include "picrin/var.h" #include "picrin/pair.h" +#include "picrin/proc.h" +#include "picrin/dict.h" -struct pic_var * +static pic_value +var_lookup(pic_state *pic, pic_value var) +{ + pic_value val, env; + struct pic_dict *binding; + + val = pic_ref(pic, pic->PICRIN_BASE, "current-dynamic-environment"); + if (pic_eq_p(val, var)) { + return pic_false_value(); + } + + env = pic_funcall(pic, "current-dynamic-environment", pic_nil_value()); + while (! pic_nil_p(env)) { + pic_assert_type(pic, pic_car(pic, env), dict); + + binding = pic_dict_ptr(pic_car(pic, env)); + if (pic_dict_has(pic, binding, var)) { + return pic_dict_ref(pic, binding, var); + } + env = pic_cdr(pic, env); + } + + return pic_false_value(); +} + +static pic_value +var_call(pic_state *pic) +{ + struct pic_proc *self = pic_get_proc(pic); + pic_value val, tmp, box, conv; + size_t n; + + n = pic_get_args(pic, "|oo", &val, &tmp); + + box = var_lookup(pic, pic_obj_value(self)); + if (! pic_test(box)) { + box = pic_attr_ref(pic, self, "@@box"); + } + + switch (n) { + case 0: + return pic_car(pic, box); + + case 1: + conv = pic_attr_ref(pic, self, "@@converter"); + if (pic_test(conv)) { + pic_assert_type(pic, conv, proc); + + val = pic_apply1(pic, pic_proc_ptr(conv), val); + } + pic_set_car(pic, box, val); + + return pic_none_value(); + + case 2: + assert(pic_false_p(tmp)); + + conv = pic_attr_ref(pic, self, "@@converter"); + if (pic_test(conv)) { + pic_assert_type(pic, conv, proc); + + return pic_apply1(pic, pic_proc_ptr(conv), val); + } else { + return val; + } + } + UNREACHABLE(); +} + +struct pic_proc * pic_make_var(pic_state *pic, pic_value init, struct pic_proc *conv) { - struct pic_var *var; + struct pic_proc *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); + var = pic_make_proc(pic, var_call, ""); + pic_attr_set(pic, var, "@@box", pic_list1(pic, init)); + pic_attr_set(pic, var, "@@converter", conv ? pic_obj_value(conv) : pic_false_value()); return var; } -pic_value -pic_var_ref(pic_state *pic, struct pic_var *var) -{ - return pic_car(pic, var->stack); -} - -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); -} - -void -pic_var_pop(pic_state *pic, struct pic_var *var) -{ - var->stack = pic_cdr(pic, var->stack); -} - static pic_value pic_var_make_parameter(pic_state *pic) { @@ -61,72 +99,12 @@ pic_var_make_parameter(pic_state *pic) return pic_obj_value(pic_make_var(pic, init, conv)); } -static pic_value -pic_var_parameter_ref(pic_state *pic) -{ - struct pic_var *var; - pic_value v; - - pic_get_args(pic, "o", &v); - - pic_assert_type(pic, v, var); - - var = pic_var_ptr(v); - - return pic_var_ref(pic, var); -} - -static pic_value -pic_var_parameter_set(pic_state *pic) -{ - struct pic_var *var; - pic_value v, val; - - pic_get_args(pic, "oo", &v, &val); - - pic_assert_type(pic, v, var); - - var = pic_var_ptr(v); - pic_var_set(pic, var, val); - return pic_none_value(); -} - -static pic_value -pic_var_parameter_push(pic_state *pic) -{ - struct pic_var *var; - pic_value v, val; - - pic_get_args(pic, "oo", &v, &val); - - pic_assert_type(pic, v, var); - - var = pic_var_ptr(v); - pic_var_push(pic, var, val); - return pic_none_value(); -} - -static pic_value -pic_var_parameter_pop(pic_state *pic) -{ - struct pic_var *var; - pic_value v; - - pic_get_args(pic, "o", &v); - - pic_assert_type(pic, v, var); - - var = pic_var_ptr(v); - pic_var_pop(pic, var); - return pic_none_value(); -} - void pic_init_var(pic_state *pic) { + pic_define(pic, "current-dynamic-environment", pic_false_value()); + pic_defun(pic, "make-parameter", pic_var_make_parameter); - pic_defun(pic, "parameter-ref", pic_var_parameter_ref); - pic_defun(pic, "parameter-set!", pic_var_parameter_set); - pic_defun(pic, "parameter-push!", pic_var_parameter_push); - pic_defun(pic, "parameter-pop!", pic_var_parameter_pop); + + pic_set(pic, pic->PICRIN_BASE, "current-dynamic-environment", pic_obj_value(pic_make_var(pic, pic_nil_value(), NULL))); } diff --git a/vm.c b/vm.c index be82543f..05ddda7c 100644 --- a/vm.c +++ b/vm.c @@ -15,7 +15,6 @@ #include "picrin/port.h" #include "picrin/irep.h" #include "picrin/blob.h" -#include "picrin/var.h" #include "picrin/lib.h" #include "picrin/macro.h" #include "picrin/error.h" @@ -826,15 +825,6 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) L_CALL: x = pic->sp[-c.u.i]; if (! pic_proc_p(x)) { - - if (pic_var_p(x)) { - if (c.u.i != 1) { - pic_errorf(pic, "invalid call-sequence for var object"); - } - POP(); - PUSH(pic_var_ref(pic, pic_var_ptr(x))); - NEXT; - } pic_errorf(pic, "invalid application: ~s", x); } proc = pic_proc_ptr(x);