Tool documentation

slava 2006-03-25 06:06:52 +00:00
parent 3f77d6eb65
commit 6a9e67a4bc
24 changed files with 335 additions and 114 deletions

View File

@ -24,6 +24,7 @@
- x11: - x11:
- title bars are funny - title bars are funny
- input methods - input methods
- wheel mouse test
- cocoa: - cocoa:
- global menu bar with useful commands - global menu bar with useful commands
- make the launchpad a palette - make the launchpad a palette

View File

@ -101,8 +101,6 @@ vectors words ;
"/library/tools/walker.factor" "/library/tools/walker.factor"
"/library/tools/annotations.factor" "/library/tools/annotations.factor"
"/library/tools/inspector.factor"
"/library/tools/components.factor"
"/library/test/test.factor" "/library/test/test.factor"
@ -211,12 +209,14 @@ vectors words ;
"/library/collections/flatten.facts" "/library/collections/flatten.facts"
"/library/collections/vectors.facts" "/library/collections/vectors.facts"
"/library/collections/virtual-sequences.facts" "/library/collections/virtual-sequences.facts"
"/library/compiler/compiler.facts"
"/library/generic/early-generic.facts" "/library/generic/early-generic.facts"
"/library/generic/generic.facts" "/library/generic/generic.facts"
"/library/generic/math-combination.facts" "/library/generic/math-combination.facts"
"/library/generic/slots.facts" "/library/generic/slots.facts"
"/library/generic/standard-combination.facts" "/library/generic/standard-combination.facts"
"/library/generic/tuple.facts" "/library/generic/tuple.facts"
"/library/inference/inference.facts"
"/library/io/binary.facts" "/library/io/binary.facts"
"/library/io/buffer.facts" "/library/io/buffer.facts"
"/library/io/c-streams.facts" "/library/io/c-streams.facts"
@ -246,7 +246,13 @@ vectors words ;
"/library/syntax/parse-syntax.facts" "/library/syntax/parse-syntax.facts"
"/library/syntax/prettyprint.facts" "/library/syntax/prettyprint.facts"
"/library/syntax/see.facts" "/library/syntax/see.facts"
"/library/test/test.facts"
"/library/tools/annotations.facts"
"/library/tools/debugger.facts" "/library/tools/debugger.facts"
"/library/tools/describe.facts"
"/library/tools/listener.facts"
"/library/tools/memory.facts"
"/library/tools/walker.facts"
"/doc/handbook/collections.facts" "/doc/handbook/collections.facts"
"/doc/handbook/dataflow.facts" "/doc/handbook/dataflow.facts"

View File

@ -27,9 +27,7 @@ sequences test words ;
: compile ( word -- ) : compile ( word -- )
[ postpone-word compile-postponed ] with-compiler ; [ postpone-word compile-postponed ] with-compiler ;
: compiled ( -- ) : compiled ( -- ) "compile" get [ word compile ] when ; parsing
#! Compile the most recently defined word.
"compile" get [ word compile ] when ; parsing
: try-compile ( word -- ) : try-compile ( word -- )
[ compile ] [ error. drop ] recover ; [ compile ] [ error. drop ] recover ;
@ -48,5 +46,3 @@ sequences test words ;
"compile" get [ dup compile ] when ; "compile" get [ dup compile ] when ;
: compile-1 ( quot -- ) compile-quot execute ; : compile-1 ( quot -- ) compile-quot execute ;
\ dataflow profile

View File

