59 lines
1.1 KiB
C
59 lines
1.1 KiB
C
#include "picrin.h"
|
|
#include "picrin/proc.h"
|
|
#include "picrin/irep.h"
|
|
|
|
struct pic_proc *
|
|
pic_proc_new(pic_state *pic, struct pic_irep *irep, struct pic_env *env)
|
|
{
|
|
struct pic_proc *proc;
|
|
|
|
proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc *), PIC_TT_PROC);
|
|
proc->cfunc_p = false;
|
|
proc->u.irep = irep;
|
|
proc->env = env;
|
|
return proc;
|
|
}
|
|
|
|
struct pic_proc *
|
|
pic_proc_new_cfunc(pic_state *pic, pic_func_t cfunc)
|
|
{
|
|
struct pic_proc *proc;
|
|
|
|
proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc *), PIC_TT_PROC);
|
|
proc->cfunc_p = true;
|
|
proc->u.cfunc = cfunc;
|
|
proc->env = NULL;
|
|
return proc;
|
|
}
|
|
|
|
static pic_value
|
|
pic_proc_proc_p(pic_state *pic)
|
|
{
|
|
pic_value v;
|
|
|
|
pic_get_args(pic, "o", &v);
|
|
|
|
return pic_bool_value(pic_proc_p(v));
|
|
}
|
|
|
|
static pic_value
|
|
pic_proc_apply(pic_state *pic)
|
|
{
|
|
pic_value proc, args;
|
|
|
|
pic_get_args(pic, "oo", &proc, &args);
|
|
|
|
if (! pic_proc_p(proc)) {
|
|
pic_error(pic, "apply: expected procedure");
|
|
}
|
|
|
|
return pic_apply(pic, pic_proc_ptr(proc), args);
|
|
}
|
|
|
|
void
|
|
pic_init_proc(pic_state *pic)
|
|
{
|
|
pic_defun(pic, "procedure?", pic_proc_proc_p);
|
|
pic_defun(pic, "apply", pic_proc_apply);
|
|
}
|