steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Clean up interpreter and walker

release
Slava Pestov 2007-10-04 18:45:19 -04:00
parent 849c83247d
commit deb1406f83
8 changed files with 128 additions and 175 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
extra/tools/interpreter/debug/debug.factor
View File

@ -1,18 +1,31 @@
! Copyright (C) 2004, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.interpreter namespaces kernel arrays continuations
threads sequences ;
USING: tools.interpreter kernel arrays continuations threads
sequences namespaces ;
IN: tools.interpreter.debug
: run-interpreter ( -- )
interpreter get [ step-into run-interpreter ] when ;
: run-interpreter ( interpreter -- )
dup interpreter-continuation [
dup step-into run-interpreter
] [
drop
] if ;
: init-interpreter ( quot -- )
: quot>cont ( quot -- cont )
[
"out" set
[ f swap 2array restore "out" get continue ] callcc0
] swap [ datastack "datastack" set stop ]
3append callcc0 ;
swap [
continue-with
] curry callcc0 call stop
] curry callcc1 ;
: init-interpreter ( quot interpreter -- )
>r
[ datastack "datastack" set ] compose quot>cont
f swap 2array
r> restore ;
: test-interpreter ( quot -- )
init-interpreter run-interpreter "datastack" get ;
<interpreter>
[ init-interpreter ] keep
run-interpreter
"datastack" get ;

42
extra/tools/interpreter/interpreter-docs.factor
View File

