continuation object is applicable

This commit is contained in:
Yuichi Nishiwaki 2014-09-05 14:15:46 +09:00
parent 3a4de8895e
commit b8b5743589
3 changed files with 32 additions and 19 deletions

42
cont.c
View File

@ -250,25 +250,6 @@ pic_dynamic_wind(pic_state *pic, struct pic_proc *in, struct pic_proc *thunk, st
return val;
}
noreturn static pic_value
pic_cont_continue(pic_state *pic)
{
struct pic_proc *proc;
size_t argc;
pic_value cont, *argv;
proc = pic_get_proc(pic);
pic_get_args(pic, "o*", &cont, &argc, &argv);
pic_assert_type(pic, cont, cont);
pic_cont_ptr(cont)->results = pic_list_by_array(pic, argc, argv);
/* execute guard handlers */
walk_to_block(pic, pic->blk, pic_cont_ptr(cont)->blk);
restore_cont(pic, pic_cont_ptr(cont));
}
pic_value
pic_callcc(pic_state *pic, struct pic_proc *proc)
@ -298,6 +279,16 @@ pic_callcc_trampoline(pic_state *pic, struct pic_proc *proc)
}
}
noreturn void
pic_continue(pic_state *pic, struct pic_cont *cont, size_t argc, pic_value *argv)
{
cont->results = pic_list_by_array(pic, argc, argv);
walk_to_block(pic, pic->blk, cont->blk);
restore_cont(pic, cont);
}
static pic_value
pic_cont_callcc(pic_state *pic)
{
@ -308,6 +299,19 @@ pic_cont_callcc(pic_state *pic)
return pic_callcc_trampoline(pic, cb);
}
noreturn static pic_value
pic_cont_continue(pic_state *pic)
{
size_t argc;
pic_value cont, *argv;
pic_get_args(pic, "o*", &cont, &argc, &argv);
pic_assert_type(pic, cont, cont);
pic_continue(pic, pic_cont_ptr(cont), argc, argv);
}
static pic_value
pic_cont_dynamic_wind(pic_state *pic)
{

View File

@ -57,6 +57,7 @@ pic_value pic_values_by_list(pic_state *, pic_value);
size_t pic_receive(pic_state *, size_t, pic_value *);
pic_value pic_callcc(pic_state *, struct pic_proc *);
noreturn void pic_continue(pic_state *, struct pic_cont *, size_t, pic_value *);
#if defined(__cplusplus)
}

8
vm.c
View File

@ -21,6 +21,7 @@
#include "picrin/error.h"
#include "picrin/dict.h"
#include "picrin/record.h"
#include "picrin/cont.h"
#define GET_OPERAND(pic,n) ((pic)->ci->fp[(n)])
@ -752,6 +753,13 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
PUSH(pic_var_ref(pic, pic_var_ptr(x)));
NEXT;
}
if (pic_cont_p(x)) {
if (c.u.i >= 1) {
pic_errorf(pic, "invalid call-sequence for cont object");
}
pic_continue(pic, pic_cont_ptr(x), c.u.i - 1, pic->sp - c.u.i + 1);
UNREACHABLE();
}
pic_errorf(pic, "invalid application: ~s", x);
}
proc = pic_proc_ptr(x);