continuations: faster with-datastack

release
Slava Pestov 2010-04-03 19:10:21 -04:00
parent f86c9439e9
commit be024c228c
2 changed files with 9 additions and 10 deletions

View File

@ -235,7 +235,7 @@ HELP: save-error
$low-level-note ; $low-level-note ;
HELP: with-datastack HELP: with-datastack
{ $values { "stack" sequence } { "quot" quotation } { "newstack" sequence } } { $values { "stack" sequence } { "quot" quotation } { "new-stack" sequence } }
{ $description "Executes the quotation with the given data stack contents, and outputs the new data stack after the word returns. The input sequence is not modified; a new sequence is produced. Does not affect the data stack in surrounding code, other than consuming the two inputs and pushing the output." } { $description "Executes the quotation with the given data stack contents, and outputs the new data stack after the word returns. The input sequence is not modified; a new sequence is produced. Does not affect the data stack in surrounding code, other than consuming the two inputs and pushing the output." }
{ $examples { $examples
{ $example "USING: continuations math prettyprint ;" "{ 3 7 } [ + ] with-datastack ." "{ 10 }" } { $example "USING: continuations math prettyprint ;" "{ 3 7 } [ + ] with-datastack ." "{ 10 }" }

View File

@ -1,10 +1,17 @@
! Copyright (C) 2003, 2009 Slava Pestov. ! Copyright (C) 2003, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays vectors kernel kernel.private sequences USING: arrays vectors kernel kernel.private sequences
namespaces make math splitting sorting quotations assocs namespaces make math splitting sorting quotations assocs
combinators combinators.private accessors words ; combinators combinators.private accessors words ;
IN: continuations IN: continuations
: with-datastack ( stack quot -- new-stack )
[
[ [ datastack ] dip swap [ { } like set-datastack ] dip ] dip
swap [ call datastack ] dip
swap [ set-datastack ] dip
] (( stack quot -- new-stack )) call-effect-unsafe ;
SYMBOL: error SYMBOL: error
SYMBOL: error-continuation SYMBOL: error-continuation
SYMBOL: error-thread SYMBOL: error-thread
@ -90,14 +97,6 @@ SYMBOL: return-continuation
: return ( -- * ) : return ( -- * )
return-continuation get continue ; return-continuation get continue ;
: with-datastack ( stack quot -- newstack )
[
[
[ [ { } like set-datastack ] dip call datastack ] dip
continue-with
] (( stack quot continuation -- * )) call-effect-unsafe
] callcc1 2nip ;
GENERIC: compute-restarts ( error -- seq ) GENERIC: compute-restarts ( error -- seq )
<PRIVATE <PRIVATE