"Step back" feature in walker

library/continuations.factor

@@ -53,3 +53,10 @@ TUPLE: continuation data retain call name catch ;
 
 : continue-with ( obj continuation -- )
     swap 9 setenv continue ; inline
+
+M: continuation clone
+    [ continuation-data clone ] keep
+    [ continuation-retain clone ] keep
+    [ continuation-call clone ] keep
+    [ continuation-name clone ] keep
+    continuation-catch clone <continuation> ;

library/tools/interpreter.factor

@@ -2,11 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: interpreter
 USING: arrays errors generic io kernel kernel-internals math
-namespaces prettyprint sequences strings threads vectors words ;
+namespaces prettyprint sequences strings threads vectors words
+hashtables ;
 
-! A Factor interpreter written in Factor. It can transfer the
+! Metacircular interpreter for single-stepping
-! continuation to and from the primary interpreter. Used by
-! compiler for partial evaluation, also by the walker.
 
 SYMBOL: meta-interp
 
@@ -74,7 +73,7 @@ SYMBOL: callframe-end
     save-callframe (meta-call) ;
 
 : <callframe> ( quot -- seq )
-    0 over length 3array ;
+    0 over length 3array >vector ;
 
 : catch-harness ( continuation -- quot )
     [ [ c> 2array ] % , \ continue-with , ] [ ] make ;
@@ -138,17 +137,45 @@ M: object do do-1 ;
 \ if [ pop-d pop-d pop-d [ nip ] [ drop ] if meta-call ] "meta-word" set-word-prop
 \ dispatch [ pop-d pop-d swap nth meta-call ] "meta-word" set-word-prop
 
-: step ( -- ) [ do-1 ] next ;
+! Time travel
+SYMBOL: meta-history
 
-: step-in ( -- ) [ do ] next ;
+: save-interp ( -- )
+    meta-history get [
+        [
+            callframe [ ] change
+            callframe-scan [ ] change
+            callframe-end [ ] change
+            meta-interp [ clone ] change
+        ] make-hash swap push
+    ] when* ;
+
+: restore-interp ( ns -- )
+    { callframe callframe-scan callframe-end }
+    [ dup pick hash swap set ] each
+    meta-interp swap hash clone meta-interp set ;
+
+: step ( -- ) save-interp [ do-1 ] next ;
+
+: step-in ( -- ) save-interp [ do ] next ;
 
 : step-out ( -- )
+    save-interp
     callframe get callframe-scan get tail
     host-quot [ ] (meta-call) ;
 
 : step-all ( -- )
+    save-interp
     save-callframe
-    meta-c [ V{ [ stop ] 0 1 } swap append ] change
+    [ stop ] <callframe> meta-c append
-    meta-interp get schedule-thread yield
+    meta-interp get [ set-continuation-call ] keep
-    V{ } clone meta-c set
+    schedule-thread yield
+    meta-c delete-all
     [ ] (meta-call) ;
+
+: step-back ( -- )
+    meta-history get dup empty? [
+        drop
+    ] [
+        pop restore-interp
+    ] if ;

library/ui/text/interactor.factor

@@ -62,7 +62,6 @@ SYMBOL: structured-input
 
 : interactor-history. ( interactor -- )
     dup interactor-output [
-        "History:" print
         interactor-history [ dup print-input ] each
     ] with-stream* ;
 
@@ -79,8 +78,8 @@ SYMBOL: structured-input
 
 interactor H{
     { T{ key-down f f "RETURN" } [ interactor-commit ] }
+    { T{ key-down f { A+ } "c" } [ dup [ interactor-output pane-clear ] curry swap interactor-call ] }
     { T{ key-down f { C+ } "h" } [ dup [ interactor-history. ] curry swap interactor-call ] }
-    { T{ key-down f { C+ } "b" } [ dup [ interactor-output pane-clear ] curry swap interactor-call ] }
     { T{ key-down f { C+ } "d" } [ f swap interactor-eval ] }
     { T{ key-down f { C+ } "i" } [ "infer ." quot-action ] }
     { T{ key-down f { C+ } "w" } [ "walk" quot-action ] }

library/ui/tools/walker.factor

@@ -46,23 +46,24 @@ TUPLE: walker-gadget track ds rs cs quot ns ;
     meta-c over walker-gadget-cs set-model
     meta-callframe swap walker-gadget-quot set-model ;
 
-: with-walker ( walker quot -- )
+: with-walker ( gadget quot -- )
-    swap dup walker-gadget-ns
+    swap find-walker-gadget
+    dup walker-gadget-ns
     [ slip update-stacks ] bind ; inline
 
-: walker-command ( button word -- )
+: walker-step [ step ] with-walker ;
-    >r find-walker-gadget r> unit with-walker ;
+: walker-step-in [ step-in ] with-walker ;
+: walker-step-out [ step-out ] with-walker ;
+: walker-step-all [ step-all ] with-walker ;
+: walker-step-back [ step-back ] with-walker ;
 
 : <walker-toolbar> ( -- gadget )
-    {
-        { "Step" step }
-        { "Step in" step-in }
-        { "Step out" step-out }
-        { "Continue" step-all }
-    } [
     [
-            first2 [ walker-command ] curry <bevel-button> ,
+        "Step" [ walker-step ] <bevel-button> , 
-        ] each
+        "Step in" [ walker-step-in ] <bevel-button> , 
+        "Step out" [ walker-step-out ] <bevel-button> , 
+        "Continue" [ walker-step-all ] <bevel-button> , 
+        "Step back" [ walker-step-back ] <bevel-button> , 
     ] make-toolbar ;
 
 : init-walker-models ( walker -- )
@@ -98,6 +99,7 @@ M: walker-gadget focusable-child*
 : init-walker ( walker -- )
     H{ } clone over set-walker-gadget-ns
     walker-continuation swap [
+        V{ } clone meta-history set
         meta-interp set
         [ ] (meta-call)
     ] with-walker ;
@@ -128,10 +130,11 @@ C: walker-gadget ( -- gadget )
     dup walker-thread ;
 
 \ walker-gadget H{
-    { T{ key-down f { C+ } "s" } [ \ step walker-command ] }
+    { T{ key-down f { C+ } "s" } [ walker-step ] }
-    { T{ key-down f { C+ } "n" } [ \ step-in walker-command ] }
+    { T{ key-down f { C+ } "n" } [ walker-step-in ] }
-    { T{ key-down f { C+ } "o" } [ \ step-out walker-command ] }
+    { T{ key-down f { C+ } "o" } [ walker-step-out ] }
-    { T{ key-down f { C+ } "l" } [ \ step-all walker-command ] }
+    { T{ key-down f { C+ } "r" } [ walker-step-all ] }
+    { T{ key-down f { C+ } "b" } [ walker-step-back ] }
 } set-gestures
 
 : walker-tool