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

struct pic_proc * -> pic_value

This commit is contained in:
Yuichi Nishiwaki 2016-02-20 00:03:16 +09:00
parent 0d8a45191a
commit 5254e80932
18 changed files with 128 additions and 171 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
contrib/10.callcc/callcc.c
View File

@ -239,7 +239,7 @@ cont_call(pic_state *pic)
}
static pic_value
pic_callcc(pic_state *pic, struct pic_proc *proc)
pic_callcc(pic_state *pic, pic_value proc)
{
struct pic_fullcont *cont;
@ -248,13 +248,12 @@ pic_callcc(pic_state *pic, struct pic_proc *proc)
return pic_valuesk(pic, cont->retc, cont->retv);
}
else {
struct pic_proc *c;
pic_value args[1];
pic_value c, args[1];
/* save the continuation object in proc */
c = pic_lambda(pic, cont_call, 1, pic_data_value(pic, cont, &cont_type));
args[0] = pic_obj_value(c);
args[0] = c;
return pic_applyk(pic, proc, 1, args);
}
}
@ -262,15 +261,15 @@ pic_callcc(pic_state *pic, struct pic_proc *proc)
static pic_value
pic_callcc_callcc(pic_state *pic)
{
struct pic_proc *proc;
pic_value proc;
pic_get_args(pic, "l", &proc);
return pic_callcc(pic, proc);
}
#define pic_redefun(pic, lib, name, func) \
pic_set(pic, lib, name, pic_obj_value(pic_lambda(pic, func, 0)))
#define pic_redefun(pic, lib, name, func) \
pic_set(pic, lib, name, pic_lambda(pic, func, 0))
void
pic_init_callcc(pic_state *pic)

5
contrib/40.srfi/src/106.c
View File