@ -0,0 +1,37 @@
IN: compiler
USING: help words ;
HELP: compile "( word -- )"
{ $values { "word" "a word" } }
{ $description "Compiles a word together with any uncompiled dependencies. Does nothing if the word is already compiled." }
{ $errors "If compilation fails, this word can throw an error. In particular, if the word's stack effect cannot be inferred (see " { $link "inference" } ", this word will throw an error. The related " { $link try-compile } " word logs errors and returns rather than throwing." } ;
HELP: compiled f
{ $description "Compiles the most recently defined word." }
{ $see word } ;
HELP: try-compile "( word -- )"
{ $values { "word" "a word" } }
{ $description "Compiles a word together with any uncompiled dependencies. Does nothing if the word is already compiled." }
{ $errors "If compilation fails, this word logs the error to the default stream and returns normally." } ;
HELP: compile-vocabs "( seq -- )"
{ $values { "seq" "a sequence of strings" } }
{ $description "Compiles all words in the vocabularies named by elements of a sequence, skipping compiled words. Compile errors are logged to the default stream." } ;
HELP: compile-all "( -- )"
{ $description "Compile all words in the dictionary which have not already been compiled. Compile errors are logged to the default stream." } ;
HELP: recompile "( word -- )"
{ $values { "word" "a word" } }
{ $description "Compiles a word, discarding a previous compiled definition first." } ;
HELP: compile-quot "( quot -- word )"
{ $values { "quot" "a quotation" } { "word" "a new, uninterned word" } }
{ $description "Creates a new uninterned word having the given quotation as its definition, and compiles it. The returned word can be passed to " { $link execute } "." }
{ $errors "Throws an error if the stack effect of the quotation cannot be inferred. See " { $link "inference" } "." } ;
HELP: compile-1 "( quot -- )"
{ $values { "quot" "a quotation" } }
{ $description "Compiles and runs a quotation." }
{ $errors "Throws an error if the stack effect of the quotation cannot be inferred. See " { $link "inference" } "." } ;

View File

@ -0,0 +1,7 @@
IN: inference
USING: help ;
HELP: infer "( quot -- effect )"
{ $values { "quot" "a quotation" } { "effect" "a pair of integers" } }
{ $description "Attempts to infer the quotation's stack effect, outputting a pair holding the correct of data stack inputs and outputs for the quotation." }
{ $errors "Throws an error if stack effect inference fails. See " { $link "inference" } "." } ;

View File

@ -18,8 +18,6 @@ M: assert summary drop "Assertion failed" ;
millis >r gc-time >r call gc-time r> - millis r> - ; millis >r gc-time >r call gc-time r> - millis r> - ;
: time ( code -- ) : time ( code -- )
#! Evaluates the given code and prints the time taken to
#! execute it.
benchmark benchmark
[ # " ms run / " % # " ms GC time" % ] "" make print flush ; [ # " ms run / " % # " ms GC time" % ] "" make print flush ;
@ -33,12 +31,10 @@ M: assert summary drop "Assertion failed" ;
] time ; ] time ;
: unit-test-fails ( quot -- ) : unit-test-fails ( quot -- )
#! Assert that the quotation throws an error.
[ f ] swap [ [ call t ] [ 2drop f ] recover ] [ f ] swap [ [ call t ] [ 2drop f ] recover ]
curry unit-test ; curry unit-test ;
: assert-depth ( quot -- ) : assert-depth ( quot -- ) depth slip depth assert= ;
depth slip depth assert= ;
SYMBOL: failures SYMBOL: failures

27
library/test/test.facts Normal file
View File

@ -0,0 +1,27 @@
IN: test
USING: help kernel ;
HELP: benchmark "( quot -- gctime runtime )"
{ $values { "quot" "a quotation" } { "gctime" "an integer denoting milliseconds" } { "runtime" "an integer denoting milliseconds" } }
{ $description "Runs a quotation, measuring the total wall clock time and the total time spent in the garbage collector." }
{ $notes "A nicer word for interactive use is " { $link time } "." } ;
HELP: time "( quot -- )"
{ $values { "quot" "a quotation" } }
{ $description "Runs a quotation and then prints the total run time and time spent in the garbage collector." }
{ $examples
{ $example "[ 1000000 0 [ + ] reduce drop ] time" "1116 ms run / 6 ms GC time" }
} ;
HELP: unit-test "( output input -- )"
{ $values { "output" "a sequence of expected stack elements" } { "input" "a quotation run with an empty stack" } }
{ $description "Runs a quotation with an empty stack, comparing the resulting stack with " { $snippet "output" } ". Elements are compared using " { $link = } ". Throws an error if the expected stack does not match the resulting stack." } ;
HELP: unit-test-fails "( quot -- )"
{ $values { "quot" "a quotation run with an empty stack" } }
{ $description "Runs a quotation with an empty stack, expecting it to throw an error. If the quotation throws an error, this word returns normally. If the quotation does not throw an error, this word " { $emphasis "does" } " raise an error." }
{ $notes "This word is used to test boundary conditions and fail-fast behavior." } ;
HELP: assert-depth "( quot -- )"
{ $values { "quot" "a quotation" } }
{ $description "Runs a quotation. Throws an error if the total number of elements on the stack is not the same before and after the quotation runs." } ;

