Move some low-level interpreter words to continuations
Slava Pestov
parent
ac9ee43702
commit
c8042a0e72
|
|
@ -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 } "." } ;
|
||||
|
|
|
|||
|
|
@ -20,9 +20,12 @@ SYMBOL: restarts
|
|||
: (catch) ( quot -- newquot )
|
||||
[ swap >c call c> drop ] curry ; inline
|
||||
|
||||
: dummy
|
||||
#! Defeat an optimization.
|
||||
f ;
|
||||
: dummy ( -- obj )
|
||||
#! Optimizing compiler assumes stack won't be messed with
|
||||
#! 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 ;
|
||||
|
|
|
|||
|
|
@ -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:"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
[ { } ] [
|
||||
|
|
|
|||
|
|
@ -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
|
||||
[
|
||||
set-walker-hook
|
||||
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 ;
|
||||
[ interpreter-continuation with-walker-hook ] keep
|
||||
restore ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue