conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

add PIC_TYPE_FUNC and PIC_TYPE_IREP

This commit is contained in:
Yuichi Nishiwaki 2016-02-21 20:42:41 +09:00
parent 608569e876
commit 2a17a2a9c2
6 changed files with 34 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extlib/benz/debug.c
View File

@ -22,7 +22,7 @@ pic_get_backtrace(pic_state *pic)
trace = pic_str_cat(pic, trace, pic_lit_value(pic, " at "));
trace = pic_str_cat(pic, trace, pic_lit_value(pic, "(anonymous lambda)"));
if (pic_proc_func_p(pic_proc_ptr(pic, proc))) {
if (pic_func_p(proc)) {
trace = pic_str_cat(pic, trace, pic_lit_value(pic, " (native function)\n"));
} else {
trace = pic_str_cat(pic, trace, pic_lit_value(pic, " (unknown location)\n")); /* TODO */

27
extlib/benz/gc.c
View File

@ -301,16 +301,16 @@ gc_mark_object(pic_state *pic, struct object *obj)
}
break;
}
case PIC_TYPE_PROC: {
if (pic_proc_irep_p(&obj->u.proc)) {
if (obj->u.proc.u.i.cxt) {
LOOP(obj->u.proc.u.i.cxt);
}
} else {
int i;
for (i = 0; i < obj->u.proc.u.f.localc; ++i) {
gc_mark(pic, obj->u.proc.locals[i]);
}
case PIC_TYPE_FUNC: {
int i;
for (i = 0; i < obj->u.proc.u.f.localc; ++i) {
gc_mark(pic, obj->u.proc.locals[i]);
}
break;
}
case PIC_TYPE_IREP: {
if (obj->u.proc.u.i.cxt) {
LOOP(obj->u.proc.u.i.cxt);
}
break;
}
@ -550,10 +550,8 @@ gc_finalize_object(pic_state *pic, struct object *obj)
kh_destroy(weak, &obj->u.weak.hash);
break;
}
case PIC_TYPE_PROC: {
if (pic_proc_irep_p(&obj->u.proc)) {
pic_irep_decref(pic, obj->u.proc.u.i.irep);
}
case PIC_TYPE_IREP: {
pic_irep_decref(pic, obj->u.proc.u.i.irep);
break;
}
@ -564,6 +562,7 @@ gc_finalize_object(pic_state *pic, struct object *obj)
case PIC_TYPE_ID:
case PIC_TYPE_RECORD:
case PIC_TYPE_CP:
case PIC_TYPE_FUNC:
break;
default:

8
extlib/benz/include/picrin.h
View File

@ -162,7 +162,6 @@ enum {
PIC_TYPE_STRING = 16,
PIC_TYPE_VECTOR = 17,
PIC_TYPE_BLOB = 18,
PIC_TYPE_PROC = 19,
PIC_TYPE_PORT = 20,
PIC_TYPE_ERROR = 21,
PIC_TYPE_ID = 22,
@ -174,7 +173,9 @@ enum {
PIC_TYPE_SYMBOL = 28,
PIC_TYPE_PAIR = 29,
PIC_TYPE_CXT = 30,
PIC_TYPE_CP = 31
PIC_TYPE_CP = 31,
PIC_TYPE_FUNC = 32,
PIC_TYPE_IREP = 33,
};
#define pic_invalid_p(pic,v) (pic_type(pic,v) == PIC_TYPE_INVALID)
@ -185,9 +186,10 @@ enum {
#define pic_eof_p(pic, v) (pic_type(pic, v) == PIC_TYPE_EOF)
#define pic_true_p(pic,v) (pic_type(pic,v) == PIC_TYPE_TRUE)
#define pic_false_p(pic,v) (pic_type(pic,v) == PIC_TYPE_FALSE)
#define pic_id_p(pic, v) (pic_type(pic, v) == PIC_TYPE_ID || pic_type(pic, v) == PIC_TYPE_SYMBOL)
#define pic_str_p(pic,v) (pic_type(pic,v) == PIC_TYPE_STRING)
#define pic_blob_p(pic,v) (pic_type(pic,v) == PIC_TYPE_BLOB)
#define pic_proc_p(pic,v) (pic_type(pic,v) == PIC_TYPE_PROC)
#define pic_proc_p(pic,v) (pic_type(pic,v) == PIC_TYPE_FUNC || pic_type(pic, v) == PIC_TYPE_IREP)
#define pic_nil_p(pic,v) (pic_type(pic,v) == PIC_TYPE_NIL)
#define pic_pair_p(pic,v) (pic_type(pic,v) == PIC_TYPE_PAIR)
#define pic_vec_p(pic,v) (pic_type(pic,v) == PIC_TYPE_VECTOR)

9
extlib/benz/include/picrin/private/object.h
View File

@ -93,10 +93,6 @@ struct context {
struct proc {
PIC_OBJECT_HEADER
enum {
PIC_PROC_TAG_IREP,
PIC_PROC_TAG_FUNC
} tag;
union {
struct {
pic_func_t func;
@ -158,7 +154,6 @@ struct object *pic_obj_ptr(pic_value);
#define pic_env_p(pic, v) (pic_type(pic, v) == PIC_TYPE_ENV)
#define pic_error_p(pic, v) (pic_type(pic, v) == PIC_TYPE_ERROR)
#define pic_rec_p(pic, v) (pic_type(pic, v) == PIC_TYPE_RECORD)
#define pic_id_p(pic, v) (pic_type(pic, v) == PIC_TYPE_ID || pic_type(pic, v) == PIC_TYPE_SYMBOL)
pic_value pic_obj_value(void *ptr);
struct object *pic_obj_alloc(pic_state *, size_t, int type);
@ -191,8 +186,8 @@ pic_value pic_id_name(pic_state *, pic_value id);
void pic_rope_incref(pic_state *, struct rope *);
void pic_rope_decref(pic_state *, struct rope *);
#define pic_proc_func_p(proc) ((proc)->tag == PIC_PROC_TAG_FUNC)
#define pic_proc_irep_p(proc) ((proc)->tag == PIC_PROC_TAG_IREP)
#define pic_func_p(proc) (pic_type(pic, proc) == PIC_TYPE_FUNC)
#define pic_irep_p(proc) (pic_type(pic, proc) == PIC_TYPE_IREP)
void pic_wind(pic_state *, struct checkpoint *, struct checkpoint *);

24
extlib/benz/proc.c
View File

@ -503,7 +503,7 @@ pic_apply(pic_state *pic, pic_value proc, int argc, pic_value *argv)
ci->fp = pic->sp - c.a;
ci->irep = NULL;
ci->cxt = NULL;
if (pic_proc_func_p(proc)) {
if (proc->tt == PIC_TYPE_FUNC) {
/* invoke! */
v = proc->u.f.func(pic);
@ -904,27 +904,27 @@ pic_set(pic_state *pic, const char *lib, const char *name, pic_value val)
pic_value
pic_closure_ref(pic_state *pic, int n)
{
struct proc *self = pic_proc_ptr(pic, GET_OPERAND(pic, 0));
pic_value self = GET_OPERAND(pic, 0);
assert(pic_proc_func_p(self));
assert(pic_func_p(self));
if (n < 0 || self->u.f.localc <= n) {
if (n < 0 || pic_proc_ptr(pic, self)->u.f.localc <= n) {
pic_errorf(pic, "pic_closure_ref: index out of range (%d)", n);
}
return self->locals[n];
return pic_proc_ptr(pic, self)->locals[n];
}
void
pic_closure_set(pic_state *pic, int n, pic_value v)
{
struct proc *self = pic_proc_ptr(pic, GET_OPERAND(pic, 0));
pic_value self = GET_OPERAND(pic, 0);
assert(pic_proc_func_p(self));
assert(pic_func_p(self));
if (n < 0 || self->u.f.localc <= n) {
if (n < 0 || pic_proc_ptr(pic, self)->u.f.localc <= n) {
pic_errorf(pic, "pic_closure_ref: index out of range (%d)", n);
}
self->locals[n] = v;
pic_proc_ptr(pic, self)->locals[n] = v;
}
pic_value
@ -979,8 +979,7 @@ pic_make_proc(pic_state *pic, pic_func_t func, int n, pic_value *env)
struct proc *proc;
int i;
proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals) + sizeof(pic_value) * n, PIC_TYPE_PROC);
proc->tag = PIC_PROC_TAG_FUNC;
proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals) + sizeof(pic_value) * n, PIC_TYPE_FUNC);
proc->u.f.func = func;
proc->u.f.localc = n;
for (i = 0; i < n; ++i) {
@ -994,8 +993,7 @@ pic_make_proc_irep(pic_state *pic, struct irep *irep, struct context *cxt)
{
struct proc *proc;
proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals), PIC_TYPE_PROC);
proc->tag = PIC_PROC_TAG_IREP;
proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals), PIC_TYPE_IREP);
proc->u.i.irep = irep;
proc->u.i.cxt = cxt;
pic_irep_incref(pic, irep);

3
extlib/benz/value.c
View File

@ -240,7 +240,8 @@ pic_typename(pic_state *pic, int type)
return "identifier";
case PIC_TYPE_CXT:
return "context";
case PIC_TYPE_PROC:
case PIC_TYPE_FUNC:
case PIC_TYPE_IREP:
return "procedure";
case PIC_TYPE_ENV:
return "environment";