View File

@ -1,12 +1,9 @@
! Copyright (C) 2005 Slava Pestov. ! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: words IN: words
USING: inspector io kernel lists math namespaces prettyprint USING: inspector io kernel lists math namespaces prettyprint
sequences strings walker ; sequences strings walker ;
! The annotation words let you flag a word for either tracing
! or single-stepping. Note that currently, words referring to
! annotated words cannot be compiled.
: annotate ( word quot -- | quot: word def -- def ) : annotate ( word quot -- | quot: word def -- def )
over >r >r dup word-def r> call r> swap define-compound ; over >r >r dup word-def r> call r> swap define-compound ;
inline inline
@ -21,17 +18,11 @@ sequences strings walker ;
, "===> Leaving: " , \ watch-msg , , "===> Leaving: " , \ watch-msg ,
] [ ] make ; ] [ ] make ;
: watch ( word -- ) : watch ( word -- ) [ (watch) ] annotate ;
#! Cause a message to be printed out when the word is
#! executed.
[ (watch) ] annotate ;
: break ( word -- ) : break ( word -- ) [ nip [ walk ] curry ] annotate ;
#! Cause the word to start the code walker when executed.
[ nip [ walk ] curry ] annotate ;
: break-on ( word test -- | test: -- ? ) : break-on ( word test -- | test: -- ? )
#! Conditional breakpoint.
swap [ swap [
nip [ swap % dup [ walk ] curry , , \ if , ] [ ] make nip [ swap % dup [ walk ] curry , , \ if , ] [ ] make
] annotate ; ] annotate ;
@ -41,6 +32,4 @@ sequences strings walker ;
inline inline
: profile ( word -- ) : profile ( word -- )
#! When the word is called, time it, and add the time to
#! the value in a global variable named by the word.
[ swap [ with-profile ] curry cons ] annotate ; [ swap [ with-profile ] curry cons ] annotate ;

View File

@ -0,0 +1,28 @@
IN: words
USING: help ;
HELP: annotate "( word quot -- )"
{ $values { "word" "a word" } { "quot" "a quotation with stack effect " { $snippet "( word def -- def )" } } }
{ $description "Changes a word definition to the result of applying a quotation to the old definition." }
{ $notes "This is the common word to implement " { $link watch } ", " { $link break } ", " { $link break-on } " and " { $link profile } "." } ;
HELP: watch "( word -- )"
{ $values { "word" "a word" } }
{ $description "Changes a word definition so that a message together with the stack contents is output before and after the word runs." } ;
HELP: break "( word -- )"
{ $values { "word" "a word" } }
{ $description "Changes a word definition so that it runs in the single-stepper." } ;
HELP: break-on "( word quot -- )"
{ $values { "word" "a word" } { "quot" "a quotation with stack effect " { $snippet "( -- ? )" } } }
{ $description "Changes a word definition so that the quotation runs first, and if it outputs a true value, the word runs in the single-stepper." } ;
HELP: profile "( word -- )"
{ $values { "word" "a word" } }
{ $description "Changes a word definition so that the total runtime is added to a variable keyed by the word in the global namespace." }
{ $examples
{ $example
": foo 1000000 [ drop ] each ;\n\\ foo profile\n\\ foo get ." "931"
}
} ;

View File

@ -1,21 +0,0 @@
IN: components
USING: hashtables help inspector kernel namespaces sequences
words ;
SYMBOL: components
H{ } clone components set-global
: get-components ( class -- assoc )
components get-global hash [ { } ] unless*
{ "Slots" [ describe ] } add ;
{
{ "Definition" [ help ] }
{ "Calls in" [ usage. ] }
{ "Calls out" [ uses. ] }
} \ word components get-global set-hash
{
{ "Documentation" [ help ] }
} \ link components get-global set-hash

