Walker now handles errors properly (almosT)

TODO.FACTOR.txt

@@ -1,5 +1,10 @@
 + 0.84:
 
++ remaining walker tasks:
+- <input> handled by walker itself
+- ^W in interactor
+- ^I in interactor
+
 - windows native i/o
 - fix contribs: parser-combinators, boids, automata, space-invaders
 - unix i/o: problems with passing f to syscalls

library/continuations.factor

@@ -18,6 +18,10 @@ USING: namespaces sequences ;
 
 TUPLE: continuation data retain call name catch ;
 
+: <empty-continuation> ( -- continuation )
+    V{ } clone V{ } clone V{ } clone V{ } clone V{ } clone
+    <continuation> ;
+
 : continuation ( -- interp )
     datastack retainstack callstack namestack catchstack
     <continuation> ; inline

library/errors.factor

@@ -13,7 +13,11 @@ USING: kernel ;
     [ >c call f c> drop f ] callcc1 nip ; inline
 
 : rethrow ( error -- )
-    catchstack* empty? [ die ] [ c> continue-with ] if ;
+    catchstack* empty? [
+        die
+    ] [
+        c> dup quotation? [ call ] [ continue-with ] if
+    ] if ;
 
 : cleanup ( try cleanup -- | try: -- | cleanup: -- )
     [ >c >r call c> drop r> call ]

library/tools/interpreter.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: interpreter
-USING: errors generic io kernel kernel-internals math namespaces
+USING: arrays errors generic io kernel kernel-internals math
-prettyprint sequences strings threads vectors words ;
+namespaces prettyprint sequences strings threads vectors words ;
 
 ! A Factor interpreter written in Factor. It can transfer the
 ! continuation to and from the primary interpreter. Used by
@@ -87,15 +87,39 @@ SYMBOL: callframe-end
     #! Note we do tail call optimization here.
     save-callframe (meta-call) ;
 
-: (host-quot) ( n quot -- )
+: <callframe> ( quot -- seq )
-    [
+    0 over length 3array ;
-        [ \ continuation , , \ continue-with , ] [ ] make
-        append
-        dup push-c swap push-c length push-c
-        meta-interp continue
-    ] callcc1 set-meta-interp 2drop ;
 
-: host-quot ( quot -- ) 0 swap (host-quot) ;
+: quot>cont ( quot -- continuation )
+    <callframe> >vector
+    <empty-continuation>
+    [ set-continuation-call ] keep ;
+
+: catch-harness ( continuation -- quot )
+    [ [ c> 2array ] % , \ continue-with , ] [ ] make ;
+
+: host-harness ( quot continuation -- )
+    tuck [
+        catch-harness , \ >c ,
+        %
+        [ c> drop continuation ] %
+        ,
+        \ continue-with ,
+    ] [ ] make ;
+
+: restore-harness ( obj -- )
+    dup array? [
+        init-meta-interp [ ] (meta-call)
+        [ first2 continue-with ] in-thread drop
+    ] [
+        set-meta-interp
+    ] if ;
+
+: host-quot ( quot -- )
+    [
+        host-harness <callframe> meta-c get swap nappend
+        meta-interp continue
+    ] callcc1 restore-harness drop ;
 
 : host-word ( word -- ) unit host-quot ;
 
@@ -137,7 +161,8 @@ M: object do ( object -- ) do-1 ;
 : step-in ( -- ) [ do ] next ;
 
 : step-out ( -- )
-    callframe-scan get callframe get (host-quot) [ ] (meta-call) ;
+    callframe get callframe-scan get tail
+    host-quot [ ] (meta-call) ;
 
 : step-all ( -- )
     save-callframe

library/ui/tools/walker.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-walker
-USING: arrays gadgets gadgets-buttons gadgets-frames
+USING: arrays errors gadgets gadgets-buttons gadgets-frames
 gadgets-listener gadgets-panes gadgets-scrolling gadgets-text
 gadgets-tiles gadgets-tracks generic hashtables inspector
 interpreter io kernel kernel-internals listener math models
@@ -94,10 +94,9 @@ M: walker-gadget focusable-child* ( listener -- gadget )
     [ global , walker-stream stdio associate , ] V{ } make ;
 
 : walker-continuation ( -- continuation )
-    continuation
+    <empty-continuation>
-    V{ } clone over set-continuation-data
+    catchstack over set-continuation-catch
-    V{ } clone over set-continuation-retain
+    namestack over set-continuation-name ;
-    V{ } clone over set-continuation-call ;
 
 : init-walker ( walker -- )
     H{ } clone over set-walker-gadget-ns