2005-01-29 14:18:28 -05:00
|
|
|
! Copyright (C) 2003, 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
2005-09-14 00:37:50 -04:00
|
|
|
IN: kernel
|
|
|
|
USING: errors lists namespaces sequences words vectors ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-06-15 23:27:28 -04:00
|
|
|
TUPLE: interp data call name catch ;
|
2004-08-23 01:13:09 -04:00
|
|
|
|
2005-09-14 00:37:50 -04:00
|
|
|
: continuation ( -- interp )
|
|
|
|
#! The continuation is reified from after the *caller* of
|
|
|
|
#! this word returns.
|
|
|
|
datastack callstack dup pop* dup pop*
|
2005-06-15 23:27:28 -04:00
|
|
|
namestack catchstack <interp> ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-06-15 23:27:28 -04:00
|
|
|
: >interp< ( interp -- data call name catch )
|
|
|
|
[ interp-data ] keep
|
|
|
|
[ interp-call ] keep
|
|
|
|
[ interp-name ] keep
|
|
|
|
interp-catch ;
|
|
|
|
|
2005-09-14 00:37:50 -04:00
|
|
|
: quot>interp ( quot -- continuation )
|
|
|
|
#! Make a continuation that executes the quotation.
|
|
|
|
#! The quotation should not return, or a call stack
|
|
|
|
#! underflow will be signalled.
|
|
|
|
{ } swap 1 <vector> [ push ] keep f f <interp> ;
|
|
|
|
|
|
|
|
: continue ( continuation -- )
|
|
|
|
#! Restore a continuation.
|
|
|
|
>interp<
|
|
|
|
set-catchstack set-namestack set-callstack set-datastack ;
|
|
|
|
|
|
|
|
: continue-with ( object continuation -- object )
|
|
|
|
#! Restore a continuation, and place the object in the
|
|
|
|
#! restored data stack.
|
|
|
|
>interp< set-catchstack set-namestack
|
|
|
|
>r swap >r set-datastack r> r> set-callstack ;
|
|
|
|
|
|
|
|
: with-continuation ( quot -- | quot: continuation -- )
|
|
|
|
#! Call a quotation with the current continuation, which may
|
|
|
|
#! be restored using continue or continue-with.
|
|
|
|
>r continuation dup interp-call dup pop* drop
|
|
|
|
r> call ; inline
|
2004-07-18 18:12:32 -04:00
|
|
|
|
2005-06-15 23:27:28 -04:00
|
|
|
: callcc0 ( quot ++ | quot: cont -- | cont: ++ )
|
2005-09-14 00:37:50 -04:00
|
|
|
"use with-continuation instead" throw ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-06-15 23:27:28 -04:00
|
|
|
: callcc1 ( quot ++ obj | quot: cont -- | cont: obj ++ obj )
|
2005-09-14 00:37:50 -04:00
|
|
|
"use with-continuation instead" throw ;
|