@ -2,7 +2,13 @@ USING: help.markup help.syntax kernel generic
math hashtables quotations classes continuations ;
IN: tools.interpreter
ARTICLE: "meta-interp-step" "Single-stepping words"
ARTICLE: "meta-interpreter" "Meta-circular interpreter"
"The meta-circular interpreter is used to implement the walker tool in the UI. If you are simply interested in single stepping through a piece of code, use the " { $link "ui-walker" } "."
$nl
"On the other hand, if you want to implement a similar tool yourself, then you can use the words described in this section."
$nl
"Meta-circular interpreter words are found in the " { $vocab-link "tools.interpreter" } " vocabulary."
$nl
"Breakpoints can be inserted in user code:"
{ $subsection break }
"Breakpoints invoke a hook:"
@ -13,40 +19,16 @@ ARTICLE: "meta-interp-step" "Single-stepping words"
{ $subsection step-out }
{ $subsection step-all } ;
ARTICLE: "meta-interp-travel" "Backwards time travel"
"Backwards time travel is implemented by capturing the continuation after every step. Since this consumes additional memory, it must be explicitly enabled by storing an empty vector into a variable:"
{ $subsection history }
"If this variable holds a vector, the interpreter state is automatically saved after every step. It can be saved at other points manually:"
{ $subsection save-interpreter }
"Or restore the most recently saved state:"
{ $subsection step-back } ;
ARTICLE: "meta-interpreter" "Meta-circular interpreter"
"The meta-circular interpreter is used to implement the walker tool in the UI. If you are simply interested in single stepping through a piece of code, use the " { $link "ui-walker" } "."
$nl
"On the other hand, if you want to implement a similar tool yourself, then you can use the words described in this section."
$nl
"Meta-circular interpreter words are found in the " { $vocab-link "tools.interpreter" } " vocabulary."
$nl
"The current interpreter state is stored in the " { $link interpreter } " variable."
{ $subsection "meta-interp-step" }
{ $subsection "meta-interp-travel" } ;
ABOUT: "meta-interpreter"
HELP: interpreter
{ $var-description "Variable holding a " { $link continuation } " instance for the single-stepper." } ;
{ $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: history
{ $var-description "A sequence of continuations, captured at every stage of single-stepping. Used by " { $link step-back } " to implement backwards time travel." } ;
HELP: save-interpreter
{ $description "Snapshots the single stepper state and saves it in " { $link history } "." } ;
HELP: step
{ $values { "interpreter" interpreter } }
{ $description "Evaluates the object in the single stepper using Factor evaluation semantics:"
{ $list
{ "If the object is a " { $link wrapper } ", then the wrapped object is pushed on the single stepper's data stack" }
@ -56,6 +38,7 @@ HELP: step
} ;
HELP: step-into
{ $values { "interpreter" interpreter } }
{ $description "Evaluates the object in the single stepper using Factor evaluation semantics:"
{ $list
{ "If the object is a " { $link wrapper } ", then the wrapped object is pushed on the single stepper's data stack" }
@ -66,10 +49,9 @@ HELP: step-into
} ;
HELP: step-out
{ $values { "interpreter" interpreter } }
{ $description "Evaluates the remainder of the current quotation in the single stepper." } ;
HELP: step-back
{ $description "Steps back to the most recently saved snapshot of the single stepper continuation in " { $link history } "." } ;
HELP: step-all
{ $values { "interpreter" interpreter } }
{ $description "Executes the remainder of the single stepper's continuation. This effectively ends single stepping unless the continuation invokes " { $link break } " at a later point in time." } ;

54
extra/tools/interpreter/interpreter-tests.factor
View File

@ -105,54 +105,6 @@ IN: temporary
[ [ { 1 2 3 } . ] string-out ] test-interpreter
] unit-test
: meta-catch interpreter get continuation-catch ;
! Step back test
! [
! init-interpreter
! V{ } clone meta-history set
!
! V{ f } clone
! V{ } clone
! V{ [ 1 2 3 ] 0 3 } clone
! V{ } clone
! V{ } clone
! f <continuation>
! meta-catch push
!
! [ ] [ [ 2 2 + throw ] (meta-call) ] unit-test
!
! [ ] [ step ] unit-test
!
! [ ] [ step ] unit-test
!
! [ { 2 2 } ] [ meta-d ] unit-test
!
! [ ] [ step ] unit-test
!
! [ { 4 } ] [ meta-d ] unit-test
! [ 3 ] [ callframe-scan get ] unit-test
!
! [ ] [ step-back ] unit-test
! [ 2 ] [ callframe-scan get ] unit-test
!
! [ { 2 2 } ] [ meta-d ] unit-test
!
! [ ] [ step ] unit-test
!
! [ [ 1 2 3 ] ] [ meta-catch peek continuation-call first ] unit-test
!
! [ ] [ step ] unit-test
!
! [ [ 1 2 3 ] ] [ callframe get ] unit-test
! [ ] [ step-back ] unit-test
!
! [ { 4 } ] [ meta-d ] unit-test
!
! [ [ 1 2 3 ] ] [ meta-catch peek continuation-call first ] unit-test
!
! [ ] [ step ] unit-test
!
! [ [ 1 2 3 ] ] [ callframe get ] unit-test
!
! ] with-scope
[ { } ] [
[ "a" "b" set "c" "d" set [ ] test-interpreter ] with-scope
] unit-test

101
extra/tools/interpreter/interpreter.factor
View File

@ -6,7 +6,9 @@ kernel.private math namespaces namespaces.private prettyprint
quotations sequences splitting strings threads vectors words ;
IN: tools.interpreter
SYMBOL: interpreter
TUPLE: interpreter continuation ;
: <interpreter> interpreter construct-empty ;
SYMBOL: break-hook
@ -15,22 +17,25 @@ SYMBOL: break-hook
over set-continuation-call
walker-hook [ continue-with ] [ break-hook get call ] if* ;
: with-interpreter-datastack ( quot -- )
interpreter get continuation-data
swap with-datastack
interpreter get set-continuation-data ; inline
GENERIC: restore ( obj -- )
M: continuation restore
clone interpreter set ;
M: pair restore
first2 clone interpreter set
[ nip f ] curry with-interpreter-datastack ;
GENERIC# restore 1 ( obj interpreter -- )
M: f restore
drop interpreter off ;
set-interpreter-continuation ;
M: continuation restore
>r clone r> set-interpreter-continuation ;
: with-interpreter-datastack ( quot interpreter -- )
interpreter-continuation [
continuation-data
swap with-datastack
] keep set-continuation-data ; inline
M: pair restore
>r first2 r> [ restore ] keep
>r [ nip f ] curry r> with-interpreter-datastack ;
<PRIVATE
: (step-into-call) \ break add* call ;
@ -71,19 +76,6 @@ M: f restore
"step-into" set-word-prop
] each
! Time travel
SYMBOL: history
: save-interpreter ( -- )
history get [ interpreter get clone swap push ] when* ;
: restore-interpreter ( interp -- )
clone interpreter set ;
: step-back ( -- )
history get dup empty?
[ drop ] [ pop restore-interpreter ] if ;
: (continue) ( continuation -- )
>continuation<
set-catchstack
@ -93,26 +85,34 @@ SYMBOL: history
set-callstack ;
! Stepping
: step-all ( -- )
[ interpreter get (continue) ] in-thread ;
: change-innermost-frame ( quot interpreter -- )
interpreter-continuation [
continuation-call clone
[
dup innermost-frame-scan 1+
swap innermost-frame-quot
rot call
] keep
[ set-innermost-frame-quot ] keep
] keep set-continuation-call ; inline
: change-innermost-frame ( quot -- )
interpreter get continuation-call clone
: (step) ( interpreter quot -- )
swap
[ change-innermost-frame ] keep
[
dup innermost-frame-scan 1+
swap innermost-frame-quot
rot call
] keep
[ set-innermost-frame-quot ] keep
interpreter get set-continuation-call ; inline
set-walker-hook
interpreter-continuation (continue)
] callcc1 swap restore ;
: (step) ( quot -- )
save-interpreter
change-innermost-frame
[ set-walker-hook interpreter get (continue) ] callcc1
restore ;
GENERIC: (step-into) ( obj -- )
: step ( n -- )
M: word (step-into) (step-into-execute) ;
M: wrapper (step-into) wrapped break ;
M: object (step-into) break ;
PRIVATE>
: step ( interpreter -- )
[
2dup nth \ break = [
nip
@ -121,18 +121,15 @@ SYMBOL: history
] if
] (step) ;
: step-out ( -- )
: step-out ( interpreter -- )
[ nip \ break add ] (step) ;
GENERIC: (step-into) ( obj -- )
M: word (step-into) (step-into-execute) ;
M: wrapper (step-into) wrapped break ;
M: object (step-into) break ;
: step-into ( -- )
: step-into ( interpreter -- )
[
cut [
swap % unclip literalize , \ (step-into) , %
] [ ] make
] (step) ;
: step-all ( interpreter -- )
interpreter-continuation [ (continue) ] curry in-thread ;

