Paste: delimited continuations

IN: delimited-continuations

USING: kernel continuations namespaces locals sequences accessors fry ;

SYMBOL: Holes

: hole-init ( -- )
    V{ } clone Holes set ;
: hole-push ( hole -- )
    Holes get push ;
: hole-pop ( -- hole )
    Holes get pop ;

: abort-top ( v -- * )
    hole-pop continue-with ;

: reset ( quot -- obj )
    '[ hole-push @ abort-top ] callcc1 ; inline

:: shift ( quot -- obj )
     [| return-shift |
       [| x |
         [ hole-push x return-shift continue-with ] callcc1
       ] quot call abort-top
     ] callcc1
    ; inline

Annotation: refactored some

IN: delimited-continuations

USING: kernel continuations namespaces locals sequences accessors fry math ;

SYMBOL: Holes

: hole-init ( -- )
    V{ } clone Holes set ;
: hole-push ( hole -- )
    Holes get push ;
: hole-pop ( -- hole )
    Holes get pop ;

: abort-top ( v -- * )
    hole-pop continue-with ;

: set-top ( quot -- obj )
    '[ hole-push @ ] callcc1 ; inline

: reset ( quot -- obj )
    '[ @ abort-top ] set-top ; inline

:: shift ( quot -- obj )
     [| k |
       [| x | [ x k continue-with ] set-top ]
       quot call abort-top
     ] callcc1
    ; inline

Annotation: better?

IN: delimited-continuations

USING: kernel continuations namespaces sequences fry ;

SYMBOL: Holes

: hole-init ( -- )
    V{ } clone Holes set ;
: hole-push ( hole -- )
    Holes get push ;
: hole-pop ( -- hole )
    Holes get pop ;

: abort-top ( v -- * )
    hole-pop continue-with ;

: set-top ( quot -- obj )
    '[ hole-push @ ] callcc1 ; inline

: reset ( quot -- obj )
    '[ @ abort-top ] set-top ; inline

: shift ( quot -- obj )
     '[ @ abort-top ] callcc1 ; inline

: jump ( x k -- obj )
     '[ _ _ continue-with ] set-top ; inline

! ( scratchpad ) [ [| k | 1 k jump k jump ] shift [| k | 2 k jump ] shift + ] reset 3 * .
! 15

New Annotation