@ -367,8 +367,7 @@ pic_socket_socket_output_port(pic_state *pic)
static pic_value
pic_socket_call_with_socket(pic_state *pic)
{
pic_value obj, result;
struct pic_proc *proc;
pic_value obj, proc, result;
struct pic_socket_t *sock;
pic_get_args(pic, "ol", &obj, &proc);
@ -389,7 +388,7 @@ pic_init_srfi_106(pic_state *pic)
{
pic_deflibrary(pic, "srfi.106");
#define pic_defun_(pic, name, f) pic_define(pic, "srfi.106", name, pic_obj_value(pic_lambda(pic, f, 0)))
#define pic_defun_(pic, name, f) pic_define(pic, "srfi.106", name, pic_lambda(pic, f, 0))
#define pic_define_(pic, name, v) pic_define(pic, "srfi.106", name, v)
pic_defun_(pic, "socket?", pic_socket_socket_p);

40
extlib/benz/cont.c
View File

@ -48,38 +48,34 @@ pic_wind(pic_state *pic, pic_checkpoint *here, pic_checkpoint *there)
if (here->depth < there->depth) {
pic_wind(pic, here, there->prev);
pic_call(pic, there->in, 0);
pic_call(pic, pic_obj_value(there->in), 0);
}
else {
pic_call(pic, there->out, 0);
pic_call(pic, pic_obj_value(there->out), 0);
pic_wind(pic, here->prev, there);
}
}
static pic_value
pic_dynamic_wind(pic_state *pic, struct pic_proc *in, struct pic_proc *thunk, struct pic_proc *out)
pic_dynamic_wind(pic_state *pic, pic_value in, pic_value thunk, pic_value out)
{
pic_checkpoint *here;
pic_value val;
if (in != NULL) {
pic_call(pic, in, 0); /* enter */
}
pic_call(pic, in, 0); /* enter */
here = pic->cp;
pic->cp = (pic_checkpoint *)pic_obj_alloc(pic, sizeof(pic_checkpoint), PIC_TYPE_CP);
pic->cp->prev = here;
pic->cp->depth = here->depth + 1;
pic->cp->in = in;
pic->cp->out = out;
pic->cp->in = pic_proc_ptr(pic, in);
pic->cp->out = pic_proc_ptr(pic, out);
val = pic_call(pic, thunk, 0);
pic->cp = here;
if (out != NULL) {
pic_call(pic, out, 0); /* exit */
}
pic_call(pic, out, 0); /* exit */
return val;
}
@ -120,20 +116,17 @@ cont_call(pic_state *pic)
PIC_UNREACHABLE();
}
struct pic_proc *
pic_value
pic_make_cont(pic_state *pic, struct pic_cont *cont)
{
static const pic_data_type cont_type = { "cont", NULL, NULL };
struct pic_proc *c;
/* save the escape continuation in proc */
c = pic_lambda(pic, cont_call, 2, pic_int_value(pic, cont->id), pic_data_value(pic, cont, &cont_type));
return c;
return pic_lambda(pic, cont_call, 2, pic_int_value(pic, cont->id), pic_data_value(pic, cont, &cont_type));
}
static pic_value
pic_callcc(pic_state *pic, struct pic_proc *proc)
pic_callcc(pic_state *pic, pic_value proc)
{
struct pic_cont cont;
@ -145,7 +138,7 @@ pic_callcc(pic_state *pic, struct pic_proc *proc)
else {
pic_value val;
val = pic_call(pic, proc, 1, pic_obj_value(pic_make_cont(pic, &cont)));
val = pic_call(pic, proc, 1, pic_make_cont(pic, &cont));
pic->cc = pic->cc->prev;
@ -209,17 +202,17 @@ pic_receive(pic_state *pic, int n, pic_value *argv)
static pic_value
pic_cont_callcc(pic_state *pic)
{
struct pic_proc *cb;
pic_value f;
pic_get_args(pic, "l", &cb);
pic_get_args(pic, "l", &f);
return pic_callcc(pic, cb);
return pic_callcc(pic, f);
}
static pic_value
pic_cont_dynamic_wind(pic_state *pic)
{
struct pic_proc *in, *thunk, *out;
pic_value in, thunk, out;
pic_get_args(pic, "lll", &in, &thunk, &out);
@ -240,9 +233,8 @@ pic_cont_values(pic_state *pic)
static pic_value
pic_cont_call_with_values(pic_state *pic)
{
struct pic_proc *producer, *consumer;
pic_value producer, consumer, *retv;
int retc;
pic_value *retv;
pic_get_args(pic, "ll", &producer, &consumer);

6
extlib/benz/debug.c
View File

@ -15,14 +15,14 @@ pic_get_backtrace(pic_state *pic)
trace = pic_lit_value(pic, "");
for (ci = pic->ci; ci != pic->cibase; --ci) {
struct pic_proc *proc = pic_proc_ptr(ci->fp[0]);
pic_value proc = ci->fp[0];
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(proc)) {
if (pic_proc_func_p(pic_proc_ptr(pic, proc))) {
trace = pic_str_cat(pic, trace, pic_lit_value(pic, " (native function)\n"));
} else if (pic_proc_irep_p(proc)) {
} else {
trace = pic_str_cat(pic, trace, pic_lit_value(pic, " (unknown location)\n")); /* TODO */
}
}

6
extlib/benz/dict.c
View File

@ -168,8 +168,7 @@ pic_dict_dictionary_size(pic_state *pic)
static pic_value
pic_dict_dictionary_map(pic_state *pic)
{
struct pic_proc *proc;
pic_value dict, ret = pic_nil_value(pic);
pic_value dict, proc, ret = pic_nil_value(pic);
pic_sym *key;
int it = 0;
@ -184,8 +183,7 @@ pic_dict_dictionary_map(pic_state *pic)
static pic_value
pic_dict_dictionary_for_each(pic_state *pic)
{
struct pic_proc *proc;
pic_value dict;
pic_value dict, proc;
pic_sym *key;
int it;

23
extlib/benz/error.c
View File

@ -51,21 +51,18 @@ pic_value
pic_native_exception_handler(pic_state *pic)
{
pic_value err;
struct pic_proc *self, *cont;
pic_get_args(pic, "&o", &self, &err);
pic_get_args(pic, "o", &err);
pic->err = err;
cont = pic_proc_ptr(pic_closure_ref(pic, 0));
pic_call(pic, cont, 1, pic_false_value(pic));
pic_call(pic, pic_closure_ref(pic, 0), 1, pic_false_value(pic));
PIC_UNREACHABLE();
}
void
pic_push_handler(pic_state *pic, struct pic_proc *handler)
pic_push_handler(pic_state *pic, pic_value handler)
{
size_t xp_len;
ptrdiff_t xp_offset;
@ -78,17 +75,17 @@ pic_push_handler(pic_state *pic, struct pic_proc *handler)
pic->xpend = pic->xpbase + xp_len;
}
*pic->xp++ = handler;
*pic->xp++ = pic_proc_ptr(pic, handler);
}
struct pic_proc *
pic_value
pic_pop_handler(pic_state *pic)
{
if (pic->xp == pic->xpbase) {
pic_panic(pic, "no exception handler registered");
}
return *--pic->xp;
return pic_obj_value(*--pic->xp);
}
struct pic_error *
@ -112,12 +109,11 @@ pic_make_error(pic_state *pic, const char *type, const char *msg, pic_value irrs
pic_value
pic_raise_continuable(pic_state *pic, pic_value err)
{
struct pic_proc *handler;
pic_value v;
pic_value handler, v;
handler = pic_pop_handler(pic);
pic_protect(pic, pic_obj_value(handler));
pic_protect(pic, handler);
v = pic_call(pic, handler, 1, err);
@ -151,8 +147,7 @@ pic_error(pic_state *pic, const char *type, const char *msg, pic_value irrs)
static pic_value
pic_error_with_exception_handler(pic_state *pic)
{
struct pic_proc *handler, *thunk;
pic_value val;
pic_value handler, thunk, val;
pic_get_args(pic, "ll", &handler, &thunk);

4
extlib/benz/eval.c
View File

@ -831,11 +831,11 @@ pic_codegen(pic_state *pic, pic_value obj)
#define SAVE(pic, ai, obj) pic_leave(pic, ai); pic_protect(pic, obj)
struct pic_proc *
pic_value
pic_compile(pic_state *pic, pic_value obj)
{
struct pic_irep *irep;
struct pic_proc *proc;
pic_value proc;
size_t ai = pic_enter(pic);
#if DEBUG

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

@ -54,7 +54,6 @@ typedef struct {
struct pic_object;
struct pic_symbol;
struct pic_string;
struct pic_proc;
struct pic_port;
struct pic_error;
struct pic_env;
@ -85,7 +84,7 @@ void pic_gc(pic_state *);
void pic_add_feature(pic_state *, const char *feature);
void pic_defun(pic_state *, const char *name, pic_func_t f);
void pic_defvar(pic_state *, const char *name, pic_value v, struct pic_proc *conv);
void pic_defvar(pic_state *, const char *name, pic_value v, pic_value conv);
void pic_define(pic_state *, const char *lib, const char *name, pic_value v);
pic_value pic_ref(pic_state *, const char *lib, const char *name);
@ -111,12 +110,12 @@ PIC_NORETURN void pic_errorf(pic_state *, const char *fmt, ...);
PIC_NORETURN void pic_error(pic_state *, const char *type, const char *msg, pic_value irrs);
PIC_NORETURN void pic_raise(pic_state *, pic_value v);
struct pic_proc *pic_lambda(pic_state *, pic_func_t f, int n, ...);
struct pic_proc *pic_vlambda(pic_state *, pic_func_t f, int n, va_list);
pic_value pic_call(pic_state *, struct pic_proc *proc, int, ...);
pic_value pic_vcall(pic_state *, struct pic_proc *proc, int, va_list);
pic_value pic_apply(pic_state *, struct pic_proc *proc, int n, pic_value *argv);
pic_value pic_applyk(pic_state *, struct pic_proc *proc, int n, pic_value *argv);
pic_value pic_lambda(pic_state *, pic_func_t f, int n, ...);
pic_value pic_vlambda(pic_state *, pic_func_t f, int n, va_list);
pic_value pic_call(pic_state *, pic_value proc, int, ...);
pic_value pic_vcall(pic_state *, pic_value proc, int, va_list);
pic_value pic_apply(pic_state *, pic_value proc, int n, pic_value *argv);
pic_value pic_applyk(pic_state *, pic_value proc, int n, pic_value *argv);
PIC_INLINE int pic_int(pic_state *, pic_value i);
PIC_INLINE double pic_float(pic_state *, pic_value f);
@ -301,7 +300,7 @@ pic_value pic_eval(pic_state *, pic_value, const char *);
void pic_load(pic_state *, struct pic_port *);
void pic_load_cstr(pic_state *, const char *);
struct pic_proc *pic_make_var(pic_state *, pic_value, struct pic_proc *);
pic_value pic_make_var(pic_state *, pic_value init, pic_value conv);
bool pic_data_type_p(pic_state *, pic_value, const pic_data_type *);
@ -320,14 +319,14 @@ bool pic_data_type_p(pic_state *, pic_value, const pic_data_type *);
pic_catch_(PIC_GENSYM(label))
#define pic_try_(cont, handler) \
do { \
extern void pic_push_handler(pic_state *, struct pic_proc *); \
extern struct pic_proc *pic_pop_handler(pic_state *); \
extern void pic_push_handler(pic_state *, pic_value proc); \
extern pic_value pic_pop_handler(pic_state *); \
extern pic_value pic_native_exception_handler(pic_state *); \
struct pic_cont cont; \
pic_save_point(pic, &cont); \
if (PIC_SETJMP(pic, cont.jmp) == 0) { \
struct pic_proc *handler; \
handler = pic_lambda(pic, pic_native_exception_handler, 1, pic_obj_value(pic_make_cont(pic, &cont))); \
pic_value handler; \
handler = pic_lambda(pic, pic_native_exception_handler, 1, pic_make_cont(pic, &cont)); \
do { \
pic_push_handler(pic, handler);
#define pic_catch_(label) \

2
extlib/benz/include/picrin/cont.h
View File

@ -31,7 +31,7 @@ struct pic_cont {
void pic_save_point(pic_state *, struct pic_cont *);
void pic_load_point(pic_state *, struct pic_cont *);
struct pic_proc *pic_make_cont(pic_state *, struct pic_cont *);
pic_value pic_make_cont(pic_state *, struct pic_cont *);
void pic_wind(pic_state *, pic_checkpoint *, pic_checkpoint *);

6
extlib/benz/include/picrin/object.h
View File

@ -125,12 +125,12 @@ struct pic_port {
#define pic_vec_ptr(pic, o) ((struct pic_vector *)pic_obj_ptr(o))
#define pic_dict_ptr(pic, o) ((struct pic_dict *)pic_obj_ptr(o))
#define pic_data_ptr(pic, o) ((struct pic_data *)pic_obj_ptr(o))
#define pic_proc_ptr(pic, o) ((struct pic_proc *)pic_obj_ptr(o))
#define pic_sym_ptr(v) ((pic_sym *)pic_obj_ptr(v))
#define pic_id_ptr(v) ((pic_id *)pic_obj_ptr(v))
#define pic_str_ptr(o) ((struct pic_string *)pic_obj_ptr(o))
#define pic_weak_ptr(v) ((struct pic_weak *)pic_obj_ptr(v))
#define pic_context_ptr(o) ((struct pic_context *)pic_obj_ptr(o))
#define pic_proc_ptr(o) ((struct pic_proc *)pic_obj_ptr(o))
#define pic_rec_ptr(v) ((struct pic_record *)pic_obj_ptr(v))
#define pic_error_ptr(v) ((struct pic_error *)pic_obj_ptr(v))
#define pic_port_ptr(v) ((struct pic_port *)pic_obj_ptr(v))
@ -157,8 +157,8 @@ struct pic_object *pic_obj_alloc(pic_state *, size_t, int type);
} while (0)
pic_id *pic_make_identifier(pic_state *, pic_id *, struct pic_env *);
struct pic_proc *pic_make_proc(pic_state *, pic_func_t, int, pic_value *);
struct pic_proc *pic_make_proc_irep(pic_state *, struct pic_irep *, struct pic_context *);
pic_value pic_make_proc(pic_state *, pic_func_t, int, pic_value *);
pic_value pic_make_proc_irep(pic_state *, struct pic_irep *, struct pic_context *);
struct pic_record *pic_make_rec(pic_state *, pic_value, pic_value);
struct pic_error *pic_make_error(pic_state *, const char *, const char *, pic_value);
struct pic_env *pic_make_env(pic_state *, struct pic_env *);

22
extlib/benz/macro.c
View File

@ -107,21 +107,21 @@ pic_find_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
static void
define_macro(pic_state *pic, pic_sym *uid, struct pic_proc *mac)
define_macro(pic_state *pic, pic_sym *uid, pic_value mac)
{
if (pic_weak_has(pic, pic->macros, uid)) {
pic_warnf(pic, "redefining syntax variable: ~s", pic_obj_value(uid));
}
pic_weak_set(pic, pic->macros, uid, pic_obj_value(mac));
pic_weak_set(pic, pic->macros, uid, mac);
}
static struct pic_proc *
static pic_value
find_macro(pic_state *pic, pic_sym *uid)
{
if (! pic_weak_has(pic, pic->macros, uid)) {
return NULL;
return pic_false_value(pic);
}
return pic_proc_ptr(pic_weak_ref(pic, pic->macros, uid));
return pic_weak_ref(pic, pic->macros, uid);
}
static void
@ -138,12 +138,12 @@ static pic_value expand_lambda(pic_state *, pic_value, struct pic_env *);
static pic_value
expand_var(pic_state *pic, pic_id *id, struct pic_env *env, pic_value deferred)
{
struct pic_proc *mac;
pic_value mac;
pic_sym *functor;
functor = pic_find_identifier(pic, id, env);
if ((mac = find_macro(pic, functor)) != NULL) {
if (! pic_false_p(pic, mac = find_macro(pic, functor))) {
return expand(pic, pic_call(pic, mac, 2, pic_obj_value(id), pic_obj_value(env)), env, deferred);
}
return pic_obj_value(functor);
@ -250,7 +250,7 @@ expand_define(pic_state *pic, pic_value expr, struct pic_env *env, pic_value def
static pic_value
expand_defmacro(pic_state *pic, pic_value expr, struct pic_env *env)
{
struct pic_proc *pic_compile(pic_state *, pic_value);
pic_value pic_compile(pic_state *, pic_value);
pic_id *id;
pic_value val;
pic_sym *uid;
@ -265,7 +265,7 @@ expand_defmacro(pic_state *pic, pic_value expr, struct pic_env *env)
pic_errorf(pic, "macro definition \"%s\" evaluates to non-procedure object", pic_str(pic, pic_id_name(pic, id)));
}
define_macro(pic, uid, pic_proc_ptr(val));
define_macro(pic, uid, val);
return pic_undef_value(pic);
}
@ -279,7 +279,7 @@ expand_node(pic_state *pic, pic_value expr, struct pic_env *env, pic_value defer
return expand_var(pic, pic_id_ptr(expr), env, deferred);
}
case PIC_TYPE_PAIR: {
struct pic_proc *mac;
pic_value mac;
if (! pic_list_p(pic, expr)) {
pic_errorf(pic, "cannot expand improper list: ~s", expr);
@ -303,7 +303,7 @@ expand_node(pic_state *pic, pic_value expr, struct pic_env *env, pic_value defer
return expand_quote(pic, expr);
}
if ((mac = find_macro(pic, functor)) != NULL) {
if (! pic_false_p(pic, mac = find_macro(pic, functor))) {
return expand(pic, pic_call(pic, mac, 2, expr, pic_obj_value(env)), env, deferred);
}
}

16
extlib/benz/pair.c
View File

@ -470,9 +470,8 @@ pic_pair_list_copy(pic_state *pic)
static pic_value
pic_pair_map(pic_state *pic)
{
struct pic_proc *proc;
int argc, i;
pic_value *args, *arg_list, ret;
pic_value proc, *args, *arg_list, ret;
pic_get_args(pic, "l*", &proc, &argc, &args);
@ -503,9 +502,8 @@ pic_pair_map(pic_state *pic)
static pic_value
pic_pair_for_each(pic_state *pic)
{
struct pic_proc *proc;
int argc, i;
pic_value *args, *arg_list;
pic_value proc, *args, *arg_list;
pic_get_args(pic, "l*", &proc, &argc, &args);
@ -563,13 +561,12 @@ pic_pair_memv(pic_state *pic)
static pic_value
pic_pair_member(pic_state *pic)
{
struct pic_proc *proc = NULL;
pic_value key, list;
pic_value key, list, proc = pic_false_value(pic);
pic_get_args(pic, "oo|l", &key, &list, &proc);
while (! pic_nil_p(pic, list)) {
if (proc == NULL) {
if (pic_false_p(pic, proc)) {
if (pic_equal_p(pic, key, pic_car(pic, list)))
return list;
} else {
@ -618,14 +615,13 @@ pic_pair_assv(pic_state *pic)
static pic_value
pic_pair_assoc(pic_state *pic)
{
struct pic_proc *proc = NULL;
pic_value key, alist, cell;
pic_value key, alist, proc = pic_false_value(pic), cell;
pic_get_args(pic, "oo|l", &key, &alist, &proc);
while (! pic_nil_p(pic, alist)) {
cell = pic_car(pic, alist);
if (proc == NULL) {
if (pic_false_p(pic, proc)) {
if (pic_equal_p(pic, key, pic_car(pic, cell)))
return cell;
} else {

2
extlib/benz/port.c
View File

@ -334,7 +334,7 @@ coerce_port(pic_state *pic)
void
pic_init_port(pic_state *pic)
{
struct pic_proc *coerce = pic_lambda(pic, coerce_port, 0);
pic_value coerce = pic_lambda(pic, coerce_port, 0);
DEFINE_PORT(pic, "current-input-port", xstdin);
DEFINE_PORT(pic, "current-output-port", xstdout);

65
extlib/benz/proc.c
View File

@ -24,7 +24,7 @@
* v pic_value * vector object
* s struct pic_str ** string object
* b pic_value * bytevector object
* l struct pic_proc ** lambda object
* l pic_value * lambda object
* p struct pic_port ** port object
* d pic_value * dictionary object
* e struct pic_error ** error object
@ -76,10 +76,10 @@ pic_get_args(pic_state *pic, const char *format, ...)
/* dispatch */
if (proc) {
struct pic_proc **proc;
pic_value *proc;
proc = va_arg(ap, struct pic_proc **);
*proc = pic_proc_ptr(GET_OPERAND(pic, 0));
proc = va_arg(ap, pic_value *);
*proc = GET_OPERAND(pic, 0);
}
for (i = 1; i <= MIN(paramc + optc, argc); ++i) {
@ -149,13 +149,13 @@ pic_get_args(pic_state *pic, const char *format, ...)
PTR_CASE('m', sym, pic_sym *)
PTR_CASE('s', str, struct pic_string *)
PTR_CASE('l', proc, struct pic_proc *)
PTR_CASE('p', port, struct pic_port *)
PTR_CASE('e', error, struct pic_error *)
PTR_CASE('r', rec, struct pic_record *)
#define OBJ_CASE(c, type) VAL_CASE(c, type, pic_value, v)
OBJ_CASE('l', proc)
OBJ_CASE('b', blob)
OBJ_CASE('v', vec)
OBJ_CASE('d', dict)
@ -337,7 +337,7 @@ bool pic_gt(pic_state *, pic_value, pic_value);
bool pic_ge(pic_state *, pic_value, pic_value);
pic_value
pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv)
pic_apply(pic_state *pic, pic_value proc, int argc, pic_value *argv)
{
pic_code c;
size_t ai = pic_enter(pic);
@ -363,7 +363,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv)
pic_callinfo *cibase;
#endif
PUSH(pic_obj_value(proc));
PUSH(proc);
for (i = 0; i < argc; ++i) {
PUSH(argv[i]);
@ -498,6 +498,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv)
CASE(OP_CALL) {
pic_value x, v;
pic_callinfo *ci;
struct pic_proc *proc;
if (c.a == -1) {
pic->sp += pic->ci[1].retc - 1;
@ -509,7 +510,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv)
if (! pic_proc_p(pic, x)) {
pic_errorf(pic, "invalid application: ~s", x);
}
proc = pic_proc_ptr(x);
proc = pic_proc_ptr(pic, x);
VM_CALL_PRINT;
@ -632,8 +633,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv)
vm_push_cxt(pic);
}
proc = pic_make_proc_irep(pic, pic->ci->irep->irep[c.a], pic->ci->cxt);
PUSH(pic_obj_value(proc));
PUSH(pic_make_proc_irep(pic, pic->ci->irep->irep[c.a], pic->ci->cxt));
pic_leave(pic, ai);
NEXT;
}
@ -794,7 +794,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv)
}
pic_value
pic_applyk(pic_state *pic, struct pic_proc *proc, int argc, pic_value *args)
pic_applyk(pic_state *pic, pic_value proc, int argc, pic_value *args)
{
pic_value *sp;
pic_callinfo *ci;
@ -803,7 +803,7 @@ pic_applyk(pic_state *pic, struct pic_proc *proc, int argc, pic_value *args)
PIC_INIT_CODE_I(pic->iseq[0], OP_NOP, 0);
PIC_INIT_CODE_I(pic->iseq[1], OP_TAILCALL, -1);
*pic->sp++ = pic_obj_value(proc);
*pic->sp++ = proc;
sp = pic->sp;
for (i = 0; i < argc; ++i) {
@ -823,7 +823,7 @@ pic_applyk(pic_state *pic, struct pic_proc *proc, int argc, pic_value *args)
}
pic_value
pic_call(pic_state *pic, struct pic_proc *proc, int n, ...)
pic_call(pic_state *pic, pic_value proc, int n, ...)
{
pic_value r;
va_list ap;
@ -835,7 +835,7 @@ pic_call(pic_state *pic, struct pic_proc *proc, int n, ...)
}
pic_value
pic_vcall(pic_state *pic, struct pic_proc *proc, int n, va_list ap)
pic_vcall(pic_state *pic, pic_value proc, int n, va_list ap)
{
pic_value *args = pic_alloca(pic, sizeof(pic_value) * n);
int i;
@ -846,10 +846,10 @@ pic_vcall(pic_state *pic, struct pic_proc *proc, int n, va_list ap)
return pic_apply(pic, proc, n, args);
}
struct pic_proc *
pic_value
pic_lambda(pic_state *pic, pic_func_t f, int n, ...)
{
struct pic_proc *proc;
pic_value proc;
va_list ap;
va_start(ap, n);
@ -858,7 +858,7 @@ pic_lambda(pic_state *pic, pic_func_t f, int n, ...)
return proc;
}
struct pic_proc *
pic_value
pic_vlambda(pic_state *pic, pic_func_t f, int n, va_list ap)
{
pic_value *env = pic_alloca(pic, sizeof(pic_value) * n);
@ -873,14 +873,14 @@ pic_vlambda(pic_state *pic, pic_func_t f, int n, va_list ap)
void
pic_defun(pic_state *pic, const char *name, pic_func_t f)
{
pic_define(pic, pic_current_library(pic), name, pic_obj_value(pic_make_proc(pic, f, 0, NULL)));
pic_define(pic, pic_current_library(pic), name, pic_make_proc(pic, f, 0, NULL));
pic_export(pic, pic_intern_cstr(pic, name));
}
void
pic_defvar(pic_state *pic, const char *name, pic_value init, struct pic_proc *conv)
pic_defvar(pic_state *pic, const char *name, pic_value init, pic_value conv)
{
pic_define(pic, pic_current_library(pic), name, pic_obj_value(pic_make_var(pic, init, conv)));
pic_define(pic, pic_current_library(pic), name, pic_make_var(pic, init, conv));
pic_export(pic, pic_intern_cstr(pic, name));
}
@ -939,31 +939,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 pic_proc *self;
self = pic_proc_ptr(GET_OPERAND(pic, 0));
struct pic_proc *self = pic_proc_ptr(pic, GET_OPERAND(pic, 0));
assert(pic_proc_func_p(self));
if (n < 0 || self->u.f.localc <= n) {
pic_errorf(pic, "pic_closure_ref: index out of range (%d)", n);
}
return pic_proc_ptr(GET_OPERAND(pic, 0))->locals[n];
return self->locals[n];
}
void
pic_closure_set(pic_state *pic, int n, pic_value v)
{
struct pic_proc *self;
self = pic_proc_ptr(GET_OPERAND(pic, 0));
struct pic_proc *self = pic_proc_ptr(pic, GET_OPERAND(pic, 0));
assert(pic_proc_func_p(self));
if (n < 0 || self->u.f.localc <= n) {
pic_errorf(pic, "pic_closure_ref: index out of range (%d)", n);
}
pic_proc_ptr(GET_OPERAND(pic, 0))->locals[n] = v;
self->locals[n] = v;
}
pic_value
@ -977,7 +973,7 @@ pic_funcall(pic_state *pic, const char *lib, const char *name, int n, ...)
pic_assert_type(pic, proc, proc);
va_start(ap, n);
r = pic_vcall(pic, pic_proc_ptr(proc), n, ap);
r = pic_vcall(pic, proc, n, ap);
va_end(ap);
return r;
@ -1012,7 +1008,7 @@ pic_irep_decref(pic_state *pic, struct pic_irep *irep)
}
}
struct pic_proc *
pic_value
pic_make_proc(pic_state *pic, pic_func_t func, int n, pic_value *env)
{
struct pic_proc *proc;
@ -1025,10 +1021,10 @@ pic_make_proc(pic_state *pic, pic_func_t func, int n, pic_value *env)
for (i = 0; i < n; ++i) {
proc->locals[i] = env[i];
}
return proc;
return pic_obj_value(proc);
}
struct pic_proc *
pic_value
pic_make_proc_irep(pic_state *pic, struct pic_irep *irep, struct pic_context *cxt)
{
struct pic_proc *proc;
@ -1038,7 +1034,7 @@ pic_make_proc_irep(pic_state *pic, struct pic_irep *irep, struct pic_context *cx
proc->u.i.irep = irep;
proc->u.i.cxt = cxt;
pic_irep_incref(pic, irep);
return proc;
return pic_obj_value(proc);
}
static pic_value
@ -1054,8 +1050,7 @@ pic_proc_proc_p(pic_state *pic)
static pic_value
pic_proc_apply(pic_state *pic)
{
struct pic_proc *proc;
pic_value *args, *arg_list;
pic_value proc, *args, *arg_list;
int argc, n, i;
pic_get_args(pic, "l*", &proc, &argc, &args);

10
extlib/benz/string.c
View File

@ -552,8 +552,7 @@ pic_str_string_append(pic_state *pic)
static pic_value
pic_str_string_map(pic_state *pic)
{
struct pic_proc *proc;
pic_value *argv, vals, val;
pic_value proc, *argv, vals, val;
int argc, i, len, j;
struct pic_string *str;
char *buf;
@ -581,7 +580,7 @@ pic_str_string_map(pic_state *pic)
for (j = 0; j < argc; ++j) {
pic_push(pic, pic_char_value(pic, pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals);
}
val = pic_funcall(pic, "picrin.base", "apply", 2, pic_obj_value(proc), vals);
val = pic_funcall(pic, "picrin.base", "apply", 2, proc, vals);
pic_assert_type(pic, val, char);
buf[i] = pic_char(pic, val);
@ -601,9 +600,8 @@ pic_str_string_map(pic_state *pic)
static pic_value
pic_str_string_for_each(pic_state *pic)
{
struct pic_proc *proc;
int argc, len, i, j;
pic_value *argv, vals;
pic_value proc, *argv, vals;
pic_get_args(pic, "l*", &proc, &argc, &argv);
@ -626,7 +624,7 @@ pic_str_string_for_each(pic_state *pic)
for (j = 0; j < argc; ++j) {
pic_push(pic, pic_char_value(pic, pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals);
}
pic_funcall(pic, "picrin.base", "apply", 2, pic_obj_value(proc), vals);
pic_funcall(pic, "picrin.base", "apply", 2, proc, vals);
}
return pic_undef_value(pic);

35
extlib/benz/var.c
View File

@ -6,28 +6,28 @@
#include "picrin/object.h"
static pic_value
var_get(pic_state *pic, struct pic_proc *var)
var_get(pic_state *pic, pic_value var)
{
pic_value elem, it;
struct pic_weak *weak;
pic_for_each (elem, pic->ptable, it) {
weak = pic_weak_ptr(elem);
if (pic_weak_has(pic, weak, var)) {
return pic_weak_ref(pic, weak, var);
if (pic_weak_has(pic, weak, pic_obj_ptr(var))) {
return pic_weak_ref(pic, weak, pic_obj_ptr(var));
}
}
pic_panic(pic, "logic flaw");
}
static pic_value
var_set(pic_state *pic, struct pic_proc *var, pic_value val)
var_set(pic_state *pic, pic_value var, pic_value val)
{
struct pic_weak *weak;
weak = pic_weak_ptr(pic_car(pic, pic->ptable));
pic_weak_set(pic, weak, var, val);
pic_weak_set(pic, weak, pic_obj_ptr(var), val);
return pic_undef_value(pic);
}
@ -35,8 +35,7 @@ var_set(pic_state *pic, struct pic_proc *var, pic_value val)
static pic_value
var_call(pic_state *pic)
{
struct pic_proc *self;
pic_value val;
pic_value self, val;
int n;
n = pic_get_args(pic, "&|o", &self, &val);
@ -48,22 +47,18 @@ var_call(pic_state *pic)
conv = pic_closure_ref(pic, 0);
if (! pic_false_p(pic, conv)) {
val = pic_call(pic, pic_proc_ptr(conv), 1, val);
val = pic_call(pic, conv, 1, val);
}
return var_set(pic, self, val);
}
}
struct pic_proc *
pic_make_var(pic_state *pic, pic_value init, struct pic_proc *conv)
pic_value
pic_make_var(pic_state *pic, pic_value init, pic_value conv)
{
struct pic_proc *var;
pic_value c = pic_false_value(pic);
pic_value var;
if (conv != NULL) {
c = pic_obj_value(conv);
}
var = pic_lambda(pic, var_call, 1, c);
var = pic_lambda(pic, var_call, 1, conv);
pic_call(pic, var, 1, init);
@ -73,19 +68,17 @@ pic_make_var(pic_state *pic, pic_value init, struct pic_proc *conv)
static pic_value
pic_var_make_parameter(pic_state *pic)
{
struct pic_proc *conv = NULL;
pic_value init;
pic_value init, conv = pic_false_value(pic);
pic_get_args(pic, "o|l", &init, &conv);
return pic_obj_value(pic_make_var(pic, init, conv));
return pic_make_var(pic, init, conv);
}
static pic_value
pic_var_with_parameter(pic_state *pic)
{
struct pic_proc *body;
pic_value val;
pic_value body, val;
pic_get_args(pic, "l", &body);

10
extlib/benz/vector.c
View File

@ -224,9 +224,8 @@ pic_vec_vector_fill_i(pic_state *pic)
static pic_value
pic_vec_vector_map(pic_state *pic)
{
struct pic_proc *proc;
int argc, i, len, j;
pic_value *argv, vec, vals;
pic_value proc, *argv, vec, vals;
pic_get_args(pic, "l*", &proc, &argc, &argv);
@ -249,7 +248,7 @@ pic_vec_vector_map(pic_state *pic)
for (j = 0; j < argc; ++j) {
pic_push(pic, pic_vec_ref(pic, argv[j], i), vals);
}
pic_vec_set(pic, vec, i, pic_funcall(pic, "picrin.base", "apply", 2, pic_obj_value(proc), vals));
pic_vec_set(pic, vec, i, pic_funcall(pic, "picrin.base", "apply", 2, proc, vals));
}
return vec;
@ -258,9 +257,8 @@ pic_vec_vector_map(pic_state *pic)
static pic_value
pic_vec_vector_for_each(pic_state *pic)
{
struct pic_proc *proc;
int argc, i, len, j;
pic_value *argv, vals;
pic_value proc, *argv, vals;
pic_get_args(pic, "l*", &proc, &argc, &argv);
@ -281,7 +279,7 @@ pic_vec_vector_for_each(pic_state *pic)
for (j = 0; j < argc; ++j) {
pic_push(pic, pic_vec_ref(pic, argv[j], i), vals);
}
pic_funcall(pic, "picrin.base", "apply", 2, pic_obj_value(proc), vals);
pic_funcall(pic, "picrin.base", "apply", 2, proc, vals);
}
return pic_undef_value(pic);

9
extlib/benz/weak.c
View File

@ -105,12 +105,11 @@ weak_set(pic_state *pic, struct pic_weak *weak, void *key, pic_value val)
static pic_value
weak_call(pic_state *pic)
{
struct pic_proc *self;
struct pic_weak *weak;
pic_value key, val;
int n;
n = pic_get_args(pic, "&o|o", &self, &key, &val);
n = pic_get_args(pic, "o|o", &key, &val);
if (! pic_obj_p(pic, key)) {
pic_errorf(pic, "attempted to set a non-object key '~s' in an ephemeron", key);
@ -128,13 +127,9 @@ weak_call(pic_state *pic)
static pic_value
pic_weak_make_ephemeron(pic_state *pic)
{
struct pic_proc *proc;
pic_get_args(pic, "");
proc = pic_lambda(pic, weak_call, 1, pic_obj_value(pic_make_weak(pic)));
return pic_obj_value(proc);
return pic_lambda(pic, weak_call, 1, pic_obj_value(pic_make_weak(pic)));
}
void