From ec4d9b49323ebb0909150f948eba3d5e4db45fe4 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Mon, 31 Jul 2006 20:12:29 +0000
Subject: [PATCH] Walker now handles errors properly (almosT)

---
 TODO.FACTOR.txt                  |  5 ++++
 library/continuations.factor     |  4 +++
 library/errors.factor            |  6 +++-
 library/tools/interpreter.factor | 47 ++++++++++++++++++++++++--------
 library/ui/tools/walker.factor   |  9 +++---
 5 files changed, 54 insertions(+), 17 deletions(-)

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 5778873e41..d1dfe80eb2 100644
--- a/TODO.FACTOR.txt
+++ b/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
diff --git a/library/continuations.factor b/library/continuations.factor
index 88fb0423e2..d0602d4847 100644
--- a/library/continuations.factor
+++ b/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
diff --git a/library/errors.factor b/library/errors.factor
index e8c68c0480..b7f4ed8f6b 100644
--- a/library/errors.factor
+++ b/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 ]
diff --git a/library/tools/interpreter.factor b/library/tools/interpreter.factor
index e866c9cb30..8f3d7134cc 100644
--- a/library/tools/interpreter.factor
+++ b/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
-prettyprint sequences strings threads vectors words ;
+USING: arrays errors generic io kernel kernel-internals math
+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 -- )
-    [
-        [ \ continuation , , \ continue-with , ] [ ] make
-        append
-        dup push-c swap push-c length push-c
-        meta-interp continue
-    ] callcc1 set-meta-interp 2drop ;
+: <callframe> ( quot -- seq )
+    0 over length 3array ;
 
-: 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
diff --git a/library/ui/tools/walker.factor b/library/ui/tools/walker.factor
index 0e5db811c5..ef1a30fc82 100644
--- a/library/ui/tools/walker.factor
+++ b/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
-    V{ } clone over set-continuation-data
-    V{ } clone over set-continuation-retain
-    V{ } clone over set-continuation-call ;
+    <empty-continuation>
+    catchstack over set-continuation-catch
+    namestack over set-continuation-name ;
 
 : init-walker ( walker -- )
     H{ } clone over set-walker-gadget-ns