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

Walker improvement

slava 2006-09-07 21:25:54 +00:00
parent 5a75f752b5
commit 9cbfa5dcff
4 changed files with 30 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
library/collections/sequences-epilogue.facts
View File

@ -196,6 +196,10 @@ HELP: last/first
{ $values { "seq" "a sequence" } { "pair" "a two-element array" } }
{ $description "Creates an array holding the first and last element of the sequence." } ;
HELP: padding
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "elt" "an object"} { "padded" "a new sequence" } }
{ $description "Outputs a new string sequence of " { $snippet "elt" } " repeated, that when appended to " { $snippet "seq" } ", yields a sequence of length " { $snippet "n" } ". If the length of { " { $snippet "seq" } " is greater than " { $snippet "n" } ", this word outputs an empty sequence." } ;
HELP: pad-left
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "elt" "an object"} { "padded" "a new sequence" } }
{ $description "Outputs a new sequence consisting of " { $snippet "seq" } " padded on the left with enough repetitions of " { $snippet "elt" } " to have the result be of length " { $snippet "n" } "." }

4
library/collections/strings.facts
View File

@ -62,10 +62,6 @@ HELP: >upper
{ $values { "str" "a string" } { "upper" "a string" } }
{ $description "Converts a string to uppercase." } ;
HELP: padding
{ $values { "str" "a string" } { "n" "a non-negative integer" } { "ch" "a character"} { "padstr" "a new string" } }
{ $description "Outputs a new string consisting of " { $snippet "ch" } " repeated, that when appended to " { $snippet "str" } ", yields a string of length " { $snippet "n" } ". If the length of { " { $snippet "str" } " is greater than " { $snippet "n" } ", this word outputs the empty string." } ;
HELP: ch>string
{ $values { "ch" "a character"} { "str" "a new string" } }
{ $description "Outputs a string of one character." } ;

28
library/ui/tools/walker.factor
View File

@ -19,14 +19,6 @@ namespaces sequences shells threads vectors ;
[ [ continuation-retain stack. ] when* ]
"Retain stack" <labelled-pane> ;
: <namestack-display> ( model -- )
[ [ continuation-name stack. ] when* ]
"Name stack" <labelled-pane> ;
: <catchstack-display> ( model -- )
[ [ continuation-catch stack. ] when* ]
"Catch stack" <labelled-pane> ;
: <quotation-display> ( quot -- gadget )
[ [ first2 callframe. ] when* ]
"Current quotation" <labelled-pane> ;
@ -53,18 +45,6 @@ TUPLE: walker-gadget model quot ns ;
: walker-step-in [ step-in ] walker-command ;
: walker-step-out [ step-out ] walker-command ;
: walker-step-back [ step-back ] walker-command ;
: walker-step-all dup [ step-all ] walker-command reset-walker ;
walker-gadget {
{
"Walker"
{ "Step" T{ key-down f f "s" } [ walker-step ] }
{ "Step in" T{ key-down f f "i" } [ walker-step-in ] }
{ "Step out" T{ key-down f f "o" } [ walker-step-out ] }
{ "Step back" T{ key-down f f "b" } [ walker-step-back ] }
{ "Continue" T{ key-down f f "c" } [ walker-step-all ] }
}
} define-commands
: init-walker-models ( walker -- model quot )
f <model> over set-walker-gadget-quot
@ -83,9 +63,7 @@ walker-gadget {
C: walker-gadget ( -- gadget )
dup init-walker-models {
{ [ walker-gadget-quot$ <quotation-display> ] f f 1/6 }
{ [ walker-gadget-model$ <callstack-display> ] f f 1/6 }
{ [ walker-gadget-model$ <datastack-display> ] f f 1/6 }
{ [ walker-gadget-model$ <retainstack-display> ] f f 1/6 }
{ [ walker-gadget-model$ <namestack-display> ] f f 1/6 }
{ [ walker-gadget-model$ <catchstack-display> ] f f 1/6 }
{ [ walker-gadget-model$ <callstack-display> ] f f 5/18 }
{ [ walker-gadget-model$ <datastack-display> ] f f 5/18 }
{ [ walker-gadget-model$ <retainstack-display> ] f f 5/18 }
} { 0 1 } make-track* ;

24
library/ui/tools/workspace.factor
View File

@ -6,7 +6,7 @@ gadgets-browser gadgets-books gadgets-frames gadgets-controls
gadgets-grids gadgets-presentations kernel models namespaces
styles words help parser tools memory generic threads
gadgets-text definitions inference test prettyprint math strings
hashtables tools modules ;
hashtables tools modules interpreter ;
IN: gadgets-workspace
GENERIC: call-tool* ( arg tool -- )
@ -103,6 +103,28 @@ workspace {
M: walker-gadget call-tool* ( arg tool -- )
>r first2 r> (walk) ;
IN: gadgets-walker
: walker-inspect ( walker -- )
walker-gadget-ns [ meta-interp get ] bind
[ inspect ] curry listener-gadget call-tool ;
: walker-step-all ( walker -- )
dup [ step-all ] walker-command reset-walker
find-workspace listener-gadget select-tool ;
walker-gadget {
{
"Walker"
{ "Step" T{ key-down f f "s" } [ walker-step ] }
{ "Step in" T{ key-down f f "i" } [ walker-step-in ] }
{ "Step out" T{ key-down f f "o" } [ walker-step-out ] }
{ "Step back" T{ key-down f f "b" } [ walker-step-back ] }
{ "Continue" T{ key-down f f "c" } [ walker-step-all ] }
{ "Inspect" T{ key-down f f "n" } [ walker-inspect ] }
}
} define-commands
IN: tools
: walk ( quot -- )