pic_get_args supports pic_procs
This commit is contained in:
parent
b9ef51530f
commit
e7f765d218
25
src/cont.c
25
src/cont.c
|
@ -150,15 +150,9 @@ static pic_value
|
||||||
pic_cont_callcc(pic_state *pic)
|
pic_cont_callcc(pic_state *pic)
|
||||||
{
|
{
|
||||||
struct pic_cont *cont;
|
struct pic_cont *cont;
|
||||||
pic_value v;
|
|
||||||
struct pic_proc *cb;
|
struct pic_proc *cb;
|
||||||
|
|
||||||
pic_get_args(pic, "o", &v);
|
pic_get_args(pic, "l", &cb);
|
||||||
|
|
||||||
if (! pic_proc_p(v)) {
|
|
||||||
pic_error(pic, "expected procedure");
|
|
||||||
}
|
|
||||||
cb = pic_proc_ptr(v);
|
|
||||||
|
|
||||||
save_cont(pic, &cont);
|
save_cont(pic, &cont);
|
||||||
if (setjmp(cont->jmp)) {
|
if (setjmp(cont->jmp)) {
|
||||||
|
@ -182,23 +176,10 @@ pic_cont_callcc(pic_state *pic)
|
||||||
static pic_value
|
static pic_value
|
||||||
pic_cont_dynamic_wind(pic_state *pic)
|
pic_cont_dynamic_wind(pic_state *pic)
|
||||||
{
|
{
|
||||||
pic_value a,b,c,v;
|
|
||||||
struct pic_proc *in, *thunk, *out;
|
struct pic_proc *in, *thunk, *out;
|
||||||
|
pic_value v;
|
||||||
|
|
||||||
pic_get_args(pic, "ooo", &a, &b, &c);
|
pic_get_args(pic, "lll", &in, &thunk, &out);
|
||||||
|
|
||||||
if (! pic_proc_p(a)) {
|
|
||||||
pic_error(pic, "procedure expected");
|
|
||||||
}
|
|
||||||
in = pic_proc_ptr(a);
|
|
||||||
if (! pic_proc_p(b)) {
|
|
||||||
pic_error(pic, "procedure expected");
|
|
||||||
}
|
|
||||||
thunk = pic_proc_ptr(b);
|
|
||||||
if (! pic_proc_p(c)) {
|
|
||||||
pic_error(pic, "procedure expected");
|
|
||||||
}
|
|
||||||
out = pic_proc_ptr(c);
|
|
||||||
|
|
||||||
/* enter */
|
/* enter */
|
||||||
pic_apply_argv(pic, in, 0);
|
pic_apply_argv(pic, in, 0);
|
||||||
|
|
14
src/error.c
14
src/error.c
|
@ -59,20 +59,10 @@ pic_raise(pic_state *pic, pic_value obj)
|
||||||
static pic_value
|
static pic_value
|
||||||
pic_error_with_exception_handler(pic_state *pic)
|
pic_error_with_exception_handler(pic_state *pic)
|
||||||
{
|
{
|
||||||
pic_value v, w;
|
|
||||||
struct pic_proc *handler, *thunk;
|
struct pic_proc *handler, *thunk;
|
||||||
|
pic_value v;
|
||||||
|
|
||||||
pic_get_args(pic, "oo", &v, &w);
|
pic_get_args(pic, "ll", &handler, &thunk);
|
||||||
|
|
||||||
if (! pic_proc_p(v)){
|
|
||||||
pic_error(pic, "expected procedure");
|
|
||||||
}
|
|
||||||
handler = pic_proc_ptr(v);
|
|
||||||
|
|
||||||
if (! pic_proc_p(v)) {
|
|
||||||
pic_error(pic, "expected procedure");
|
|
||||||
}
|
|
||||||
thunk = pic_proc_ptr(w);
|
|
||||||
|
|
||||||
if (pic->ridx >= pic->rlen) {
|
if (pic->ridx >= pic->rlen) {
|
||||||
|
|
||||||
|
|
10
src/proc.c
10
src/proc.c
|
@ -40,15 +40,13 @@ pic_proc_proc_p(pic_state *pic)
|
||||||
static pic_value
|
static pic_value
|
||||||
pic_proc_apply(pic_state *pic)
|
pic_proc_apply(pic_state *pic)
|
||||||
{
|
{
|
||||||
pic_value proc, *args, v;
|
struct pic_proc *proc;
|
||||||
|
pic_value *args, v;
|
||||||
size_t argc;
|
size_t argc;
|
||||||
int i;
|
int i;
|
||||||
|
|
||||||
pic_get_args(pic, "o*", &proc, &argc, &args);
|
pic_get_args(pic, "l*", &proc, &argc, &args);
|
||||||
|
|
||||||
if (! pic_proc_p(proc)) {
|
|
||||||
pic_error(pic, "apply: expected procedure");
|
|
||||||
}
|
|
||||||
if (argc == 0) {
|
if (argc == 0) {
|
||||||
pic_error(pic, "apply: wrong number of arguments");
|
pic_error(pic, "apply: wrong number of arguments");
|
||||||
}
|
}
|
||||||
|
@ -57,7 +55,7 @@ pic_proc_apply(pic_state *pic)
|
||||||
v = pic_cons(pic, args[i], v);
|
v = pic_cons(pic, args[i], v);
|
||||||
}
|
}
|
||||||
|
|
||||||
return pic_apply(pic, pic_proc_ptr(proc), v);
|
return pic_apply(pic, proc, v);
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
|
|
18
src/vm.c
18
src/vm.c
|
@ -240,6 +240,24 @@ pic_get_args(pic_state *pic, const char *format, ...)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
|
case 'l':
|
||||||
|
{
|
||||||
|
struct pic_proc **l;
|
||||||
|
pic_value v;
|
||||||
|
|
||||||
|
l = va_arg(ap, struct pic_proc **);
|
||||||
|
if (i < argc) {
|
||||||
|
v = GET_OPERAND(pic,i);
|
||||||
|
if (pic_proc_p(v)) {
|
||||||
|
*l = pic_proc_ptr(v);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
pic_error(pic, "pic_get_args, expected procedure");
|
||||||
|
}
|
||||||
|
i++;
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
default:
|
default:
|
||||||
{
|
{
|
||||||
pic_error(pic, "pic_get_args: invalid argument specifier given");
|
pic_error(pic, "pic_get_args: invalid argument specifier given");
|
||||||
|
|
Loading…
Reference in New Issue