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-07-24 20:17:51 -04:00
|
|
|
IN: kernel USING: errors lists namespaces sequences words ;
|
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-07-24 20:17:51 -04:00
|
|
|
: continuation ( interp -- )
|
|
|
|
interp dup interp-call >pop> >pop> drop
|
|
|
|
dup interp-data >pop> drop ;
|
|
|
|
|
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-07-24 20:17:51 -04:00
|
|
|
: set-interp ( interp quot -- )
|
|
|
|
>r >interp< set-catchstack set-namestack
|
|
|
|
>r set-datastack r> r> swap set-callstack call ;
|
2004-07-18 18:12:32 -04:00
|
|
|
|
2005-06-15 23:27:28 -04:00
|
|
|
: callcc0 ( quot ++ | quot: cont -- | cont: ++ )
|
|
|
|
continuation
|
2005-07-24 20:17:51 -04:00
|
|
|
[ [ ] 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
|
2005-08-04 00:48:07 -04:00
|
|
|
[ swap literalize unit set-interp ] cons swap call ;
|