View File

@ -18,6 +18,14 @@ HELP: :get "( variable -- value )"
{ $values { "variable" "an object" } { "value" "the value, or f" } } { $values { "variable" "an object" } { "value" "the value, or f" } }
{ $description "Looks up the value of a variable at the time of the most recent error." } ; { $description "Looks up the value of a variable at the time of the most recent error." } ;
HELP: error. "( error -- )"
{ $values { "error" "an error" } }
{ $contract "Print an error to the default stream." } ;
HELP: print-error "( error -- )"
{ $values { "error" "an error" } }
{ $description "Print an error to the default stream. This word gets called by the listener and other tools which report caught errors to the user. You can define methods on this generic word for custom error reporting." } ;
HELP: try "( quot -- )" HELP: try "( quot -- )"
{ $values { "quot" "a quotation" } } { $values { "quot" "a quotation" } }
{ $description "Calls the quotation. If it throws an error, logs the error to the default stream and restores the datastack." } ; { $description "Calls the quotation. If it throws an error, logs the error to the default stream and restores the datastack." } ;

View File

@ -96,20 +96,13 @@ DEFER: describe
: words. ( vocab -- ) : words. ( vocab -- )
words natural-sort [ (help) ] sequence-outliner ; words natural-sort [ (help) ] sequence-outliner ;
: vocabs. ( -- ) : vocabs. ( -- ) vocabs [ words. ] sequence-outliner ;
#! Outlining word browser.
vocabs [ words. ] sequence-outliner ;
: usage. ( word -- ) : usage. ( word -- ) usage [ usage. ] sequence-outliner ;
#! Outlining usages browser.
usage [ usage. ] sequence-outliner ;
: uses. ( word -- ) : uses. ( word -- ) uses [ uses. ] sequence-outliner ;
#! Outlining call hierarchy browser.
uses [ uses. ] sequence-outliner ;
: stack. ( seq -- seq ) : stack. ( seq -- seq ) reverse-slice >array describe ;
reverse-slice >array describe ;
: .s datastack stack. ; : .s datastack stack. ;
: .r callstack stack. ; : .r callstack stack. ;

View File

