/** * See Copyright Notice in picrin.h */ #include "picrin.h" #include "picrin/var.h" #include "picrin/pair.h" static pic_value var_ref(pic_state *pic, struct pic_var *var) { return pic_car(pic, var->stack); } static void var_set(pic_state *pic, struct pic_var *var, pic_value value) { pic_set_car(pic, var->stack, value); } static void var_push(pic_state *pic, struct pic_var *var, pic_value value) { var->stack = pic_cons(pic, value, var->stack); } static void var_pop(pic_state *pic, struct pic_var *var) { var->stack = pic_cdr(pic, var->stack); } struct pic_var * pic_var_new(pic_state *pic, pic_value init) { 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_push(pic, var, init); return var; } pic_value pic_var_ref(pic_state *pic, const char *name) { pic_value v; struct pic_var *var; v = pic_ref(pic, name); pic_assert_type(pic, v, var); var = pic_var_ptr(v); return var_ref(pic, var); } void pic_var_set(pic_state *pic, const char *name, pic_value value) { pic_value v; struct pic_var *var; v = pic_ref(pic, name); pic_assert_type(pic, v, var); var = pic_var_ptr(v); var_set(pic, var, value); } void pic_var_push(pic_state *pic, const char *name, pic_value value) { pic_value v; struct pic_var *var; v = pic_ref(pic, name); pic_assert_type(pic, v, var); var = pic_var_ptr(v); var_push(pic, var, value); } void pic_var_pop(pic_state *pic, const char *name) { pic_value v; struct pic_var *var; v = pic_ref(pic, name); pic_assert_type(pic, v, var); var = pic_var_ptr(v); var_pop(pic, var); } static pic_value pic_var_make_var(pic_state *pic) { pic_value init; pic_get_args(pic, "o", &init); return pic_obj_value(pic_var_new(pic, init)); } static pic_value pic_var_var_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 var_ref(pic, var); } static pic_value pic_var_var_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); var_set(pic, var, val); return pic_none_value(); } static pic_value pic_var_var_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); var_push(pic, var, val); return pic_none_value(); } static pic_value pic_var_var_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); var_pop(pic, var); return pic_none_value(); } void pic_init_var(pic_state *pic) { pic_deflibrary ("(picrin var)") { pic_defun(pic, "make-var", pic_var_make_var); pic_defun(pic, "var-ref", pic_var_var_ref); pic_defun(pic, "var-set!", pic_var_var_set); pic_defun(pic, "var-push!", pic_var_var_push); pic_defun(pic, "var-pop!", pic_var_var_pop); } }