Move some low-level interpreter words to continuations

core/continuations/continuations-docs.factor

@@ -102,24 +102,6 @@ HELP: callcc1
 { $values { "quot" "a quotation with stack effect " { $snippet "( continuation -- )" } } { "obj" "an object provided when resuming the continuation" } }
 { $description "Applies the quotation to the current continuation, which is reified from the point immediately after which the caller returns. The " { $link continue-with } " word resumes the continuation, passing a value back to the original execution context." } ;
 
-HELP: set-walker-hook
-{ $values { "quot" "a quotation with stack effect " { $snippet "( continuation -- )" } ", or " { $link f } } }
-{ $description "Sets a quotation to be called when a continuation is resumed." }
-{ $notes "The single-stepper uses this hook to support single-stepping through code which makes use of continuations." } ;
-
-HELP: walker-hook
-{ $values { "quot" "a quotation with stack effect " { $snippet "( obj -- )" } ", or " { $link f } } }
-{ $description "Outputs a quotation to be called when a continuation is resumed, or " { $link f } " if no hook is set. If a hook was set prior to this word being called, it will be reset to " { $link f } "."
-$nl
-"The following words do not perform their usual action and instead just call the walker hook if one is set:"
-    { $list
-        { { $link callcc0 } " will call the hook, passing it the continuation to resume." }
-        { { $link callcc1 } " will call the hook, passing it a " { $snippet "{ obj continuation }" } " pair." }
-        { { $link stop } " will call the hook, passing it " { $link f } "." }
-    }
-"The walker hook must take appropriate action so that the callers of these words see the behavior that they expect." }
-{ $notes "The single-stepper uses this hook to support single-stepping through code which makes use of continuations." } ;
-
 HELP: (continue-with)
 { $values { "obj" "an object to pass to the continuation's execution context" } { "continuation" continuation } }
 { $description "Resumes a continuation reified by " { $link callcc1 } " without invoking " { $link walker-hook } ". The object will be placed on the data stack when the continuation resumes." } ;
@@ -214,3 +196,6 @@ $low-level-note ;
 
 HELP: init-error-handler
 { $description "Called on startup to initialize the catch stack and set a pair of hooks which allow the Factor VM to signal errors to library code." } ;
+
+HELP: break
+{ $description "Suspends execution of the current thread and starts the single stepper by calling " { $link break-hook } "." } ;

core/continuations/continuations.factor

@@ -20,9 +20,12 @@ SYMBOL: restarts
 : (catch) ( quot -- newquot )
     [ swap >c call c> drop ] curry ; inline
 
-: dummy
+: dummy ( -- obj )
-    #! Defeat an optimization.
+    #! Optimizing compiler assumes stack won't be messed with
-    f ;
+    #! in-transit. To ensure that a value is actually reified
+    #! on the stack, we put it in a non-inline word together
+    #! with a declaration.
+    f { object } declare ;
 
 PRIVATE>
 
@@ -70,12 +73,16 @@ C: <continuation> continuation
 
 : callcc1 ( quot -- obj ) [ ] ifcc ; inline
 
-: set-walker-hook ( quot -- ) 3 setenv ; inline
-
-: walker-hook ( -- quot ) 3 getenv f set-walker-hook ; inline
-
 <PRIVATE
 
+: (continue) ( continuation -- )
+    >continuation<
+    set-catchstack
+    set-namestack
+    set-retainstack
+    >r set-datastack r>
+    set-callstack ;
+
 : (continue-with) ( obj continuation -- )
     swap 4 setenv
     >continuation<
@@ -87,6 +94,10 @@ C: <continuation> continuation
 
 PRIVATE>
 