6
extra/ui/tools/tools-docs.factor
View File

@ -58,9 +58,9 @@ ARTICLE: "ui-walker" "UI walker"
"The walker single-steps through quotations. To use the walker, enter a piece of code in the listener's input area and press " { $operation walk } "."
$nl
"The walker can travel backwards through time, and restore stacks. This does not undo side effects and therefore can only be used reliably on referentially transparent code."
{ $command-map walker-gadget "toolbar" }
{ $command-map walker-gadget "other" }
"Walkers are instances of " { $link walker-gadget } "." ;
{ $command-map walker "toolbar" }
{ $command-map walker "other" }
"Walkers are instances of " { $link walker } "." ;
ARTICLE: "ui-profiler" "UI profiler"
"The graphical profiler is based on the terminal profiler (see " { $link "profiling" } ") and adds more convenient browsing of profiler results."

4
extra/ui/tools/tools.factor
View File

@ -17,7 +17,7 @@ IN: ui.tools
<stack-display>
<browser-gadget>
<inspector-gadget>
<walker-gadget>
<walker>
<profiler-gadget>
} ;
@ -65,7 +65,7 @@ M: workspace model-changed
: com-inspector inspector-gadget select-tool ;
: com-walker walker-gadget select-tool ;
: com-walker walker select-tool ;
: com-profiler profiler-gadget select-tool ;

4
extra/ui/tools/walker/walker-tests.factor
View File

