add pic_func struct to hold native function name

This commit is contained in:
Yuichi Nishiwaki 2014-02-26 00:39:16 +09:00
parent bb93a8be14
commit 06a7b0f5f6
5 changed files with 28 additions and 14 deletions

View File

@ -9,6 +9,12 @@
extern "C" { extern "C" {
#endif #endif
/* native C function */
struct pic_func {
pic_func_t f;
pic_sym name;
};
struct pic_env { struct pic_env {
PIC_OBJECT_HEADER PIC_OBJECT_HEADER
pic_value *values; pic_value *values;
@ -18,22 +24,26 @@ struct pic_env {
struct pic_proc { struct pic_proc {
PIC_OBJECT_HEADER PIC_OBJECT_HEADER
bool cfunc_p; char kind;
union { union {
pic_func_t cfunc; struct pic_func func;
struct pic_irep *irep; struct pic_irep *irep;
} u; } u;
struct pic_env *env; struct pic_env *env;
}; };
#define PIC_PROC_KIND_FUNC 1
#define PIC_PROC_KIND_IREP 2
#define pic_proc_func_p(proc) ((proc)->kind == PIC_PROC_KIND_FUNC)
#define pic_proc_irep_p(proc) ((proc)->kind == PIC_PROC_KIND_IREP)
#define pic_proc_p(o) (pic_type(o) == PIC_TT_PROC) #define pic_proc_p(o) (pic_type(o) == PIC_TT_PROC)
#define pic_env_p(o) (pic_type(o) == PIC_TT_ENV) #define pic_env_p(o) (pic_type(o) == PIC_TT_ENV)
#define pic_proc_ptr(o) ((struct pic_proc *)pic_ptr(o)) #define pic_proc_ptr(o) ((struct pic_proc *)pic_ptr(o))
#define pic_env_ptr(o) ((struct pic_env *)pic_ptr(o)) #define pic_env_ptr(o) ((struct pic_env *)pic_ptr(o))
#define pic_proc_cfunc_p(o) (pic_proc_ptr(o)->cfunc_p)
struct pic_proc *pic_proc_new(pic_state *, pic_func_t); struct pic_proc *pic_proc_new(pic_state *, pic_func_t);
struct pic_proc *pic_proc_new_irep(pic_state *, struct pic_irep *, struct pic_env *); struct pic_proc *pic_proc_new_irep(pic_state *, struct pic_irep *, struct pic_env *);

View File

@ -356,7 +356,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
if (proc->env) { if (proc->env) {
gc_mark_object(pic, (struct pic_object *)proc->env); gc_mark_object(pic, (struct pic_object *)proc->env);
} }
if (! proc->cfunc_p) { if (pic_proc_irep_p(proc)) {
gc_mark_object(pic, (struct pic_object *)proc->u.irep); gc_mark_object(pic, (struct pic_object *)proc->u.irep);
} }
break; break;

View File

@ -8,13 +8,14 @@
#include "picrin/irep.h" #include "picrin/irep.h"
struct pic_proc * struct pic_proc *
pic_proc_new(pic_state *pic, pic_func_t cfunc) pic_proc_new(pic_state *pic, pic_func_t func)
{ {
struct pic_proc *proc; struct pic_proc *proc;
proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC); proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
proc->cfunc_p = true; proc->kind = PIC_PROC_KIND_FUNC;
proc->u.cfunc = cfunc; proc->u.func.f = func;
proc->u.func.name = pic_intern_cstr(pic, "(no name)");
proc->env = NULL; proc->env = NULL;
return proc; return proc;
} }
@ -25,7 +26,7 @@ pic_proc_new_irep(pic_state *pic, struct pic_irep *irep, struct pic_env *env)
struct pic_proc *proc; struct pic_proc *proc;
proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC); proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
proc->cfunc_p = false; proc->kind = PIC_PROC_KIND_IREP;
proc->u.irep = irep; proc->u.irep = irep;
proc->env = env; proc->env = env;
return proc; return proc;

View File

@ -50,7 +50,10 @@ get_var_from_proc(pic_state *pic, struct pic_proc *proc)
{ {
pic_value v; pic_value v;
if (! proc->cfunc_p) { if (! pic_proc_p(v)) {
goto typeerror;
}
if (! pic_proc_func_p(pic_proc_ptr(v))) {
goto typeerror; goto typeerror;
} }
if (pic_proc_cv_size(pic, proc) != 1) { if (pic_proc_cv_size(pic, proc) != 1) {

View File

@ -480,7 +480,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
pic_error(pic, "logic flaw"); pic_error(pic, "logic flaw");
} }
irep = pic_proc_ptr(self)->u.irep; irep = pic_proc_ptr(self)->u.irep;
if (pic_proc_cfunc_p(self)) { if (! pic_proc_irep_p(pic_proc_ptr(self))) {
pic_error(pic, "logic flaw"); pic_error(pic, "logic flaw");
} }
PUSH(irep->pool[c.u.i]); PUSH(irep->pool[c.u.i]);
@ -590,10 +590,10 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
ci->ip = pic->ip; ci->ip = pic->ip;
ci->fp = pic->sp - c.u.i; ci->fp = pic->sp - c.u.i;
ci->env = NULL; ci->env = NULL;
if (pic_proc_cfunc_p(x)) { if (pic_proc_func_p(pic_proc_ptr(x))) {
/* invoke! */ /* invoke! */
pic->sp[0] = proc->u.cfunc(pic); pic->sp[0] = proc->u.func.f(pic);
pic->sp += ci->retc; pic->sp += ci->retc;
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
@ -702,7 +702,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
pic_error(pic, "logic flaw"); pic_error(pic, "logic flaw");
} }
irep = pic_proc_ptr(self)->u.irep; irep = pic_proc_ptr(self)->u.irep;
if (pic_proc_cfunc_p(self)) { if (! pic_proc_irep_p(pic_proc_ptr(self))) {
pic_error(pic, "logic flaw"); pic_error(pic, "logic flaw");
} }
proc = pic_proc_new_irep(pic, irep->irep[c.u.i], pic->ci->env); proc = pic_proc_new_irep(pic, irep->irep[c.u.i], pic->ci->env);