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

pic_get_args supports pic_procs

This commit is contained in:
Yuichi Nishiwaki 2014-01-08 20:53:28 +09:00
parent b9ef51530f
commit e7f765d218
4 changed files with 27 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
src/cont.c
View File

@ -150,15 +150,9 @@ static pic_value
pic_cont_callcc(pic_state *pic)
{
struct pic_cont *cont;
pic_value v;
struct pic_proc *cb;
pic_get_args(pic, "o", &v);
if (! pic_proc_p(v)) {
pic_error(pic, "expected procedure");
}
cb = pic_proc_ptr(v);
pic_get_args(pic, "l", &cb);
save_cont(pic, &cont);
if (setjmp(cont->jmp)) {
@ -182,23 +176,10 @@ pic_cont_callcc(pic_state *pic)
static pic_value
pic_cont_dynamic_wind(pic_state *pic)
{
pic_value a,b,c,v;
struct pic_proc *in, *thunk, *out;
pic_value v;
pic_get_args(pic, "ooo", &a, &b, &c);
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);
pic_get_args(pic, "lll", &in, &thunk, &out);
/* enter */
pic_apply_argv(pic, in, 0);

14
src/error.c
View File

@ -59,20 +59,10 @@ pic_raise(pic_state *pic, pic_value obj)
static pic_value
pic_error_with_exception_handler(pic_state *pic)
{
pic_value v, w;
struct pic_proc *handler, *thunk;
pic_value v;
pic_get_args(pic, "oo", &v, &w);
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);
pic_get_args(pic, "ll", &handler, &thunk);
if (pic->ridx >= pic->rlen) {

10
src/proc.c
View File

@ -40,15 +40,13 @@ pic_proc_proc_p(pic_state *pic)
static pic_value
pic_proc_apply(pic_state *pic)
{
pic_value proc, *args, v;
struct pic_proc *proc;
pic_value *args, v;
size_t argc;
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) {
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);
}
return pic_apply(pic, pic_proc_ptr(proc), v);
return pic_apply(pic, proc, v);
}
void

18
src/vm.c
View File

@ -240,6 +240,24 @@ pic_get_args(pic_state *pic, const char *format, ...)
}
}
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:
{
pic_error(pic, "pic_get_args: invalid argument specifier given");