@ -4,7 +4,7 @@ listener tools.test ui ui.gadgets ui.gadgets.worlds
ui.gadgets.packs vectors ui.tools ;
IN: temporary
[ ] [ <walker-gadget> "walker" set ] unit-test
[ ] [ <walker "walker" set ] unit-test
! Make sure the toolbar buttons don't throw if we're
! not actually walking.
@ -37,7 +37,7 @@ IN: temporary
[ t ] [ "ok" get ] unit-test
[ ] [ <walker-gadget> "w" set ] unit-test
[ ] [ <walker> "w" set ] unit-test
continuation "c" set
[ ] [ "c" get "w" get call-tool* ] unit-test

59
extra/ui/tools/walker/walker.factor
View File

@ -8,61 +8,70 @@ ui.gestures ui.gadgets.buttons ui.gadgets.panes
prettyprint.config prettyprint.backend ;
IN: ui.tools.walker
TUPLE: walker-gadget model ns ;
TUPLE: walker model interpreter history ;
: update-stacks ( walker -- )
interpreter get swap walker-gadget-model set-model ;
dup walker-interpreter interpreter-continuation
swap walker-model set-model ;
: with-walker ( gadget quot -- )
swap dup walker-gadget-ns [ slip update-stacks ] bind ;
inline
: with-walker ( walker quot -- )
over >r >r walker-interpreter r> call r>
update-stacks ; inline
: walker-active? ( walker -- ? )
interpreter swap walker-gadget-ns key? ;
walker-interpreter interpreter-continuation >boolean ;
: walker-command ( gadget quot -- )
over walker-active? [ with-walker ] [ 2drop ] if ; inline
: com-step [ step ] walker-command ;
: com-into [ step-into ] walker-command ;
: com-out [ step-out ] walker-command ;
: com-back [ step-back ] walker-command ;
: save-interpreter ( walker -- )
dup walker-interpreter interpreter-continuation clone
swap walker-history push ;
: init-walker-models ( walker -- )
f <model> over set-walker-gadget-model
H{ } clone swap set-walker-gadget-ns ;
: com-step ( walker -- )
dup save-interpreter [ step ] walker-command ;
: com-into ( walker -- )
dup save-interpreter [ step-into ] walker-command ;
: com-out ( walker -- )
dup save-interpreter [ step-out ] walker-command ;
: com-back ( walker -- )
dup walker-history
dup empty? [ drop ] [ pop swap call-tool* ] if ;
: reset-walker ( walker -- )
dup walker-gadget-ns clear-assoc
[ V{ } clone history set ] with-walker ;
<interpreter> over set-walker-interpreter
V{ } clone over set-walker-history
update-stacks ;
: <walker-gadget> ( -- gadget )
walker-gadget construct-empty
dup init-walker-models [
: <walker> ( -- gadget )
f <model> f f walker construct-boa [
toolbar,
g walker-gadget-model <traceback-gadget> 1 track,
g walker-model <traceback-gadget> 1 track,
] { 0 1 } build-track
dup reset-walker ;
M: walker-gadget call-tool* ( continuation walker -- )
M: walker call-tool* ( continuation walker -- )
[ restore ] with-walker ;
: com-inspect ( walker -- )
dup walker-active? [
interpreter swap walker-gadget-ns at
walker-interpreter interpreter-continuation
[ inspect ] curry call-listener
] [
drop
] if ;
: com-continue ( walker -- )
dup [ step-all ] walker-command reset-walker ;
dup walker-interpreter step-all reset-walker ;
: walker-help "ui-walker" help-window ;
\ walker-help H{ { +nullary+ t } } define-command
walker-gadget "toolbar" f {
walker "toolbar" f {
{ T{ key-down f { A+ } "s" } com-step }
{ T{ key-down f { A+ } "i" } com-into }
{ T{ key-down f { A+ } "o" } com-out }
@ -71,8 +80,8 @@ walker-gadget "toolbar" f {
{ T{ key-down f f "F1" } walker-help }
} define-command-map
walker-gadget "other" f {
walker "other" f {
{ T{ key-down f { A+ } "n" } com-inspect }
} define-command-map
[ walker-gadget call-tool stop ] break-hook set-global
[ walker call-tool stop ] break-hook set-global