Tool documentation
parent
3f77d6eb65
commit
6a9e67a4bc
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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" } "." } ;
|
|
@ -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" } "." } ;
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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." } ;
|
|
@ -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 ;
|
||||||
|
|
|
@ -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"
|
||||||
|
}
|
||||||
|
} ;
|
|
@ -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
|
|
|
@ -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." } ;
|
||||||
|
|
|
@ -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. ;
|
||||||
|
|
|
@ -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." } ;
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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." } ;
|
|
@ -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.
|
||||||
|
|
|
@ -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." } ;
|
|
@ -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
|
||||||
|
|
|
@ -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 } "." } ;
|
|
@ -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 -- )
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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?
|
||||||
|
|
Loading…
Reference in New Issue