factor/library/continuations.factor

63 lines
1.6 KiB
Factor
Raw Normal View History

2006-05-02 06:05:58 -04:00
! Copyright (C) 2003, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: kernel-internals
USING: vectors ;
2006-08-15 21:23:05 -04:00
: catchstack* ( -- catchstack )
6 getenv { vector } declare ; inline
2006-05-02 06:05:58 -04:00
2006-06-04 15:35:00 -04:00
: (continue-with) 9 getenv ;
IN: errors
USING: kernel kernel-internals ;
2006-08-15 21:23:05 -04:00
: catchstack ( -- catchstack ) catchstack* clone ; inline
: set-catchstack ( catchstack -- ) >vector 6 setenv ; inline
2005-09-14 00:37:50 -04:00
IN: kernel
USING: namespaces sequences ;
2004-07-16 02:26:21 -04:00
2006-05-14 23:09:47 -04:00
TUPLE: continuation data retain call name catch ;
2005-09-24 23:21:09 -04:00
: <empty-continuation> ( -- continuation )
V{ } clone V{ } clone V{ } clone V{ } clone V{ } clone
<continuation> ;
2006-08-15 21:23:05 -04:00
: continuation ( -- continuation )
2006-07-24 00:41:27 -04:00
datastack retainstack callstack namestack catchstack
<continuation> ; inline
2004-07-16 02:26:21 -04:00
2006-05-14 23:09:47 -04:00
: >continuation< ( continuation -- data retain call name catch )
2005-09-18 23:22:58 -04:00
[ continuation-data ] keep
2006-05-14 23:09:47 -04:00
[ continuation-retain ] keep
2005-09-18 23:22:58 -04:00
[ continuation-call ] keep
[ continuation-name ] keep
continuation-catch ; inline
2005-06-15 23:27:28 -04:00
2006-08-15 16:29:35 -04:00
: ifcc ( terminator balance -- )
2006-07-24 00:20:08 -04:00
[ f f continuation 2nip dup ] call 2swap if ; inline
2006-08-15 21:23:05 -04:00
: callcc0 ( quot -- ) [ drop ] ifcc ; inline
2005-09-14 00:37:50 -04:00
: continue ( continuation -- )
>continuation<
2006-05-14 23:09:47 -04:00
set-catchstack
set-namestack
set-callstack
set-retainstack
set-datastack ;
inline
2005-09-14 00:37:50 -04:00
2006-08-15 21:23:05 -04:00
: callcc1 ( quot -- obj )
[ drop (continue-with) ] ifcc ; inline
2005-09-23 01:22:04 -04:00
2006-08-15 21:23:05 -04:00
: continue-with ( obj continuation -- )
swap 9 setenv continue ; inline
2006-08-24 02:40:03 -04:00
M: continuation clone
[ continuation-data clone ] keep
[ continuation-retain clone ] keep
[ continuation-call clone ] keep
[ continuation-name clone ] keep
continuation-catch clone <continuation> ;