+: set-walker-hook ( quot -- ) 3 setenv ; inline
+
+: walker-hook ( -- quot ) 3 getenv f set-walker-hook ; inline
+
 : continue-with ( obj continuation -- )
     [
         walker-hook [ >r 2array r> ] when* (continue-with)
@@ -170,3 +181,19 @@ M: condition compute-restarts
     "kernel-error" 6 setenv ;
 
 PRIVATE>
+
+! Debugging support
+: with-walker-hook ( continuation -- )
+    [ swap set-walker-hook (continue) ] curry callcc1 ;
+
+SYMBOL: break-hook
+
+: break ( -- )
+    continuation callstack
+    over set-continuation-call
+    walker-hook [ (continue-with) ] [ break-hook get call ] if* ;
+
+GENERIC: (step-into) ( obj -- )
+
+M: wrapper (step-into) wrapped break ;
+M: object (step-into) break ;

extra/tools/interpreter/interpreter-docs.factor

@@ -24,9 +24,6 @@ ABOUT: "meta-interpreter"
 HELP: interpreter
 { $class-description "An interpreter instance." } ;
 
-HELP: break
-{ $description "Suspends execution of the current thread and starts the single stepper by calling " { $link break-hook } "." } ;
-
 HELP: step
 { $values { "interpreter" interpreter } }
 { $description "Evaluates the object in the single stepper using Factor evaluation semantics:"

extra/tools/interpreter/interpreter-tests.factor

@@ -1,9 +1,29 @@
 USING: tools.interpreter io io.streams.string kernel math
 math.private namespaces prettyprint sequences tools.test
 continuations math.parser threads arrays
-tools.interpreter.debug ;
+tools.interpreter.private tools.interpreter.debug ;
 IN: temporary
 
+[ [ + ] ] [
+    [ \ + (step-into) ] (remove-breakpoints)
+] unit-test
+
+[ [ (step-into) ] ] [
+    [ (step-into) ] (remove-breakpoints)
+] unit-test
+
+[ [ 3 ] ] [
+    [ 3 (step-into) ] (remove-breakpoints)
+] unit-test
+
+[ [ 2 2 + . ] ] [
+    [ 2 2 \ + (step-into) . ] (remove-breakpoints)
+] unit-test
+
+[ [ 2 2 + . ] ] [
+    [ 2 break 2 \ + (step-into) . ] (remove-breakpoints)
+] unit-test
+
 [ "Ooops" throw ] break-hook set
 
 [ { } ] [

extra/tools/interpreter/interpreter.factor

@@ -10,13 +10,6 @@ TUPLE: interpreter continuation ;
 
 : <interpreter> interpreter construct-empty ;
 
-SYMBOL: break-hook
-
-: break ( -- )
-    continuation callstack
-    over set-continuation-call
-    walker-hook [ continue-with ] [ break-hook get call ] if* ;
-
 GENERIC# restore 1 ( obj interpreter -- )
 
 M: f restore
@@ -58,6 +51,8 @@ M: pair restore
 : (step-into-continuation)
     continuation callstack over set-continuation-call break ;
 
+M: word (step-into) (step-into-execute) ;
+
 {
     { call [ (step-into-call) ] }
     { (throw) [ (step-into-call) ] }
@@ -76,14 +71,6 @@ M: pair restore
     "step-into" set-word-prop
 ] each
 
-: (continue) ( continuation -- )
-    >continuation<
-    set-catchstack
-    set-namestack
-    set-retainstack
-    >r set-datastack r>
-    set-callstack ;
-
 ! Stepping
 : change-innermost-frame ( quot interpreter -- )
     interpreter-continuation [
@@ -99,16 +86,8 @@ M: pair restore
 : (step) ( interpreter quot -- )
     swap
     [ change-innermost-frame ] keep
-    [
+    [ interpreter-continuation with-walker-hook ] keep
-        set-walker-hook
+    restore ;
-        interpreter-continuation (continue)
-    ] callcc1 swap restore ;
-
-GENERIC: (step-into) ( obj -- )
-
-M: word (step-into) (step-into-execute) ;
-M: wrapper (step-into) wrapped break ;
-M: object (step-into) break ;
 
 PRIVATE>