picrin/extlib/benz/proc.c

98 lines
2.0 KiB
C
Raw Normal View History

2014-08-25 00:38:09 -04:00
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
struct pic_proc *
2015-06-27 06:02:18 -04:00
pic_make_proc(pic_state *pic, pic_func_t func)
2014-08-25 00:38:09 -04:00
{
struct pic_proc *proc;
2015-05-27 10:01:35 -04:00
2014-08-25 00:38:09 -04:00
proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
2015-05-31 07:22:46 -04:00
proc->tag = PIC_PROC_TAG_FUNC;
proc->u.f.func = func;
proc->u.f.env = NULL;
2014-08-25 00:38:09 -04:00
return proc;
}
struct pic_proc *
2015-05-30 09:34:51 -04:00
pic_make_proc_irep(pic_state *pic, struct pic_irep *irep, struct pic_context *cxt)
2014-08-25 00:38:09 -04:00
{
struct pic_proc *proc;
proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
2015-05-31 07:22:46 -04:00
proc->tag = PIC_PROC_TAG_IREP;
2015-05-31 07:19:07 -04:00
proc->u.i.irep = irep;
proc->u.i.cxt = cxt;
2014-08-25 00:38:09 -04:00
return proc;
}
struct pic_dict *
pic_proc_env(pic_state *pic, struct pic_proc *proc)
{
assert(pic_proc_func_p(proc));
if (! proc->u.f.env) {
proc->u.f.env = pic_make_dict(pic);
}
return proc->u.f.env;
}
2015-06-08 09:28:17 -04:00
bool
pic_proc_env_has(pic_state *pic, struct pic_proc *proc, const char *key)
{
2015-07-12 19:16:04 -04:00
return pic_dict_has(pic, pic_proc_env(pic, proc), pic_intern(pic, key));
2015-06-08 09:28:17 -04:00
}
pic_value
pic_proc_env_ref(pic_state *pic, struct pic_proc *proc, const char *key)
{
2015-07-12 19:16:04 -04:00
return pic_dict_ref(pic, pic_proc_env(pic, proc), pic_intern(pic, key));
}
void
pic_proc_env_set(pic_state *pic, struct pic_proc *proc, const char *key, pic_value val)
{
2015-07-12 19:16:04 -04:00
pic_dict_set(pic, pic_proc_env(pic, proc), pic_intern(pic, key), val);
}
2014-08-25 00:38:09 -04:00
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)
{
struct pic_proc *proc;
pic_value *args;
size_t argc;
pic_value arg_list;
pic_get_args(pic, "l*", &proc, &argc, &args);
if (argc == 0) {
2014-09-16 10:43:15 -04:00
pic_errorf(pic, "apply: wrong number of arguments");
2014-08-25 00:38:09 -04:00
}
arg_list = args[--argc];
while (argc--) {
arg_list = pic_cons(pic, args[argc], arg_list);
}
2015-07-04 05:01:30 -04:00
return pic_apply_trampoline_list(pic, proc, arg_list);
2014-08-25 00:38:09 -04:00
}
void
pic_init_proc(pic_state *pic)
{
pic_defun(pic, "procedure?", pic_proc_proc_p);
pic_defun(pic, "apply", pic_proc_apply);
}