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

change the interface of call/cc

This commit is contained in:
Yuichi Nishiwaki 2014-08-25 17:10:25 +09:00
parent 4cf8f3d7f6
commit e0831c1aa3
2 changed files with 12 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
cont.c
View File

@ -7,7 +7,6 @@
#include <stdarg.h> #include <stdarg.h>
#include "picrin.h" #include "picrin.h"
#include "picrin/proc.h"
#include "picrin/cont.h" #include "picrin/cont.h"
#include "picrin/pair.h" #include "picrin/pair.h"
#include "picrin/error.h" #include "picrin/error.h"
@ -252,23 +251,21 @@ pic_dynamic_wind(pic_state *pic, struct pic_proc *in, struct pic_proc *thunk, st
} }
noreturn static pic_value noreturn static pic_value
cont_call(pic_state *pic) pic_cont_continue(pic_state *pic)
{ {
struct pic_proc *proc; struct pic_proc *proc;
size_t argc; size_t argc;
pic_value *argv; pic_value cont, *argv;
struct pic_cont *cont;
proc = pic_get_proc(pic); proc = pic_get_proc(pic);
pic_get_args(pic, "*", &argc, &argv); pic_get_args(pic, "o*", &cont, &argc, &argv);
cont = (struct pic_cont *)pic_ptr(pic_attr_ref(pic, proc, "@@cont")); pic_assert_type(pic, cont, cont);
cont->results = pic_list_by_array(pic, argc, argv);
/* execute guard handlers */ /* execute guard handlers */
walk_to_block(pic, pic->blk, cont->blk); walk_to_block(pic, pic->blk, pic_cont_ptr(cont)->blk);
restore_cont(pic, cont); restore_cont(pic, pic_cont_ptr(cont));
} }
pic_value pic_value
@ -281,14 +278,7 @@ pic_callcc(pic_state *pic, struct pic_proc *proc)
return pic_values_by_list(pic, cont->results); return pic_values_by_list(pic, cont->results);
} }
else { else {
struct pic_proc *c; return pic_apply1(pic, proc, pic_obj_value(cont));
c = pic_proc_new(pic, cont_call, "<continuation-procedure>");
/* save the continuation object in proc */
pic_attr_set(pic, c, "@@cont", pic_obj_value(cont));
return pic_apply1(pic, proc, pic_obj_value(c));
} }
} }
@ -302,14 +292,7 @@ pic_callcc_trampoline(pic_state *pic, struct pic_proc *proc)
return pic_values_by_list(pic, cont->results); return pic_values_by_list(pic, cont->results);
} }
else { else {
struct pic_proc *c; return pic_apply_trampoline(pic, proc, pic_list1(pic, pic_obj_value(cont)));
c = pic_proc_new(pic, cont_call, "<continuation-procedure>");
/* save the continuation object in proc */
pic_attr_set(pic, c, "@@cont", pic_obj_value(cont));
return pic_apply_trampoline(pic, proc, pic_list1(pic, pic_obj_value(c)));
} }
} }
@ -365,6 +348,7 @@ pic_init_cont(pic_state *pic)
{ {
pic_defun(pic, "call-with-current-continuation", pic_cont_callcc); pic_defun(pic, "call-with-current-continuation", pic_cont_callcc);
pic_defun(pic, "call/cc", pic_cont_callcc); pic_defun(pic, "call/cc", pic_cont_callcc);
pic_defun(pic, "continue", pic_cont_continue);
pic_defun(pic, "dynamic-wind", pic_cont_dynamic_wind); pic_defun(pic, "dynamic-wind", pic_cont_dynamic_wind);
pic_defun(pic, "values", pic_cont_values); pic_defun(pic, "values", pic_cont_values);
pic_defun(pic, "call-with-values", pic_cont_call_with_values); pic_defun(pic, "call-with-values", pic_cont_call_with_values);

3
include/picrin/cont.h
View File

@ -43,6 +43,9 @@ struct pic_cont {
pic_value results; pic_value results;
}; };
#define pic_cont_p(o) (pic_type(o) == PIC_TT_CONT)
#define pic_cont_ptr(o) ((struct pic_cont *)pic_ptr(o))
pic_value pic_values0(pic_state *); pic_value pic_values0(pic_state *);
pic_value pic_values1(pic_state *, pic_value); pic_value pic_values1(pic_state *, pic_value);
pic_value pic_values2(pic_state *, pic_value, pic_value); pic_value pic_values2(pic_state *, pic_value, pic_value);