Merge branch 'cv-to-use-attr'
This commit is contained in:
commit
f23aebb29a
|
@ -51,15 +51,9 @@ struct pic_proc *pic_proc_new_irep(pic_state *, struct pic_irep *, struct pic_en
|
||||||
|
|
||||||
pic_sym pic_proc_name(struct pic_proc *);
|
pic_sym pic_proc_name(struct pic_proc *);
|
||||||
|
|
||||||
struct pic_dict *pic_proc_attr(pic_state *, struct pic_proc *);
|
struct pic_dict *pic_attr(pic_state *, struct pic_proc *);
|
||||||
|
pic_value pic_attr_ref(pic_state *, struct pic_proc *, const char *);
|
||||||
/* closed variables accessor */
|
void pic_attr_set(pic_state *, struct pic_proc *, const char *, pic_value);
|
||||||
void pic_proc_cv_init(pic_state *, struct pic_proc *, size_t);
|
|
||||||
int pic_proc_cv_size(pic_state *, struct pic_proc *);
|
|
||||||
pic_value pic_proc_cv_ref(pic_state *, struct pic_proc *, size_t);
|
|
||||||
void pic_proc_cv_set(pic_state *, struct pic_proc *, size_t, pic_value);
|
|
||||||
|
|
||||||
struct pic_proc *pic_papply(pic_state *, struct pic_proc *, pic_value);
|
|
||||||
|
|
||||||
#if defined(__cplusplus)
|
#if defined(__cplusplus)
|
||||||
}
|
}
|
||||||
|
|
|
@ -221,7 +221,7 @@ cont_call(pic_state *pic)
|
||||||
proc = pic_get_proc(pic);
|
proc = pic_get_proc(pic);
|
||||||
pic_get_args(pic, "*", &argc, &argv);
|
pic_get_args(pic, "*", &argc, &argv);
|
||||||
|
|
||||||
cont = (struct pic_cont *)pic_ptr(pic_proc_cv_ref(pic, proc, 0));
|
cont = (struct pic_cont *)pic_ptr(pic_attr_ref(pic, proc, "@@cont"));
|
||||||
cont->results = pic_list_by_array(pic, argc, argv);
|
cont->results = pic_list_by_array(pic, argc, argv);
|
||||||
|
|
||||||
/* execute guard handlers */
|
/* execute guard handlers */
|
||||||
|
@ -245,8 +245,7 @@ pic_callcc(pic_state *pic, struct pic_proc *proc)
|
||||||
c = pic_proc_new(pic, cont_call, "<continuation-procedure>");
|
c = pic_proc_new(pic, cont_call, "<continuation-procedure>");
|
||||||
|
|
||||||
/* save the continuation object in proc */
|
/* save the continuation object in proc */
|
||||||
pic_proc_cv_init(pic, c, 1);
|
pic_attr_set(pic, c, "@@cont", pic_obj_value(cont));
|
||||||
pic_proc_cv_set(pic, c, 0, pic_obj_value(cont));
|
|
||||||
|
|
||||||
return pic_apply1(pic, proc, pic_obj_value(c));
|
return pic_apply1(pic, proc, pic_obj_value(c));
|
||||||
}
|
}
|
||||||
|
@ -267,8 +266,7 @@ pic_callcc_trampoline(pic_state *pic, struct pic_proc *proc)
|
||||||
c = pic_proc_new(pic, cont_call, "<continuation-procedure>");
|
c = pic_proc_new(pic, cont_call, "<continuation-procedure>");
|
||||||
|
|
||||||
/* save the continuation object in proc */
|
/* save the continuation object in proc */
|
||||||
pic_proc_cv_init(pic, c, 1);
|
pic_attr_set(pic, c, "@@cont", pic_obj_value(cont));
|
||||||
pic_proc_cv_set(pic, c, 0, pic_obj_value(cont));
|
|
||||||
|
|
||||||
return pic_apply_trampoline(pic, proc, pic_list1(pic, pic_obj_value(c)));
|
return pic_apply_trampoline(pic, proc, pic_list1(pic, pic_obj_value(c)));
|
||||||
}
|
}
|
||||||
|
|
71
src/proc.c
71
src/proc.c
|
@ -50,7 +50,7 @@ pic_proc_name(struct pic_proc *proc)
|
||||||
}
|
}
|
||||||
|
|
||||||
struct pic_dict *
|
struct pic_dict *
|
||||||
pic_proc_attr(pic_state *pic, struct pic_proc *proc)
|
pic_attr(pic_state *pic, struct pic_proc *proc)
|
||||||
{
|
{
|
||||||
if (proc->attr == NULL) {
|
if (proc->attr == NULL) {
|
||||||
proc->attr = pic_dict_new(pic);
|
proc->attr = pic_dict_new(pic);
|
||||||
|
@ -58,75 +58,16 @@ pic_proc_attr(pic_state *pic, struct pic_proc *proc)
|
||||||
return proc->attr;
|
return proc->attr;
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
|
||||||
pic_proc_cv_init(pic_state *pic, struct pic_proc *proc, size_t cv_size)
|
|
||||||
{
|
|
||||||
struct pic_env *env;
|
|
||||||
|
|
||||||
if (proc->env != NULL) {
|
|
||||||
pic_error(pic, "env slot already in use");
|
|
||||||
}
|
|
||||||
env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV);
|
|
||||||
env->regc = cv_size;
|
|
||||||
env->regs = (pic_value *)pic_calloc(pic, cv_size, sizeof(pic_value));
|
|
||||||
env->up = NULL;
|
|
||||||
|
|
||||||
proc->env = env;
|
|
||||||
}
|
|
||||||
|
|
||||||
int
|
|
||||||
pic_proc_cv_size(pic_state *pic, struct pic_proc *proc)
|
|
||||||
{
|
|
||||||
UNUSED(pic);
|
|
||||||
return proc->env ? proc->env->regc : 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
pic_value
|
pic_value
|
||||||
pic_proc_cv_ref(pic_state *pic, struct pic_proc *proc, size_t i)
|
pic_attr_ref(pic_state *pic, struct pic_proc *proc, const char *key)
|
||||||
{
|
{
|
||||||
if (proc->env == NULL) {
|
return pic_dict_ref(pic, pic_attr(pic, proc), pic_intern_cstr(pic, key));
|
||||||
pic_error(pic, "no closed env");
|
|
||||||
}
|
|
||||||
return proc->env->regs[i];
|
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
pic_proc_cv_set(pic_state *pic, struct pic_proc *proc, size_t i, pic_value v)
|
pic_attr_set(pic_state *pic, struct pic_proc *proc, const char *key, pic_value v)
|
||||||
{
|
{
|
||||||
if (proc->env == NULL) {
|
pic_dict_set(pic, pic_attr(pic, proc), pic_intern_cstr(pic, key), v);
|
||||||
pic_error(pic, "no closed env");
|
|
||||||
}
|
|
||||||
proc->env->regs[i] = v;
|
|
||||||
}
|
|
||||||
|
|
||||||
static pic_value
|
|
||||||
papply_call(pic_state *pic)
|
|
||||||
{
|
|
||||||
size_t argc;
|
|
||||||
pic_value *argv, arg, arg_list;
|
|
||||||
struct pic_proc *proc;
|
|
||||||
|
|
||||||
pic_get_args(pic, "*", &argc, &argv);
|
|
||||||
|
|
||||||
proc = pic_proc_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 0));
|
|
||||||
arg = pic_proc_cv_ref(pic, pic_get_proc(pic), 1);
|
|
||||||
|
|
||||||
arg_list = pic_list_by_array(pic, argc, argv);
|
|
||||||
arg_list = pic_cons(pic, arg, arg_list);
|
|
||||||
return pic_apply(pic, proc, arg_list);
|
|
||||||
}
|
|
||||||
|
|
||||||
struct pic_proc *
|
|
||||||
pic_papply(pic_state *pic, struct pic_proc *proc, pic_value arg)
|
|
||||||
{
|
|
||||||
struct pic_proc *pa_proc;
|
|
||||||
|
|
||||||
pa_proc = pic_proc_new(pic, papply_call, "<partial-applied-procedure>");
|
|
||||||
pic_proc_cv_init(pic, pa_proc, 2);
|
|
||||||
pic_proc_cv_set(pic, pa_proc, 0, pic_obj_value(proc));
|
|
||||||
pic_proc_cv_set(pic, pa_proc, 1, arg);
|
|
||||||
|
|
||||||
return pa_proc;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
|
@ -225,7 +166,7 @@ pic_proc_attribute(pic_state *pic)
|
||||||
|
|
||||||
pic_get_args(pic, "l", &proc);
|
pic_get_args(pic, "l", &proc);
|
||||||
|
|
||||||
return pic_obj_value(pic_proc_attr(pic, proc));
|
return pic_obj_value(pic_attr(pic, proc));
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
|
|
Loading…
Reference in New Issue