From 7ffcbb7a7deade7dd9e2684ba7b234eb13cff540 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 12 Jul 2014 22:30:50 +0900 Subject: [PATCH] refactor var. c api no longer supports converters. --- include/picrin/var.h | 7 +-- piclib/built-in.scm | 35 +++++++++-- src/gc.c | 3 - src/var.c | 142 +++++++++++++------------------------------ 4 files changed, 75 insertions(+), 112 deletions(-) diff --git a/include/picrin/var.h b/include/picrin/var.h index 883b4612..73afaaba 100644 --- a/include/picrin/var.h +++ b/include/picrin/var.h @@ -12,16 +12,15 @@ extern "C" { struct pic_var { PIC_OBJECT_HEADER pic_value value; - 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_proc *); +struct pic_var *pic_var_new(pic_state *, pic_value); -struct pic_proc *pic_wrap_var(pic_state *, struct pic_var *); -struct pic_var *pic_unwrap_var(pic_state *, struct pic_proc *); +pic_value pic_var_ref(pic_state *, const char *); +void pic_var_set(pic_state *, const char *, pic_value); #if defined(__cplusplus) } diff --git a/piclib/built-in.scm b/piclib/built-in.scm index d5a7b726..f598310a 100644 --- a/piclib/built-in.scm +++ b/piclib/built-in.scm @@ -410,10 +410,34 @@ (import (scheme base) (scheme cxr) (picrin macro) - (picrin core-syntax)) + (picrin core-syntax) + (picrin var)) - ;; reopen (pircin parameter) - ;; see src/var.c + (define (single? x) + (and (list? x) (= (length x) 1))) + + (define (double? x) + (and (list? x) (= (length x) 2))) + + (define (%make-parameter init conv) + (let ((var (make-var (conv init)))) + (lambda args + (cond + ((null? args) + (var-ref var)) + ((single? args) + (var-set! var (conv (car args)))) + ((double? args) + (var-set! var ((cadr args) (car args)))) + (else + (error "invalid arguments for parameter")))))) + + (define (make-parameter init . conv) + (let ((conv + (if (null? conv) + (lambda (x) x) + (car conv)))) + (%make-parameter init conv))) (define-syntax parameterize (er-macro-transformer @@ -432,11 +456,12 @@ ,@bindings (,(r 'let) ((,(r 'result) (begin ,@body))) ,@(map (lambda (var) - `(,(r 'parameter-set!) ,var ,(r (gensym var)))) + `(,var ,(r (gensym var)) (,(r 'lambda) (x) x))) vars) ,(r 'result)))))))) - (export parameterize)) + (export make-parameter + parameterize)) ;;; Record Type (define-library (picrin record) diff --git a/src/gc.c b/src/gc.c index ea3c35b3..cfaffa60 100644 --- a/src/gc.c +++ b/src/gc.c @@ -476,9 +476,6 @@ 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->value); - 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 41dd7fef..76d3c297 100644 --- a/src/var.c +++ b/src/var.c @@ -14,158 +14,100 @@ var_ref(pic_state *pic, struct pic_var *var) } static void -var_set_force(pic_state *pic, struct pic_var *var, pic_value value) +var_set(pic_state *pic, struct pic_var *var, pic_value value) { UNUSED(pic); var->value = value; } -static void -var_set(pic_state *pic, struct pic_var *var, pic_value value) -{ - if (var->conv) { - value = pic_apply1(pic, var->conv, value); - } - var_set_force(pic, var, value); -} - struct pic_var * -pic_var_new(pic_state *pic, pic_value init, struct pic_proc *conv /* = NULL */) +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->value = pic_undef_value(); - var->conv = conv; - - var_set(pic, var, init); + var->value = init; return var; } -static pic_value -var_call(pic_state *pic) +pic_value +pic_var_ref(pic_state *pic, const char *name) { - struct pic_proc *proc; + pic_value v; struct pic_var *var; - pic_value v; - int c; - proc = pic_get_proc(pic); + v = pic_ref(pic, name); - c = pic_get_args(pic, "|o", &v); - if (c == 0) { - var = pic_var_ptr(proc->env->regs[0]); - return var_ref(pic, var); - } - else if (c == 1) { - var = pic_var_ptr(proc->env->regs[0]); + pic_assert_type(pic, v, var); - var_set(pic, var, v); - return pic_none_value(); - } - else { - pic_abort(pic, "logic flaw"); - } - UNREACHABLE(); + var = pic_var_ptr(v); + + return var_ref(pic, var); } -struct pic_proc * -pic_wrap_var(pic_state *pic, struct pic_var *var) -{ - struct pic_proc *proc; - - proc = pic_proc_new(pic, var_call, ""); - pic_proc_cv_init(pic, proc, 1); - pic_proc_cv_set(pic, proc, 0, pic_obj_value(var)); - return proc; -} - -struct pic_var * -pic_unwrap_var(pic_state *pic, struct pic_proc *proc) +void +pic_var_set(pic_state *pic, const char *name, pic_value value) { pic_value v; + struct pic_var *var; - if (! pic_proc_func_p(proc)) { - goto typeerror; - } - if (pic_proc_cv_size(pic, proc) != 1) { - goto typeerror; - } - v = pic_proc_cv_ref(pic, proc, 0); - if (! pic_var_p(v)) { - goto typeerror; - } - return pic_var_ptr(v); + v = pic_ref(pic, name); - typeerror: - pic_errorf(pic, "expected parameter, but got ~s", v); + pic_assert_type(pic, v, var); + + var = pic_var_ptr(v); + + var_set(pic, var, value); } static pic_value -pic_var_make_parameter(pic_state *pic) +pic_var_make_var(pic_state *pic) { - struct pic_proc *conv = NULL; - struct pic_var *var; pic_value init; - pic_get_args(pic, "o|l", &init, &conv); + pic_get_args(pic, "o", &init); - var = pic_var_new(pic, init, conv); - return pic_obj_value(pic_wrap_var(pic, var)); + return pic_obj_value(pic_var_new(pic, init)); } static pic_value -pic_var_parameter_ref(pic_state *pic) +pic_var_var_ref(pic_state *pic) { - struct pic_proc *proc; struct pic_var *var; + pic_value v; - pic_get_args(pic, "l", &proc); + pic_get_args(pic, "o", &v); + + pic_assert_type(pic, v, var); + + var = pic_var_ptr(v); - var = pic_unwrap_var(pic, proc); return var_ref(pic, var); } static pic_value -pic_var_parameter_set(pic_state *pic) +pic_var_var_set(pic_state *pic) { - struct pic_proc *proc; struct pic_var *var; - pic_value v; + pic_value v, val; - pic_get_args(pic, "lo", &proc, &v); + pic_get_args(pic, "oo", &v, &val); + + pic_assert_type(pic, v, var); + + var = pic_var_ptr(v); + var_set(pic, var, val); - var = pic_unwrap_var(pic, proc); - /* no convert */ - var_set_force(pic, var, v); return pic_none_value(); } -static pic_value -pic_var_parameter_converter(pic_state *pic) -{ - struct pic_proc *proc; - struct pic_var *var; - - pic_get_args(pic, "l", &proc); - - var = pic_unwrap_var(pic, proc); - if (var->conv) { - return pic_obj_value(var->conv); - } - else { - return pic_false_value(); - } -} - void pic_init_var(pic_state *pic) { - pic_deflibrary ("(picrin parameter)") { - 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); /* no convert */ - pic_defun(pic, "parameter-converter", pic_var_parameter_converter); + 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); } }