From a2971bd3bef5ed9fb3e1b6cf66141156aafd2c43 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 2 Apr 2008 00:03:04 -0500
Subject: [PATCH] Improve walker: step into on an array recursively sets
 breakpoint on each quotation nested in the array. Useful for cond, case,
 cleave, ...

---
 extra/tools/walker/walker.factor | 44 ++++++++++++++++++++------------
 1 file changed, 28 insertions(+), 16 deletions(-)

diff --git a/extra/tools/walker/walker.factor b/extra/tools/walker/walker.factor
index d548c0a4f5..6bd8ace877 100755
--- a/extra/tools/walker/walker.factor
+++ b/extra/tools/walker/walker.factor
@@ -3,7 +3,7 @@
 USING: threads kernel namespaces continuations combinators
 sequences math namespaces.private continuations.private
 concurrency.messaging quotations kernel.private words
-sequences.private assocs models ;
+sequences.private assocs models arrays accessors ;
 IN: tools.walker
 
 SYMBOL: show-walker-hook ! ( status continuation thread -- )
@@ -51,9 +51,16 @@ DEFER: start-walker-thread
 : walk ( quot -- quot' )
     \ break prefix [ break rethrow ] recover ;
 
-: add-breakpoint ( quot -- quot' )
+GENERIC: add-breakpoint ( quot -- quot' )
+
+M: callable add-breakpoint
     dup [ break ] head? [ \ break prefix ] unless ;
 
+M: array add-breakpoint
+    [ add-breakpoint ] map ;
+
+M: object add-breakpoint ;
+
 : (step-into-quot) ( quot -- ) add-breakpoint call ;
 
 : (step-into-if) ? (step-into-quot) ;
@@ -74,7 +81,7 @@ DEFER: start-walker-thread
 \ (step-into-execute) t "step-into?" set-word-prop
 
 : (step-into-continuation)
-    continuation callstack over set-continuation-call break ;
+    continuation callstack >>call break ;
 
 ! Messages sent to walker thread
 SYMBOL: step
@@ -94,15 +101,18 @@ SYMBOL: +stopped+
 : change-frame ( continuation quot -- continuation' )
     #! Applies quot to innermost call frame of the
     #! continuation.
-    >r clone r>
-    over continuation-call clone
-    [
-        dup innermost-frame-scan 1+
-        swap innermost-frame-quot
-        rot call
-    ] keep
-    [ set-innermost-frame-quot ] keep
-    over set-continuation-call ; inline
+    >r clone r> [
+        >r clone r>
+        [
+            >r
+            [ innermost-frame-scan 1+ ]
+            [ innermost-frame-quot ] bi
+            r> call
+        ]
+        [ drop set-innermost-frame-quot ]
+        [ drop ]
+        2tri
+    ] curry change-call ; inline
 
 : step-msg ( continuation -- continuation' )
     [
@@ -143,6 +153,7 @@ SYMBOL: +stopped+
             swap % unclip {
                 { [ dup \ break eq? ] [ , ] }
                 { [ dup quotation? ] [ add-breakpoint , \ break , ] }
+                { [ dup array? ] [ add-breakpoint , \ break , ] }
                 { [ dup word? ] [ literalize , \ (step-into-execute) , ] }
                 { [ t ] [ , \ break , ] }
             } cond %
@@ -177,16 +188,17 @@ SYMBOL: +stopped+
                 { step-back [ f ] }
                 { f [ +stopped+ set-status f ] }
                 [
-                    dup walker-continuation tget set-model
-                    step-into-msg
+                    [ walker-continuation tget set-model ]
+                    [ step-into-msg ] bi
                 ]
             } case
         ] handle-synchronous
     ] [ ] while ;
 
 : step-back-msg ( continuation -- continuation' )
-    walker-history tget dup pop*
-    empty? [ drop walker-history tget pop ] unless ;
+    walker-history tget
+    [ pop* ]
+    [ dup empty? [ drop ] [ nip pop ] if ] bi ;
 
 : walker-suspended ( continuation -- continuation' )
     +suspended+ set-status