diff --git a/piclib/prelude.scm b/piclib/prelude.scm index 9b8a390a..7367d593 100644 --- a/piclib/prelude.scm +++ b/piclib/prelude.scm @@ -299,13 +299,6 @@ (lambda (form r c) `(,(r 'let*-values) ,@(cdr form))))) - (define (vector-map proc vect) - (do ((i 0 (+ i 1)) - (u (make-vector (vector-length vect)))) - ((= i (vector-length vect)) - u) - (vector-set! u i (proc (vector-ref vect i))))) - (define (walk proc expr) (cond ((null? expr) @@ -314,7 +307,7 @@ (cons (proc (car expr)) (walk proc (cdr expr)))) ((vector? expr) - (vector-map proc expr)) + (list->vector (map proc (vector->list expr)))) (else (proc expr)))) diff --git a/src/cont.c b/src/cont.c index de076874..11b5a3f6 100644 --- a/src/cont.c +++ b/src/cont.c @@ -210,6 +210,37 @@ walk_to_block(pic_state *pic, pic_block *here, pic_block *there) } } +static pic_value +pic_dynamic_wind(pic_state *pic, struct pic_proc *in, struct pic_proc *thunk, struct pic_proc *out) +{ + pic_block *here; + pic_value val; + + if (in != NULL) { + pic_apply0(pic, in); /* enter */ + } + + here = pic->blk; + pic->blk = (pic_block *)pic_alloc(pic, sizeof(pic_block)); + pic->blk->prev = here; + pic->blk->depth = here->depth + 1; + pic->blk->in = in; + pic->blk->out = out; + pic->blk->refcnt = 1; + PIC_BLK_INCREF(pic, here); + + val = pic_apply0(pic, thunk); + + PIC_BLK_DECREF(pic, pic->blk); + pic->blk = here; + + if (out != NULL) { + pic_apply0(pic, out); /* exit */ + } + + return val; +} + noreturn static pic_value cont_call(pic_state *pic) { @@ -286,33 +317,10 @@ static pic_value pic_cont_dynamic_wind(pic_state *pic) { struct pic_proc *in, *thunk, *out; - pic_value v; pic_get_args(pic, "lll", &in, &thunk, &out); - /* enter */ - pic_apply0(pic, in); - { - pic_block *here; - - here = pic->blk; - pic->blk = (pic_block *)pic_alloc(pic, sizeof(pic_block)); - pic->blk->prev = here; - pic->blk->depth = here->depth + 1; - pic->blk->in = in; - pic->blk->out = out; - pic->blk->refcnt = 1; - PIC_BLK_INCREF(pic, here); - - v = pic_apply0(pic, thunk); - - PIC_BLK_DECREF(pic, pic->blk); - pic->blk = here; - } - /* exit */ - pic_apply0(pic, out); - - return v; + return pic_dynamic_wind(pic, in, thunk, out); } static pic_value