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-04-06 21:41:49 -04:00
|
|
|
IN: kernel USING: errors lists namespaces sequences ;
|
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-06-15 23:27:28 -04:00
|
|
|
: interp ( -- interp )
|
|
|
|
datastack callstack >pop> >pop>
|
|
|
|
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 ;
|
|
|
|
|
|
|
|
: set-interp ( interp -- )
|
|
|
|
>interp< set-catchstack set-namestack
|
2004-07-18 18:12:32 -04:00
|
|
|
>r set-datastack r> set-callstack ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-06-15 23:27:28 -04:00
|
|
|
: continuation ( interp -- )
|
|
|
|
interp dup interp-call >pop> >pop> drop
|
|
|
|
dup interp-data >pop> drop ;
|
2004-07-18 18:12:32 -04:00
|
|
|
|
2005-06-15 23:27:28 -04:00
|
|
|
: callcc0 ( quot ++ | quot: cont -- | cont: ++ )
|
|
|
|
continuation
|
|
|
|
[ set-interp ] cons swap call ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-06-15 23:27:28 -04:00
|
|
|
: callcc1 ( quot ++ obj | quot: cont -- | cont: obj ++ obj )
|
|
|
|
continuation
|
|
|
|
[ [ interp-data push ] keep set-interp ] cons swap call ;
|