@ -0,0 +1,55 @@
IN: inspector
USING: help io prettyprint words ;
HELP: summary "( object -- string )"
{ $values { "object" "an object" } { "string" "a string" } }
{ $contract "Outputs a brief description of the object." } ;
HELP: sheet "( object -- sheet )"
{ $values { "object" "an object" } { "sheet" "a sequence of sequences" } }
{ $contract "Outputs a representation of the object for the " { $link describe } " word, which is a table where each row corresponds to an object slot, and consists of a number of columns, presumably including the slot name and value." } ;
HELP: slot-sheet "( object -- sheet )"
{ $values { "object" "an object" } { "sheet" "a sequence of sequences" } }
{ $description "Outputs a table of object slot names and values. This is used by the default implementation of " { $link sheet } "." } ;
HELP: describe "( object -- )"
{ $values { "object" "an object" } }
{ $description "Print a tabular overview of the object, featuring expanding outliners of the default stream supports them (for example, in the Factor UI)."
"For sequences and hashtables, this outputs the entries of the collection. For all other object types, slot names and values are shown." }
{ $notes "Slot values are converted to strings using " { $link unparse-short } "." } ;
HELP: sequence-outliner "( seq quot -- )"
{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( object -- )" } } }
{ $description "Prints an expanding outliner to the default stream. The sequence elements are converted to strings using " { $link unparse-short } ", and each element is output on its own row. Expanding a row outliner applies the quotation to the object; the quotation should print output to the default stream to elaborate the object." }
{ $notes "For a lower-level outliner output facility, use " { $link simple-outliner } " or " { $link write-outliner } "." } ;
HELP: words. "( vocab -- )"
{ $values { "vocab" "a string naming a vocabulary" } }
{ $description "Prints an outliner listing all words in a vocabulary. Expanding a row shows the word documentation and definition using " { $link help } "." }
{ $see-also words } ;
HELP: vocabs. "( -- )"
{ $description "Prints an outliner listing all vocabularies. Expanding a row lists the words in that vocabulary using " { $link words. } "." }
{ $see-also vocabs } ;
HELP: usage. "( word -- )"
{ $values { "word" "a word" } }
{ $description "Prints an outliner listing all callers of a word. This may include the word itself, if it is recursive." }
{ $see-also usage usages } ;
HELP: uses. "( word -- )"
{ $values { "word" "a word" } }
{ $description "Prints an outliner listing all words called by a word. This may include the word itself, if it is recursive." }
{ $see-also uses } ;
HELP: stack. "( seq -- )"
{ $values { "seq" "a sequence" } }
{ $description "Prints an outliner listing elements of a sequence in reverse order. Elements are coverted to strings using " { $link unparse-short } "." }
{ $notes "This word is used in the implementation of " { $link .s } " and " { $link .r } "." } ;
HELP: .s "( -- )"
{ $description "Displays the contents of the data stack, with the top of the stack printed first." } ;
HELP: .r "( -- )"
{ $description "Displays the contents of the return stack, with the top of the stack printed first." } ;

View File

@ -4,8 +4,9 @@ IN: interpreter
USING: errors generic io kernel kernel-internals lists math USING: errors generic io kernel kernel-internals lists math
namespaces prettyprint sequences strings vectors words ; namespaces prettyprint sequences strings vectors words ;
! A Factor interpreter written in Factor. Used by compiler for ! A Factor interpreter written in Factor. It can transfer the
! partial evaluation, also by the walker. ! continuation to and from the primary interpreter. Used by
! compiler for partial evaluation, also by the walker.
! Meta-stacks ! Meta-stacks
SYMBOL: meta-r SYMBOL: meta-r

View File

@ -12,12 +12,9 @@ SYMBOL: datastack-hook
" " listener-prompt set-global " " listener-prompt set-global
: bye ( -- ) : bye ( -- ) quit-flag on ;
#! Exit the current listener.
quit-flag on ;
: (read-multiline) ( quot depth -- quot ? ) : (read-multiline) ( quot depth -- quot ? )
#! Flag indicates EOF.
>r readln dup [ >r readln dup [
(parse) depth r> dup >r <= [ (parse) depth r> dup >r <= [
( we're done ) r> drop t ( we're done ) r> drop t
@ -29,12 +26,9 @@ SYMBOL: datastack-hook
] if ; ] if ;
: read-multiline ( -- quot ? ) : read-multiline ( -- quot ? )
#! Keep parsing until the end is reached. Flag indicates
#! EOF.
[ f depth (read-multiline) >r reverse r> ] with-parser ; [ f depth (read-multiline) >r reverse r> ] with-parser ;
: listen ( -- ) : listen ( -- )
#! Wait for user input, and execute.
listener-hook get call listener-hook get call
listener-prompt get write flush listener-prompt get write flush
[ read-multiline [ call ] [ bye ] if ] try ; [ read-multiline [ call ] [ bye ] if ] try ;
@ -43,9 +37,6 @@ SYMBOL: datastack-hook
quit-flag get [ quit-flag off ] [ listen (listener) ] if ; quit-flag get [ quit-flag off ] [ listen (listener) ] if ;
: listener ( -- ) : listener ( -- )
#! Run a listener loop that executes user input. We start
#! the listener in a new scope and copy the vocabulary
#! search path.
[ [
use [ clone ] change use [ clone ] change
[ datastack ] datastack-hook set [ datastack ] datastack-hook set

View File

@ -0,0 +1,38 @@
IN: listener
USING: help kernel ;
HELP: listener-prompt f
{ $description "Variable holding a string printed before each line of input read by the listener." } ;
HELP: quit-flag f
{ $description "Variable set to true by " { $link bye } " word; it forces the next iteration of the " { $link (listener) } " loop to end." } ;
HELP: listener-hook f
{ $description "Variable holding a quotation called by the listener before reading each line of input. The UI sets this variable to a quotation which updates the stack display in a listener gadget." } ;
HELP: datastack-hook f
{ $description "Variable holding a quotation called by the UI to produce the elements of the data stack display. Initially, this quotation simply calls " { $link datastack } ", however the single-stepper overrides it to show the stepper data stack instead." } ;
HELP: bye "( -- )"
{ $description "Terminates the innermost listener loop, returning to its caller." } ;
HELP: (read-multiline) "( quot depth -- newquot ? )"
{ $values { "quot" "the quotation being parsed" } { "depth" "the initial parsing stack depth" } { "newquot" "the quotation being parsed, after another line of input" } { "?" "a flag indicating end of input" } }
{ $description "Internal word used to read multiline expressions." } ;
HELP: read-multiline "( -- quot ? )"
{ $values { "quot" "a parsed quotation" } { "?" "a flag indicating end of file" } }
{ $description "Reads a Factor expression from the default stream, possibly spanning more than line. Additional lines of input are read while the parser stack height is greater than one. Since structural parsing words push partial quotations on the stack, this will keep on reading input until all delimited parsing words are terminated." } ;
HELP: listen "( -- )"
{ $description "Prompts for an expression on the default stream and evaluates it. On end of file, " { $link quit-flag } " is set to terminate the listener loop." }
{ $errors "If the expression input by the user throws an error, the error is printed to the default stream and the word returns normally." } ;
HELP: (listener) "( -- )"
{ $description "Prompts for expressions on the default stream and evaluates them until end of file is reached. This is an internal word; call " { $link listener } " instead." } ;
HELP: listener "( -- )"
{ $description "Starts a listener prompting for expressions on the default stream." } ;
HELP: print-banner "( -- )"
{ $description "Print Factor version, operating system, and CPU architecture." } ;

View File

@ -1,5 +1,5 @@
! Copyright (C) 2004, 2005 Slava Pestov. ! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: memory IN: memory
USING: arrays errors generic hashtables io kernel USING: arrays errors generic hashtables io kernel
kernel-internals lists math namespaces parser prettyprint kernel-internals lists math namespaces parser prettyprint
@ -9,13 +9,9 @@ sequences strings vectors words ;
: full-gc ( -- ) generations 1 - gc ; : full-gc ( -- ) generations 1 - gc ;
: image ( -- path ) : image ( -- path ) 16 getenv ;
#! Current image name.
16 getenv ;
: save : save ( -- ) image save-image ;
#! Save the current image.
image save-image ;
! Printing an overview of heap usage. ! Printing an overview of heap usage.
@ -47,7 +43,6 @@ sequences strings vectors words ;
[ swap [ call ] keep (each-object) ] [ 2drop ] if ; inline [ swap [ call ] keep (each-object) ] [ 2drop ] if ; inline
: each-object ( quot -- ) : each-object ( quot -- )
#! Applies the quotation to each object in the image.
[ begin-scan [ (each-object) ] keep ] [ begin-scan [ (each-object) ] keep ]
[ end-scan ] cleanup drop ; inline [ end-scan ] cleanup drop ; inline
@ -55,8 +50,6 @@ sequences strings vectors words ;
>r over >r call [ r> r> push ] [ r> r> 2drop ] if ; inline >r over >r call [ r> r> push ] [ r> r> 2drop ] if ; inline
: instances ( quot -- seq ) : instances ( quot -- seq )
#! Return a vector of all objects that return true when the
#! quotation is applied to them.
10000 <vector> [ 10000 <vector> [
-rot [ (instances) ] 2keep -rot [ (instances) ] 2keep
] each-object nip ; inline ] each-object nip ; inline
@ -75,9 +68,6 @@ M: object each-slot ( obj quot -- )
f swap [ pick eq? or ] each-slot nip ; f swap [ pick eq? or ] each-slot nip ;
: references ( obj -- list ) : references ( obj -- list )
#! Return a list of all objects that refer to a given object
#! in the image. If only one reference exists, find
#! something referencing that, and so on.
[ dupd refers? ] instances nip ; [ dupd refers? ] instances nip ;
: hash+ ( n key hash -- ) : hash+ ( n key hash -- )
@ -98,7 +88,6 @@ M: object each-slot ( obj quot -- )
pprint " instances" print ; pprint " instances" print ;
: heap-stats. ( -- ) : heap-stats. ( -- )
#! Print heap allocation breakdown.
heap-stats dup hash-keys natural-sort [ heap-stats dup hash-keys natural-sort [
( hash hash key -- ) ( hash hash key -- )
[ [ pick hash ] keep pick hash ] keep heap-stat. [ [ pick hash ] keep pick hash ] keep heap-stat.

View File

@ -0,0 +1,49 @@
IN: memory
USING: help ;
HELP: generations "( -- n )"
{ $values { "n" "a positive integer" } }
{ $description "Outputs the number of generations partitioning the heap." } ;
HELP: full-gc "( -- )"
{ $description "Performs a full garbage collection." } ;
HELP: image "( -- path )"
{ $values { "path" "a path name string" } }
{ $description "Outputs the path name of the currently running Factor image." } ;
HELP: save "( -- )"
{ $description "Saves a snapshot of the heap to the current image file." } ;
HELP: room. "( -- )"
{ $description "Prints an overview of memory usage broken down by generation and zone." } ;
HELP: each-object "( quot -- )"
{ $values { "quot" "a quotation with stack effect " { $snippet "( obj -- )" } } }
{ $description "Applies a quotation to each object in the heap. The garbage collector is switched off while this combinator runs, so the given quotation must not allocate too much memory." }
{ $notes "This word is the low-level facility used to implement the " { $link instances } ", " { $link references } " and " { $link heap-stats. } " words." } ;
HELP: instances "( quot -- seq )"
{ $values { "quot" "a quotation with stack effect " { $snippet "( obj -- ? )" } } { "seq" "a fresh sequence" } }
{ $description "Outputs a sequence of all objects in the heap which satisfy the quotation." }
{ $notes "This word relies on " { $link each-object } ", so in particular the garbage collector is switched off while it runs and the given quotation must not allocate too much memory." } ;
HELP: each-slot "( obj quot -- )"
{ $values { "obj" "an object" } { "quot" "a quotation with stack effect " { $snippet "( slot -- )" } } }
{ $description "Applies a quotation to the value of each one of an object's slots." } ;
HELP: refers? "( obj1 obj2 -- ? )"
{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } }
{ $description "Tests if any one of " { $snippet "obj2" } "'s slots point to " { $link "obj1" } "." } ;
HELP: references "( obj -- seq )"
{ $values { "obj" "an object" } { "seq" "a fresh sequence" } }
{ $description "Outputs a sequence of all objects in the heap which refer to the given object via one of their slots." }
{ $notes "The output sequence sometimes refers to temporary objects created by the execution of the " { $link references } " word itself." } ;
HELP: heap-stats "( -- counts sizes )"
{ $values { "counts" "a hashtable mapping class words to integers" } { "sizes" "a hashtable mapping class words to integers" } }
{ $description "Outputs a pair of hashtables, holding class instance counts and instance memory usage, respectively." } ;
HELP: heap-stats. "( -- )"
{ $description "For each class, prints the number of instances and total memory consumed by those instances." } ;

View File

@ -5,41 +5,22 @@ USING: errors hashtables inspector interpreter io kernel
listener lists math namespaces prettyprint sequences strings listener lists math namespaces prettyprint sequences strings
vectors words ; vectors words ;
! The single-stepper simulates Factor in Factor to allow : &s ( -- ) meta-d get stack. ;
! single-stepping through the execution of a quotation. It can
! transfer the continuation to and from the primary interpreter.
: &s
#! Print stepper data stack.
meta-d get stack. ;
: meta-r* : meta-r*
#! Stepper call stack, as well as the currently
#! executing quotation.
[ meta-r get % meta-executing get , meta-cf get , ] { } make ; [ meta-r get % meta-executing get , meta-cf get , ] { } make ;
: &r : &r ( -- ) meta-r* stack. ;
#! Print stepper call stack, as well as the currently
#! executing quotation.
meta-r* stack. ;
: &get ( var -- value ) : &get ( var -- value ) meta-n get hash-stack ;
#! Get stepper variable value.
meta-n get hash-stack ;
: report ( -- ) meta-cf get . ; : report ( -- ) meta-cf get . ;
: step : step ( -- ) next do-1 report ;
#! Step over current word.
next do-1 report ;
: into : into ( -- ) next do report ;
#! Step into current word.
next do report ;
: end-walk : end-walk ( -- )
#! Continue executing the single-stepped continuation in the
#! primary interpreter.
\ call push-r meta-cf get push-r meta-interp continue ; \ call push-r meta-cf get push-r meta-interp continue ;
: walk-banner ( -- ) : walk-banner ( -- )
@ -55,7 +36,6 @@ vectors words ;
"walk " listener-prompt set ; "walk " listener-prompt set ;
: walk ( quot -- ) : walk ( quot -- )
#! Single-step through execution of a quotation.
datastack dup pop* callstack namestack catchstack [ datastack dup pop* callstack namestack catchstack [
meta-c set meta-n set meta-r set meta-d set meta-c set meta-n set meta-r set meta-d set
meta-cf set meta-cf set

View File

@ -0,0 +1,31 @@
IN: walker
USING: help inspector ;
HELP: &s "( -- )"
{ $description "Prints the single stepper data stack." }
{ $notes "This is analogous to " { $link .s } "." } ;
HELP: &r "( -- )"
{ $description "Prints the single stepper return stack and the currently executing quotation." }
{ $notes "This is analogous to " { $link .r } "." } ;
HELP: &get "( var -- value )"
{ $values { "var" "an object" } { "value" "an object" } }
{ $description "Looks up a variable value in the single stepper name stack." } ;
HELP: report "( -- )"
{ $description "Print the quotation currently executing in the single stepper." } ;
HELP: step "( -- )"
{ $description "Run one iteration of the single stepper, without stepping into compound definitions." }
{ $see-also into } ;
HELP: into "( -- )"
{ $description "Run one iteration of the single stepper; if the current word is a compound definition, the single stepper begins stepping through the word's definition." }
{ $see-also step } ;
HELP: end-walk "( -- )"
{ $description "Continue normal execution of the single-stepped quotation." } ;
HELP: walk "( quot -- )"
{ $description "Spawn a new listener, customized for single-stepping through a quotation using the " { $link step } " and " { $link into } " words. The state of the single stepper stacks can be displayed using " { $link &s } " and " { $link &r } ", while variable values can be inspected with " { $link &get } "." } ;

View File

@ -1,11 +1,29 @@
! Copyright (C) 2006 Slava Pestov. ! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: gadgets-browser IN: gadgets-browser
USING: arrays components gadgets gadgets-buttons gadgets-labels USING: arrays gadgets gadgets-buttons gadgets-labels
gadgets-layouts gadgets-panes gadgets-scrolling gadgets-theme gadgets-layouts gadgets-panes gadgets-scrolling gadgets-theme
generic hashtables help inspector kernel lists math namespaces generic hashtables help inspector kernel lists math namespaces
prettyprint sequences words ; prettyprint sequences words ;
SYMBOL: components
H{ } clone components set-global
: get-components ( class -- assoc )
components get-global hash [ { } ] unless*
{ "Slots" [ describe ] } add ;
{
{ "Definition" [ help ] }
{ "Calls in" [ usage. ] }
{ "Calls out" [ uses. ] }
} \ word components get-global set-hash
{
{ "Documentation" [ help ] }
} \ link components get-global set-hash
TUPLE: book page pages ; TUPLE: book page pages ;
: show-page ( key book -- ) : show-page ( key book -- )

View File

@ -57,4 +57,4 @@ M: listener-gadget focusable-child* ( listener -- gadget )
listener-gadget-pane ; listener-gadget-pane ;
: listener-window ( -- ) : listener-window ( -- )
<listener-gadget> "Listener" simple-window ; <listener-gadget> "Listener" open-window ;

View File

@ -22,6 +22,8 @@ TUPLE: world status focus fonts handle ;
: add-status ( status world -- ) : add-status ( status world -- )
[ set-world-status ] 2keep @bottom frame-add ; [ set-world-status ] 2keep @bottom frame-add ;
DEFER: request-focus
C: world ( gadget status -- world ) C: world ( gadget status -- world )
dup delegate>frame dup delegate>frame
t over set-gadget-root? t over set-gadget-root?