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, " at "));
trace = pic_str_cat(pic, trace, pic_lit_value(pic, "(anonymous lambda)")); 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")); trace = pic_str_cat(pic, trace, pic_lit_value(pic, " (native function)\n"));
} else { } else {
trace = pic_str_cat(pic, trace, pic_lit_value(pic, " (unknown location)\n")); /* TODO */ 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; break;
} }
case PIC_TYPE_PROC: { case PIC_TYPE_FUNC: {
if (pic_proc_irep_p(&obj->u.proc)) { int i;
if (obj->u.proc.u.i.cxt) { for (i = 0; i < obj->u.proc.u.f.localc; ++i) {
LOOP(obj->u.proc.u.i.cxt); gc_mark(pic, obj->u.proc.locals[i]);
} }
} else { break;
int i; }
for (i = 0; i < obj->u.proc.u.f.localc; ++i) { case PIC_TYPE_IREP: {
gc_mark(pic, obj->u.proc.locals[i]); if (obj->u.proc.u.i.cxt) {
} LOOP(obj->u.proc.u.i.cxt);
} }
break; break;
} }
@ -550,10 +550,8 @@ gc_finalize_object(pic_state *pic, struct object *obj)
kh_destroy(weak, &obj->u.weak.hash); kh_destroy(weak, &obj->u.weak.hash);
break; break;
} }
case PIC_TYPE_PROC: { case PIC_TYPE_IREP: {
if (pic_proc_irep_p(&obj->u.proc)) { pic_irep_decref(pic, obj->u.proc.u.i.irep);
pic_irep_decref(pic, obj->u.proc.u.i.irep);
}
break; break;
} }
@ -564,6 +562,7 @@ gc_finalize_object(pic_state *pic, struct object *obj)
case PIC_TYPE_ID: case PIC_TYPE_ID:
case PIC_TYPE_RECORD: case PIC_TYPE_RECORD:
case PIC_TYPE_CP: case PIC_TYPE_CP:
case PIC_TYPE_FUNC:
break; break;
default: default:

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

@ -162,7 +162,6 @@ enum {
PIC_TYPE_STRING = 16, PIC_TYPE_STRING = 16,
PIC_TYPE_VECTOR = 17, PIC_TYPE_VECTOR = 17,
PIC_TYPE_BLOB = 18, PIC_TYPE_BLOB = 18,
PIC_TYPE_PROC = 19,
PIC_TYPE_PORT = 20, PIC_TYPE_PORT = 20,
PIC_TYPE_ERROR = 21, PIC_TYPE_ERROR = 21,
PIC_TYPE_ID = 22, PIC_TYPE_ID = 22,
@ -174,7 +173,9 @@ enum {
PIC_TYPE_SYMBOL = 28, PIC_TYPE_SYMBOL = 28,
PIC_TYPE_PAIR = 29, PIC_TYPE_PAIR = 29,
PIC_TYPE_CXT = 30, 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) #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_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_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_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_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_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_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_pair_p(pic,v) (pic_type(pic,v) == PIC_TYPE_PAIR)
#define pic_vec_p(pic,v) (pic_type(pic,v) == PIC_TYPE_VECTOR) #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 { struct proc {
PIC_OBJECT_HEADER PIC_OBJECT_HEADER
enum {
PIC_PROC_TAG_IREP,
PIC_PROC_TAG_FUNC
} tag;
union { union {
struct { struct {
pic_func_t func; 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_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_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_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); pic_value pic_obj_value(void *ptr);
struct object *pic_obj_alloc(pic_state *, size_t, int type); 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_incref(pic_state *, struct rope *);
void pic_rope_decref(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_func_p(proc) (pic_type(pic, proc) == PIC_TYPE_FUNC)
#define pic_proc_irep_p(proc) ((proc)->tag == PIC_PROC_TAG_IREP) #define pic_irep_p(proc) (pic_type(pic, proc) == PIC_TYPE_IREP)
void pic_wind(pic_state *, struct checkpoint *, struct checkpoint *); 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->fp = pic->sp - c.a;
ci->irep = NULL; ci->irep = NULL;
ci->cxt = NULL; ci->cxt = NULL;
if (pic_proc_func_p(proc)) { if (proc->tt == PIC_TYPE_FUNC) {
/* invoke! */ /* invoke! */
v = proc->u.f.func(pic); 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_value
pic_closure_ref(pic_state *pic, int n) 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); 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 void
pic_closure_set(pic_state *pic, int n, pic_value v) 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); 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 pic_value
@ -979,8 +979,7 @@ pic_make_proc(pic_state *pic, pic_func_t func, int n, pic_value *env)
struct proc *proc; struct proc *proc;
int i; int i;
proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals) + sizeof(pic_value) * n, PIC_TYPE_PROC); proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals) + sizeof(pic_value) * n, PIC_TYPE_FUNC);
proc->tag = PIC_PROC_TAG_FUNC;
proc->u.f.func = func; proc->u.f.func = func;
proc->u.f.localc = n; proc->u.f.localc = n;
for (i = 0; i < n; ++i) { 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; struct proc *proc;
proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals), PIC_TYPE_PROC); proc = (struct proc *)pic_obj_alloc(pic, offsetof(struct proc, locals), PIC_TYPE_IREP);
proc->tag = PIC_PROC_TAG_IREP;
proc->u.i.irep = irep; proc->u.i.irep = irep;
proc->u.i.cxt = cxt; proc->u.i.cxt = cxt;
pic_irep_incref(pic, irep); 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"; return "identifier";
case PIC_TYPE_CXT: case PIC_TYPE_CXT:
return "context"; return "context";
case PIC_TYPE_PROC: case PIC_TYPE_FUNC:
case PIC_TYPE_IREP:
return "procedure"; return "procedure";
case PIC_TYPE_ENV: case PIC_TYPE_ENV:
return "environment"; return "environment";