From e090916c710246f51dcf3b8076e14fabbbe0191b Mon Sep 17 00:00:00 2001 From: slava Date: Fri, 8 Dec 2006 03:53:50 +0000 Subject: [PATCH] More modularization of core, heading towards being able to make smaller images --- TODO.txt | 1 + core/bootstrap/boot-stage1.factor | 3 + core/bootstrap/init.factor | 2 +- core/collections/sequence-sort.factor | 6 + core/compiler/alien/prettyprint.factor | 14 +++ core/compiler/load.factor | 1 + core/debugger.factor | 124 ++++++++++++++++++++ core/debugger.facts | 99 ++++++++++++++++ core/definitions.factor | 2 + core/documentation.factor | 77 ++++++++++++ core/errors.factor | 8 ++ core/errors.facts | 10 ++ core/help/help.factor | 7 +- core/help/help.facts | 2 +- core/help/load.factor | 11 ++ core/help/markup.factor | 12 +- core/{test/help => help/test}/search.factor | 0 core/{test/help => help/test}/topics.factor | 0 core/help/topics.factor | 24 ---- core/{tools => }/listener.factor | 0 core/{tools => }/listener.facts | 0 core/load.factor | 112 +----------------- core/modules.factor | 88 ++------------ core/modules.facts | 15 --- core/prettyprint/backend.factor | 12 +- core/{tools => prettyprint}/describe.factor | 0 core/{tools => prettyprint}/describe.facts | 0 core/prettyprint/sections.facts | 6 - core/syntax/parse-syntax.factor | 1 + core/tools/completion.factor | 2 +- core/tools/debugger.factor | 124 +------------------- core/tools/debugger.facts | 100 +--------------- core/tools/definitions.factor | 31 ++++- core/{bootstrap => tools}/image.factor | 0 core/{bootstrap => tools}/image.facts | 0 core/tools/load.factor | 30 +++++ core/tools/modules.factor | 74 ++++++++++++ core/tools/modules.facts | 17 +++ core/tools/test.factor | 8 -- core/tools/test.facts | 10 -- core/{ => tools}/test/annotate.factor | 0 core/{ => tools}/test/inspector.factor | 0 core/{ => tools}/test/interpreter.factor | 0 core/{ => tools}/test/memory.factor | 0 core/{ => tools}/test/tools.factor | 0 core/ui/cocoa/load.factor | 2 +- core/ui/debugger.factor | 21 +--- core/ui/gadgets/presentations.factor | 3 - core/ui/load.factor | 11 -- core/ui/tools/listener.factor | 10 ++ core/ui/tools/load.factor | 18 +++ core/ui/tools/search.factor | 3 +- core/ui/{ => tools}/test/listener.factor | 0 core/ui/tools/workspace.factor | 1 + core/ui/windows/load.factor | 2 +- core/ui/x11/load.factor | 2 + 56 files changed, 578 insertions(+), 528 deletions(-) create mode 100644 core/compiler/alien/prettyprint.factor create mode 100644 core/debugger.factor create mode 100644 core/debugger.facts create mode 100644 core/documentation.factor create mode 100644 core/help/load.factor rename core/{test/help => help/test}/search.factor (100%) rename core/{test/help => help/test}/topics.factor (100%) rename core/{tools => }/listener.factor (100%) rename core/{tools => }/listener.facts (100%) rename core/{tools => prettyprint}/describe.factor (100%) rename core/{tools => prettyprint}/describe.facts (100%) rename core/{bootstrap => tools}/image.factor (100%) rename core/{bootstrap => tools}/image.facts (100%) create mode 100644 core/tools/load.factor create mode 100644 core/tools/modules.factor create mode 100644 core/tools/modules.facts rename core/{ => tools}/test/annotate.factor (100%) rename core/{ => tools}/test/inspector.factor (100%) rename core/{ => tools}/test/interpreter.factor (100%) rename core/{ => tools}/test/memory.factor (100%) rename core/{ => tools}/test/tools.factor (100%) create mode 100644 core/ui/tools/load.factor rename core/ui/{ => tools}/test/listener.factor (100%) diff --git a/TODO.txt b/TODO.txt index 1c65349f9a..3206eefb41 100644 --- a/TODO.txt +++ b/TODO.txt @@ -2,6 +2,7 @@ - error popups obscure input area - callback scheduling issue +- error window: ENTER hides it + 0.88: diff --git a/core/bootstrap/boot-stage1.factor b/core/bootstrap/boot-stage1.factor index a7d173ceef..d7863760f6 100644 --- a/core/bootstrap/boot-stage1.factor +++ b/core/bootstrap/boot-stage1.factor @@ -14,9 +14,12 @@ prettyprint sequences vectors words ; \ boot , "core" require + "core/help" require + "core/tools" require "core/compiler" require "core/io/buffer" require "core/ui" require + "core/ui/tools" require "core/compiler/" architecture get append require "core/handbook" require diff --git a/core/bootstrap/init.factor b/core/bootstrap/init.factor index d75fc76e72..d01a22f949 100644 --- a/core/bootstrap/init.factor +++ b/core/bootstrap/init.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. IN: kernel-internals USING: assembler command-line errors io io-internals kernel math -namespaces parser threads words ; +namespaces parser words threads ; : boot ( -- ) init-namespaces diff --git a/core/collections/sequence-sort.factor b/core/collections/sequence-sort.factor index 227cb4d57c..b74c5251ae 100644 --- a/core/collections/sequence-sort.factor +++ b/core/collections/sequence-sort.factor @@ -90,6 +90,12 @@ IN: sequences : natural-sort ( seq -- sortedseq ) [ <=> ] sort ; +: sort-keys ( alist -- alist ) + [ [ first ] 2apply <=> ] sort ; + +: sort-values ( alist -- alist ) + [ [ second ] 2apply <=> ] sort ; + : binsearch ( elt seq quot -- i ) swap dup empty? [ 3drop -1 ] [ flatten-slice (binsearch) ] if ; inline diff --git a/core/compiler/alien/prettyprint.factor b/core/compiler/alien/prettyprint.factor new file mode 100644 index 0000000000..76abf44d96 --- /dev/null +++ b/core/compiler/alien/prettyprint.factor @@ -0,0 +1,14 @@ +! Copyright (C) 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +IN: prettyprint-internals +USING: alien kernel prettyprint math ; + +M: alien pprint* + dup expired? [ + drop "( alien expired )" + ] [ + \ ALIEN: pprint-word alien-address number>string + ] if text ; + +M: dll pprint* + dll-path alien>char-string "DLL\" " pprint-string ; diff --git a/core/compiler/load.factor b/core/compiler/load.factor index 33d71bbe0c..784044dde4 100644 --- a/core/compiler/load.factor +++ b/core/compiler/load.factor @@ -31,6 +31,7 @@ PROVIDE: core/compiler "alien/alien-invoke.factor" "alien/alien-callback.factor" "alien/alien-indirect.factor" + "alien/prettyprint.factor" "alien/syntax.factor" "alien/alien-callback.facts" diff --git a/core/debugger.factor b/core/debugger.factor new file mode 100644 index 0000000000..843c493ac9 --- /dev/null +++ b/core/debugger.factor @@ -0,0 +1,124 @@ +! Copyright (C) 2004, 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays definitions generic hashtables tools io +kernel math namespaces parser prettyprint sequences +sequences-internals strings styles vectors words errors ; +IN: kernel-internals + +: save-error ( error trace continuation -- ) + error-continuation set-global + error-stack-trace set-global + dup error set-global + compute-restarts restarts set-global ; + +: error-handler ( error trace -- ) + dupd continuation save-error rethrow ; + +: init-error-handler ( -- ) + V{ } clone set-catchstack + ! kernel calls on error + [ error-handler ] 5 setenv + \ kernel-error 12 setenv ; + +: code-heap-start 17 getenv ; +: code-heap-end 18 getenv ; + +: ( -- xtmap ) + [ + f code-heap-start 2array , + all-words [ compiled? ] subset + [ dup word-xt 2array , ] each + f code-heap-end 2array , + ] { } make sort-values ; + +: find-xt ( xt xtmap -- word ) + [ second - ] binsearch* first ; + +: symbolic-stack-trace ( seq -- seq ) + swap [ dup pick find-xt 2array ] map nip ; + +IN: errors + +GENERIC: error. ( error -- ) +GENERIC: error-help ( error -- topic ) + +M: object error. . ; +M: object error-help drop f ; + +M: tuple error. describe ; +M: tuple error-help class ; + +M: string error. print ; + +: :s ( -- ) + error-continuation get continuation-data stack. ; + +: :r ( -- ) + error-continuation get continuation-retain stack. ; + +: xt. ( xt -- ) + >hex cell 2 * CHAR: 0 pad-left write ; + +: word-xt. ( xt word -- ) + "Compiled: " write dup pprint bl + "(offset " write word-xt - >hex write ")" write ; + +: bare-xt. ( xt -- ) + "C code: " write xt. ; + +: :trace + error-stack-trace get symbolic-stack-trace [ + first2 [ word-xt. ] [ bare-xt. ] if* terpri + ] each ; + +: :c ( -- ) + error-continuation get continuation-call callstack. :trace ; + +: :get ( variable -- value ) + error-continuation get continuation-name hash-stack ; + +: :res ( n -- ) + restarts get-global nth f restarts set-global restart ; + +: restart. ( restart n -- ) + [ # " :res " % restart-name % ] "" make print ; + +: restarts. ( -- ) + restarts get dup empty? [ + drop + ] [ + terpri + "The following restarts are available:" print + terpri + dup length [ restart. ] 2each + ] if ; + +: debug-help ( -- ) + terpri + "Debugger commands:" print + terpri + ":help - documentation for this error" print + ":s - data stack at exception time" print + ":r - retain stack at exception time" print + ":c - call stack at exception time" print + + error get [ parse-error? ] is? [ + ":edit - jump to source location" print + ] when + + ":get ( var -- value ) accesses variables at time of the error" print + flush ; + +: print-error ( error -- ) + [ + dup error. + ] [ + "Error in print-error!" print drop + ] recover drop ; + +SYMBOL: error-hook + +[ print-error restarts. debug-help ] error-hook set-global + +: try ( quot -- ) + [ error-hook get call ] recover ; diff --git a/core/debugger.facts b/core/debugger.facts new file mode 100644 index 0000000000..9cdf81800d --- /dev/null +++ b/core/debugger.facts @@ -0,0 +1,99 @@ +IN: errors +USING: alien arrays generic help kernel math memory +strings vectors ; + +HELP: :s +{ $description "Prints the data stack at the time of the most recent error. Used for interactive debugging." } ; + +HELP: :r +{ $description "Prints the retain stack at the time of the most recent error. Used for interactive debugging." } ; + +HELP: :c +{ $description "Prints the call stack at the time of the most recent error. Used for interactive debugging." } ; + +HELP: :get +{ $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." } ; + +HELP: :res +{ $values { "n" "a non-negative integer" } } +{ $description "Continues executing the " { $snippet "n" } "th restart." } ; + +HELP: error. +{ $values { "error" "an error" } } +{ $contract "Print an error to the default stream." } ; + +HELP: error-help +{ $values { "error" "an error" } { "topic" "an article name or word" } } +{ $contract "Outputs a help article which explains the error." } +{ $see-also :help } ; + +HELP: print-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 +{ $values { "quot" "a quotation" } } +{ $description "Calls the quotation. If it throws an error, logs the error to the default stream and restores the data stack." } ; + +HELP: expired-error. +{ $error-description "Thrown by " { $link alien-address } " and " { $link alien-invoke } " if an " { $link alien } " object passed in as a parameter has expired. Alien objects expire if they are saved an image which is subsequently loaded; this prevents a certain class of programming errors, usually attempts to use uninitialized objects, since holding a C address is meaningless between sessions." } +{ $notes "You can check if an alien object has expired by calling " { $link expired? } "." } ; + +HELP: io-error. +{ $error-description "Thrown by the C streams I/O primitives if an I/O error occurs." } ; + +HELP: undefined-word-error. +{ $error-description "Thrown if an attempt is made to call a word which was defined by " { $link POSTPONE: DEFER: } "." } ; + +HELP: type-check-error. +{ $error-description "Thrown by various primitives if one of the inputs does not have the expected type. Generic words throw " { $link no-method } " and " { $link no-math-method } " errors in such cases instead." } ; + +HELP: signal-error. +{ $error-description + "Thrown by the runtime when a Unix signal is received. While signal numbers are system-specific, the following are relatively standard:" + { $list + { "4 - Illegal instruction. If you see this error, it is a bug in Factor's compiler and should be reported." } + { "8 - Arithmetic exception. Most likely a divide by zero in " { $link /i } "." } + { "10, 11 - Memory protection fault. This error suggests invalid values are being passed to C functions by an " { $link alien-invoke } ". Factor also uses memory protection to trap stack underflows and overflows, but usually these are reported as their own errors. Sometimes they'll show up as a generic signal 11, though." } + } + "The Windows equivalent of a signal 11 is a SEH fault. When one occurs, the runtime throws a singal error, even though it does not correspond to a Unix signal." +} ; + +HELP: negative-array-size-error. +{ $error-description "Thrown by " { $link } ", " { $link } ", " { $link } " and " { $link } " if a negative capacity is specified." } ; + +HELP: c-string-error. +{ $error-description "Thrown by " { $link alien-invoke } " and various primitives if a string containing null bytes, or characters with values higher than 255 is passed in where a C string is expected. See " { $link "c-strings" } "." } ; + +HELP: ffi-error. +{ $error-description "Thrown by " { $link dlopen } " and " { $link dlsym } " if a problem occurs while loading a native library or looking up a symbol. See " { $link "alien" } "." } ; + +HELP: heap-scan-error. +{ $error-description "Thrown if " { $link next-object } " is called outside of a " { $link begin-scan } "/" { $link end-scan } " pair." } ; + +HELP: undefined-symbol-error. +{ $error-description "Thrown if a previously-compiled " { $link alien-invoke } " call refers to a native library symbol which no longer exists." } ; + +HELP: user-interrupt. +{ $error-description "Thrown by the " { $snippet "t" } " command in the FEP." } ; + +HELP: datastack-underflow. +{ $error-description "Thrown by the runtime if an attempt is made to pop elements from an empty data stack." } +{ $notes "You can use the stack effect tool to statically check stack effects of quotations. See " { $link "inference" } "." } ; + +HELP: datastack-overflow. +{ $error-description "Thrown by the runtime if an attempt is made to push elements on a full data stack." } +{ $notes "This error usually indicates a run-away recursion, however if you legitimately need a data stack larger than the default, see " { $link "runtime-cli-args" } "." } ; + +HELP: retainstack-underflow. +{ $error-description "Thrown by the runtime if " { $link r> } " is called while the retain stack is empty." } +{ $notes "You can use the stack effect tool to statically check stack effects of quotations. See " { $link "inference" } "." } ; + +HELP: retainstack-overflow. +{ $error-description "Thrown by the runtime if " { $link >r } " is called when the retain stack is full." } +{ $notes "This error usually indicates a run-away recursion, however if you legitimately need a retain stack larger than the default, see " { $link "runtime-cli-args" } "." } ; + +HELP: callstack-overflow. +{ $error-description "Thrown by the runtime if the call stack is full." } +{ $notes "This error usually indicates a run-away recursion, however if you legitimately need a call stack larger than the default, see " { $link "runtime-cli-args" } "." } ; diff --git a/core/definitions.factor b/core/definitions.factor index 023904b84d..0d516b60e6 100644 --- a/core/definitions.factor +++ b/core/definitions.factor @@ -10,3 +10,5 @@ GENERIC: where ( defspec -- loc ) GENERIC: subdefs ( defspec -- seq ) GENERIC: forget ( defspec -- ) + +GENERIC: synopsis* ( defspec -- ) diff --git a/core/documentation.factor b/core/documentation.factor new file mode 100644 index 0000000000..64cf161e95 --- /dev/null +++ b/core/documentation.factor @@ -0,0 +1,77 @@ +PROVIDE: core/documentation +{ +directory+ "core" } +{ +files+ { + "continuations.facts" + "definitions.facts" + "effects.facts" + "errors.facts" + "kernel.facts" + "modules.facts" + "quotations.facts" + "threads.facts" + "words.facts" + "listener.facts" + "bootstrap/init.facts" + "collections/growable.facts" + "collections/arrays.facts" + "collections/graphs.facts" + "collections/hashtables.facts" + "collections/namespaces.facts" + "collections/queues.facts" + "collections/sbuf.facts" + "collections/sequence-combinators.facts" + "collections/sequence-sort.facts" + "collections/sequences-epilogue.facts" + "collections/sequences.facts" + "collections/slicing.facts" + "collections/strings.facts" + "collections/flatten.facts" + "collections/vectors.facts" + "collections/virtual-sequences.facts" + "generic/early-generic.facts" + "generic/classes.facts" + "generic/generic.facts" + "generic/methods.facts" + "generic/math-combination.facts" + "generic/slots.facts" + "generic/standard-combination.facts" + "generic/tuple.facts" + "help/help.facts" + "help/markup.facts" + "help/syntax.facts" + "help/topics.facts" + "io/binary.facts" + "io/c-streams.facts" + "io/duplex-stream.facts" + "io/files.facts" + "io/lines.facts" + "io/nested-style.facts" + "io/plain-stream.facts" + "io/server.facts" + "io/stdio.facts" + "io/stream.facts" + "io/string-streams.facts" + "io/styles.facts" + "math/arc-trig-hyp.facts" + "math/complex.facts" + "math/constants.facts" + "math/float.facts" + "math/integer.facts" + "math/math.facts" + "math/parse-numbers.facts" + "math/pow.facts" + "math/random.facts" + "math/ratio.facts" + "math/trig-hyp.facts" + "math/vectors.facts" + "prettyprint/core.facts" + "prettyprint/sections.facts" + "prettyprint/backend.facts" + "prettyprint/frontend.facts" + "prettyprint/debugger.facts" + "prettyprint/describe.facts" + "syntax/early-parser.facts" + "syntax/parse-stream.facts" + "syntax/parser.facts" + "syntax/parse-syntax.facts" +} } ; diff --git a/core/errors.factor b/core/errors.factor index 01660b4a69..4b9774daea 100644 --- a/core/errors.factor +++ b/core/errors.factor @@ -60,4 +60,12 @@ M: condition compute-restarts PREDICATE: array kernel-error ( obj -- ? ) dup first \ kernel-error eq? swap second 0 18 between? and ; +TUPLE: assert got expect ; + +: assert ( got expect -- * ) throw ; + +: assert= ( a b -- ) 2dup = [ 2drop ] [ assert ] if ; + +: assert-depth ( quot -- ) depth slip depth swap assert= ; + DEFER: try diff --git a/core/errors.facts b/core/errors.facts index 9610443486..d3f9a027e1 100644 --- a/core/errors.facts +++ b/core/errors.facts @@ -71,3 +71,13 @@ HELP: compute-restarts { $description "Outputs a sequence of triples, where each triple consists of a human-readable string, an object, and a continuation. Resuming a continuation with the corresponding object restarts execution immediately after the corresponding call to " { $link condition } "." $terpri "This word recursively travels up the delegation chain to collate restarts from nested and wrapped conditions." } ; + +HELP: assert +{ $values { "got" "the obtained value" } { "expect" "the expected value" } } +{ $description "Throws an " { $link assert } " error." } +{ $error-description "Thrown when a unit test or other assertion fails." } +{ $see-also assert-depth } ; + +HELP: assert-depth +{ $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." } ; diff --git a/core/help/help.factor b/core/help/help.factor index f975308b33..93a99ada7a 100644 --- a/core/help/help.factor +++ b/core/help/help.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. IN: help USING: arrays io kernel namespaces parser prettyprint sequences -words hashtables definitions ; +words hashtables definitions errors generic ; M: word article-title dup parsing? [ @@ -85,8 +85,3 @@ M: word article-content [ remove-word-help ] keep [ swap "help" set-word-prop ] keep xref-article ; - -! Definition protocol -M: link forget link-name remove-article ; - -M: word-link forget f "help" set-word-prop ; diff --git a/core/help/help.facts b/core/help/help.facts index 3f5e97f77e..a9d9291101 100644 --- a/core/help/help.facts +++ b/core/help/help.facts @@ -3,7 +3,7 @@ USING: definitions io prettyprint ; HELP: $title { $values { "topic" "a help article name or a word" } } -{ $description "Prints a help article's title, or a word's " { $link synopsis } ", depending on the type of " { $snippet "topic" } "." } ; +{ $description "Prints a help article's title, or a word's " { $link summary } ", depending on the type of " { $snippet "topic" } "." } ; HELP: (help) { $values { "topic" "an article name or a word" } } diff --git a/core/help/load.factor b/core/help/load.factor new file mode 100644 index 0000000000..561e1bcfcf --- /dev/null +++ b/core/help/load.factor @@ -0,0 +1,11 @@ +PROVIDE: core/help +{ +files+ { + "stylesheet.factor" + "topics.factor" + "markup.factor" + "help.factor" + "syntax.factor" +} } +{ +tests+ { + "test/topics.factor" +} } ; diff --git a/core/help/markup.factor b/core/help/markup.factor index 0fd938bfd8..ab53ed409f 100644 --- a/core/help/markup.factor +++ b/core/help/markup.factor @@ -242,7 +242,13 @@ M: f print-element drop ; drop "Throws an error if the I/O operation fails." $errors ; +: $prettyprinting-note + drop { + "This word should only be called from inside the " + { $link with-pprint } " combinator." + } $notes ; + : sort-articles ( seq -- newseq ) - [ [ article-title ] keep 2array ] map - [ [ first ] 2apply <=> ] sort - 1 ; + [ dup article-title 2array ] map + [ [ second ] 2apply <=> ] sort + 0 ; diff --git a/core/test/help/search.factor b/core/help/test/search.factor similarity index 100% rename from core/test/help/search.factor rename to core/help/test/search.factor diff --git a/core/test/help/topics.factor b/core/help/test/topics.factor similarity index 100% rename from core/test/help/topics.factor rename to core/help/test/topics.factor diff --git a/core/help/topics.factor b/core/help/topics.factor index 4aa621261c..fda7892e0f 100644 --- a/core/help/topics.factor +++ b/core/help/topics.factor @@ -73,27 +73,3 @@ DEFER: $subsection : xref-help ( -- ) all-articles [ children ] parent-graph get build-graph ; - -! Definition protocol -M: link where link-name article article-loc ; - -M: link synopsis* - \ ARTICLE: pprint-word - dup link-name pprint* - article-title pprint* ; - -M: link definition article-content t ; - -M: link see (see) ; - -PREDICATE: link word-link link-name word? ; - -M: word-link where link-name "help-loc" word-prop ; - -M: word-link synopsis* - \ HELP: pprint-word - link-name dup pprint-word - stack-effect effect>string comment. ; - -M: word-link definition - link-name "help" word-prop t ; diff --git a/core/tools/listener.factor b/core/listener.factor similarity index 100% rename from core/tools/listener.factor rename to core/listener.factor diff --git a/core/tools/listener.facts b/core/listener.facts similarity index 100% rename from core/tools/listener.facts rename to core/listener.facts diff --git a/core/load.factor b/core/load.factor index ccc91fbd90..8089587589 100644 --- a/core/load.factor +++ b/core/load.factor @@ -75,124 +75,25 @@ PROVIDE: core "prettyprint/sections.factor" "prettyprint/backend.factor" "prettyprint/frontend.factor" + "prettyprint/describe.factor" "syntax/parser.factor" "syntax/parse-stream.factor" - "tools/definitions.factor" - "tools/describe.factor" - "tools/completion.factor" - - "help/stylesheet.factor" - "help/topics.factor" - "help/markup.factor" - "help/help.factor" - "help/syntax.factor" - - "tools/debugger.factor" + "debugger.factor" + "listener.factor" "threads.factor" "io/server.factor" - "tools/memory.factor" - "tools/listener.factor" - "tools/inspector.factor" - "tools/word-tools.factor" - "tools/test.factor" - - "tools/interpreter.factor" - "cli.factor" "modules.factor" "syntax/parse-syntax.factor" - "tools/errors.factor" - "bootstrap/init.factor" - "bootstrap/image.factor" - - "continuations.facts" - "definitions.facts" - "effects.facts" - "errors.facts" - "kernel.facts" - "modules.facts" - "quotations.facts" - "threads.facts" - "words.facts" - "bootstrap/image.facts" - "bootstrap/init.facts" - "collections/growable.facts" - "collections/arrays.facts" - "collections/graphs.facts" - "collections/hashtables.facts" - "collections/namespaces.facts" - "collections/queues.facts" - "collections/sbuf.facts" - "collections/sequence-combinators.facts" - "collections/sequence-sort.facts" - "collections/sequences-epilogue.facts" - "collections/sequences.facts" - "collections/slicing.facts" - "collections/strings.facts" - "collections/flatten.facts" - "collections/vectors.facts" - "collections/virtual-sequences.facts" - "generic/early-generic.facts" - "generic/classes.facts" - "generic/generic.facts" - "generic/methods.facts" - "generic/math-combination.facts" - "generic/slots.facts" - "generic/standard-combination.facts" - "generic/tuple.facts" - "help/help.facts" - "help/markup.facts" - "help/syntax.facts" - "help/topics.facts" - "io/binary.facts" - "io/c-streams.facts" - "io/duplex-stream.facts" - "io/files.facts" - "io/lines.facts" - "io/nested-style.facts" - "io/plain-stream.facts" - "io/server.facts" - "io/stdio.facts" - "io/stream.facts" - "io/string-streams.facts" - "io/styles.facts" - "math/arc-trig-hyp.facts" - "math/complex.facts" - "math/constants.facts" - "math/float.facts" - "math/integer.facts" - "math/math.facts" - "math/parse-numbers.facts" - "math/pow.facts" - "math/random.facts" - "math/ratio.facts" - "math/trig-hyp.facts" - "math/vectors.facts" - "prettyprint/core.facts" - "prettyprint/sections.facts" - "prettyprint/backend.facts" - "prettyprint/frontend.facts" - "syntax/early-parser.facts" - "syntax/parse-stream.facts" - "syntax/parser.facts" - "syntax/parse-syntax.facts" - "tools/definitions.facts" - "tools/word-tools.facts" - "tools/debugger.facts" - "tools/describe.facts" - "tools/inspector.facts" - "tools/listener.facts" - "tools/memory.facts" - "tools/test.facts" + } } { +tests+ { - "test/annotate.factor" "test/binary.factor" "test/collections/hashtables.factor" "test/collections/namespaces.factor" @@ -205,10 +106,7 @@ PROVIDE: core "test/continuations.factor" "test/errors.factor" "test/generic.factor" - "test/help/topics.factor" "test/init.factor" - "test/inspector.factor" - "test/interpreter.factor" "test/io/io.factor" "test/io/nested-style.factor" "test/kernel.factor" @@ -220,7 +118,6 @@ PROVIDE: core "test/math/math-combinators.factor" "test/math/random.factor" "test/math/rational.factor" - "test/memory.factor" "test/parse-number.factor" "test/parser.factor" "test/parsing-word.factor" @@ -231,5 +128,4 @@ PROVIDE: core "test/threads.factor" "test/tuple.factor" "test/words.factor" - "test/tools.factor" } } ; diff --git a/core/modules.factor b/core/modules.factor index bab829e5f2..38abcf5b65 100644 --- a/core/modules.factor +++ b/core/modules.factor @@ -2,17 +2,11 @@ ! See http://factorcode.org/license.txt for BSD license. IN: modules USING: hashtables io kernel namespaces parser sequences -test words strings arrays math help prettyprint-internals -definitions styles ; +words strings arrays math help errors ; SYMBOL: modules -TUPLE: module name loc files tests help main ; - -! For presentations -TUPLE: module-link name ; - -M: module-link module-name module-link-name ; +TUPLE: module name loc directory files tests help main ; : module-def ( name -- path ) "resource:" over "/load.factor" append3 @@ -31,7 +25,7 @@ M: module-link module-name module-link-name ; [ path+ "resource:" swap append ] map-with ; : module-files* ( module -- seq ) - dup module-name swap module-files process-files ; + dup module-directory swap module-files process-files ; : load-module ( name -- ) [ @@ -46,24 +40,28 @@ M: module-link module-name module-link-name ; module-files* [ source-modified? ] subset run-files ] if ; +: reload-modules ( -- ) + modules get [ reload-module ] each do-parse-hook ; + : require ( name -- ) dup module [ reload-module ] [ load-module ] ?if do-parse-hook ; -: module-tests* ( module -- seq ) - dup module-name swap module-tests process-files ; - : remove-module ( name -- ) module [ modules get delete ] when* ; : alist>module ( name loc hash -- module ) alist>hash [ - +files+ get +tests+ get +help+ get + +directory+ get [ over ] unless* + +files+ get + +tests+ get + +help+ get ] bind f ; : module>alist ( module -- hash ) [ + +directory+ over module-directory 2array , +files+ over module-files 2array , +tests+ over module-tests 2array , +help+ swap module-help 2array , @@ -74,67 +72,3 @@ M: module-link module-name module-link-name ; alist>module [ module-files* run-files ] keep modules get push ; - -: test-module ( name -- ) - dup require - module module-tests* run-tests ; - -: test-modules ( -- ) - modules get [ module-tests* ] map concat run-tests ; - -: reload-modules ( -- ) - modules get [ reload-module ] each do-parse-hook ; - -: run-module ( name -- ) - dup require - dup module module-main [ - assert-depth - ] [ - "The module " write write - " does not define an entry point." print - "To define one, see the documentation for the " write - \ MAIN: ($link) " word." print - ] ?if ; - -: modules-help ( -- seq ) - modules get [ module-help ] map [ ] subset ; - -M: module synopsis* - \ PROVIDE: pprint-word - [ module-name ] keep presented associate styled-text ; - -M: module definition module>alist t ; - -M: module where module-loc ; - -: module-dir? ( path -- ? ) - "load.factor" path+ resource-path exists? ; - -: (available-modules) ( path -- ) - dup resource-path directory [ path+ ] map-with - dup [ module-dir? ] subset % - [ (available-modules) ] each ; - -: small-modules ( path -- seq ) - dup resource-path directory [ path+ ] map-with - [ ".factor" tail? ] subset - [ ".factor" ?tail drop ] map ; - -: available-modules ( -- seq ) - [ - "core" (available-modules) - "apps" (available-modules) - "apps" small-modules % - "libs" (available-modules) - "libs" small-modules % - "demos" (available-modules) - "demos" small-modules % - ] { } make natural-sort - [ dup module [ ] [ ] ?if ] map ; - -: module-string ( obj -- str ) - dup module-name swap module? [ " (loaded)" append ] when ; - -: modules. ( -- ) - available-modules - [ [ module-string ] keep write-object terpri ] each ; diff --git a/core/modules.facts b/core/modules.facts index 6e4b625a4d..7a6e1448d5 100644 --- a/core/modules.facts +++ b/core/modules.facts @@ -31,17 +31,6 @@ HELP: provide { $values { "name" "a string" } { "hash" "a hashtable" } { "loc" "a pair holding a path name and line number" } } { $description "Registers a module definition and loads its source files. The possible hashtable keys are documented in the " { $link POSTPONE: PROVIDE: } " word. Usually instead of calling this word, module definitions use the parsing word " { $link POSTPONE: PROVIDE: } " instead." } ; -HELP: test-module -{ $values { "name" "a module name string" } } -{ $description "Runs the unit test files associated to the module by a previous call to " { $link provide } " or " { $link POSTPONE: PROVIDE: } "." } ; - -HELP: test-modules -{ $description "Runs unit test files for all loaded modules." } ; - -HELP: run-module -{ $values { "name" "a module name string" } } -{ $description "Runs the main entry point of the module, first loading the module if necessary using " { $link require } ". Entry points can be defined with the " { $link POSTPONE: MAIN: } " word." } ; - HELP: reload-module { $values { "module" "a " { $link module } " instance" } } { $description "Reloads any source files making up a module if they have been modified on disk since last being loaded. Most of the time " { $link reload-modules } " should be called instead." } ; @@ -49,7 +38,3 @@ HELP: reload-module HELP: reload-modules { $description "Reloads all source files in all loaded modules which have been modified on disk since last being loaded." } { $notes "If modification times become invalid after moving sources or images between machines, and this word ends up trying to reload all library sources, call " { $link reset-modified } " from the listener." } ; - -HELP: modules-help -{ $values { "seq" "a new sequence" } } -{ $description "Outputs a sequence of help articles which are the main entry points into the documentation of loaded modules. Modules can define documentation entry points with the " { $link +help+ } " key of the association list given in " { $link POSTPONE: PROVIDE: } "." } ; diff --git a/core/prettyprint/backend.factor b/core/prettyprint/backend.factor index 09f4dde28f..57e4a37b98 100644 --- a/core/prettyprint/backend.factor +++ b/core/prettyprint/backend.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2003, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: prettyprint-internals -USING: alien arrays generic hashtables io kernel math +USING: arrays generic hashtables io kernel math namespaces parser sequences strings styles vectors words prettyprint ; @@ -31,13 +31,6 @@ M: real pprint* number>string text ; M: f pprint* drop \ f pprint-word ; -M: alien pprint* - dup expired? [ - drop "( alien expired )" - ] [ - \ ALIEN: pprint-word alien-address number>string - ] if text ; - ! Strings : ch>ascii-escape ( ch -- str ) H{ @@ -75,9 +68,6 @@ M: string pprint* "\"" pprint-string ; M: sbuf pprint* "SBUF\" " pprint-string ; -M: dll pprint* - dll-path alien>char-string "DLL\" " pprint-string ; - ! Sequences : nesting-limit? ( -- ? ) nesting-limit get dup [ pprinter-stack get length < ] when ; diff --git a/core/tools/describe.factor b/core/prettyprint/describe.factor similarity index 100% rename from core/tools/describe.factor rename to core/prettyprint/describe.factor diff --git a/core/tools/describe.facts b/core/prettyprint/describe.facts similarity index 100% rename from core/tools/describe.facts rename to core/prettyprint/describe.facts diff --git a/core/prettyprint/sections.facts b/core/prettyprint/sections.facts index a9734fa991..cc3f4e5663 100644 --- a/core/prettyprint/sections.facts +++ b/core/prettyprint/sections.facts @@ -1,12 +1,6 @@ IN: help USING: io kernel prettyprint prettyprint-internals words ; -: $prettyprinting-note - drop { - "This word should only be called from inside the " - { $link with-pprint } " combinator." - } $notes ; - HELP: pprint-section { $values { "section" "a section" } } { $contract "Prettyprints an object delegating to an instance of " { $link section } ", performing wrapping and indentation using the formatting information in the section." } ; diff --git a/core/syntax/parse-syntax.factor b/core/syntax/parse-syntax.factor index 38b5730133..f62a964ba8 100644 --- a/core/syntax/parse-syntax.factor +++ b/core/syntax/parse-syntax.factor @@ -93,3 +93,4 @@ DEFER: !PRIMITIVE: parsing SYMBOL: !+files+ SYMBOL: !+tests+ SYMBOL: !+help+ +SYMBOL: !+directory+ diff --git a/core/tools/completion.factor b/core/tools/completion.factor index b30d27254e..18d62bd24e 100644 --- a/core/tools/completion.factor +++ b/core/tools/completion.factor @@ -50,7 +50,7 @@ USING: kernel arrays sequences math namespaces strings io ; : rank-completions ( results -- newresults ) #! Discard results in the low 33% - [ [ first ] 2apply swap - ] sort + sort-keys [ 0 [ first max ] reduce 3 / ] keep [ first < ] subset-with [ second ] map ; diff --git a/core/tools/debugger.factor b/core/tools/debugger.factor index 8ed0c3711b..66ed6a6287 100644 --- a/core/tools/debugger.factor +++ b/core/tools/debugger.factor @@ -1,85 +1,10 @@ -! Copyright (C) 2004, 2006 Slava Pestov. +! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays definitions generic hashtables help tools io +USING: arrays definitions generic hashtables tools io kernel math namespaces parser prettyprint sequences -sequences-internals strings styles vectors words errors ; -IN: kernel-internals - -: save-error ( error trace continuation -- ) - error-continuation set-global - error-stack-trace set-global - dup error set-global - compute-restarts restarts set-global ; - -: error-handler ( error trace -- ) - dupd continuation save-error rethrow ; - -: init-error-handler ( -- ) - V{ } clone set-catchstack - ! kernel calls on error - [ error-handler ] 5 setenv - \ kernel-error 12 setenv ; - -: code-heap-start 17 getenv ; -: code-heap-end 18 getenv ; - -: ( -- xtmap ) - [ - f code-heap-start 2array , - all-words [ compiled? ] subset - [ dup word-xt 2array , ] each - f code-heap-end 2array , - ] { } make [ [ second ] 2apply - ] sort ; - -: find-xt ( xt xtmap -- word ) - [ second - ] binsearch* first ; - -: symbolic-stack-trace ( seq -- seq ) - swap [ dup pick find-xt 2array ] map nip ; - +sequences-internals strings styles vectors words errors help ; IN: errors -GENERIC: error. ( error -- ) -GENERIC: error-help ( error -- topic ) - -M: object error. . ; -M: object error-help drop f ; - -M: tuple error. describe ; -M: tuple error-help class ; - -M: string error. print ; - -: :s ( -- ) - error-continuation get continuation-data stack. ; - -: :r ( -- ) - error-continuation get continuation-retain stack. ; - -: xt. ( xt -- ) - >hex cell 2 * CHAR: 0 pad-left write ; - -: word-xt. ( xt word -- ) - "Compiled: " write dup pprint bl - "(offset " write word-xt - >hex write ")" write ; - -: bare-xt. ( xt -- ) - "C code: " write xt. ; - -: :trace - error-stack-trace get symbolic-stack-trace [ - first2 [ word-xt. ] [ bare-xt. ] if* terpri - ] each ; - -: :c ( -- ) - error-continuation get continuation-call callstack. :trace ; - -: :get ( variable -- value ) - error-continuation get continuation-name hash-stack ; - -: :res ( n -- ) - restarts get-global nth f restarts set-global restart ; - : :edit ( -- ) error get delegates [ parse-error? ] find-last nip [ dup parse-error-file ?resource-path @@ -100,46 +25,3 @@ M: string error. print ; { [ dup length 1 = ] [ first help ] } { [ t ] [ (:help-multi) ] } } cond ; - -: restart. ( restart n -- ) - [ # " :res " % restart-name % ] "" make print ; - -: restarts. ( -- ) - restarts get dup empty? [ - drop - ] [ - terpri - "The following restarts are available:" print - terpri - dup length [ restart. ] 2each - ] if ; - -: debug-help ( -- ) - terpri - "Debugger commands:" print - terpri - ":help - documentation for this error" print - ":s - data stack at exception time" print - ":r - retain stack at exception time" print - ":c - call stack at exception time" print - - error get [ parse-error? ] is? [ - ":edit - jump to source location" print - ] when - - ":get ( var -- value ) accesses variables at time of the error" print - flush ; - -: print-error ( error -- ) - [ - dup error. - ] [ - "Error in print-error!" print drop - ] recover drop ; - -SYMBOL: error-hook - -[ print-error restarts. debug-help ] error-hook set-global - -: try ( quot -- ) - [ error-hook get call ] recover ; diff --git a/core/tools/debugger.facts b/core/tools/debugger.facts index 0c413106ce..429a1eb3d0 100644 --- a/core/tools/debugger.facts +++ b/core/tools/debugger.facts @@ -1,102 +1,8 @@ IN: errors -USING: alien arrays generic help kernel math memory -strings vectors ; - -HELP: :s -{ $description "Prints the data stack at the time of the most recent error. Used for interactive debugging." } ; - -HELP: :r -{ $description "Prints the retain stack at the time of the most recent error. Used for interactive debugging." } ; - -HELP: :c -{ $description "Prints the call stack at the time of the most recent error. Used for interactive debugging." } ; - -HELP: :get -{ $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." } ; +USING: help parser definitions ; HELP: :help { $description "Displays documentation for the most recent error." } ; -HELP: :res -{ $values { "n" "a non-negative integer" } } -{ $description "Continues executing the " { $snippet "n" } "th restart." } ; - -HELP: error. -{ $values { "error" "an error" } } -{ $contract "Print an error to the default stream." } ; - -HELP: error-help -{ $values { "error" "an error" } { "topic" "an article name or word" } } -{ $contract "Outputs a help article which explains the error." } -{ $see-also :help } ; - -HELP: print-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 -{ $values { "quot" "a quotation" } } -{ $description "Calls the quotation. If it throws an error, logs the error to the default stream and restores the data stack." } ; - -HELP: expired-error. -{ $error-description "Thrown by " { $link alien-address } " and " { $link alien-invoke } " if an " { $link alien } " object passed in as a parameter has expired. Alien objects expire if they are saved an image which is subsequently loaded; this prevents a certain class of programming errors, usually attempts to use uninitialized objects, since holding a C address is meaningless between sessions." } -{ $notes "You can check if an alien object has expired by calling " { $link expired? } "." } ; - -HELP: io-error. -{ $error-description "Thrown by the C streams I/O primitives if an I/O error occurs." } ; - -HELP: undefined-word-error. -{ $error-description "Thrown if an attempt is made to call a word which was defined by " { $link POSTPONE: DEFER: } "." } ; - -HELP: type-check-error. -{ $error-description "Thrown by various primitives if one of the inputs does not have the expected type. Generic words throw " { $link no-method } " and " { $link no-math-method } " errors in such cases instead." } ; - -HELP: signal-error. -{ $error-description - "Thrown by the runtime when a Unix signal is received. While signal numbers are system-specific, the following are relatively standard:" - { $list - { "4 - Illegal instruction. If you see this error, it is a bug in Factor's compiler and should be reported." } - { "8 - Arithmetic exception. Most likely a divide by zero in " { $link /i } "." } - { "10, 11 - Memory protection fault. This error suggests invalid values are being passed to C functions by an " { $link alien-invoke } ". Factor also uses memory protection to trap stack underflows and overflows, but usually these are reported as their own errors. Sometimes they'll show up as a generic signal 11, though." } - } - "The Windows equivalent of a signal 11 is a SEH fault. When one occurs, the runtime throws a singal error, even though it does not correspond to a Unix signal." -} ; - -HELP: negative-array-size-error. -{ $error-description "Thrown by " { $link } ", " { $link } ", " { $link } " and " { $link } " if a negative capacity is specified." } ; - -HELP: c-string-error. -{ $error-description "Thrown by " { $link alien-invoke } " and various primitives if a string containing null bytes, or characters with values higher than 255 is passed in where a C string is expected. See " { $link "c-strings" } "." } ; - -HELP: ffi-error. -{ $error-description "Thrown by " { $link dlopen } " and " { $link dlsym } " if a problem occurs while loading a native library or looking up a symbol. See " { $link "alien" } "." } ; - -HELP: heap-scan-error. -{ $error-description "Thrown if " { $link next-object } " is called outside of a " { $link begin-scan } "/" { $link end-scan } " pair." } ; - -HELP: undefined-symbol-error. -{ $error-description "Thrown if a previously-compiled " { $link alien-invoke } " call refers to a native library symbol which no longer exists." } ; - -HELP: user-interrupt. -{ $error-description "Thrown by the " { $snippet "t" } " command in the FEP." } ; - -HELP: datastack-underflow. -{ $error-description "Thrown by the runtime if an attempt is made to pop elements from an empty data stack." } -{ $notes "You can use the stack effect tool to statically check stack effects of quotations. See " { $link "inference" } "." } ; - -HELP: datastack-overflow. -{ $error-description "Thrown by the runtime if an attempt is made to push elements on a full data stack." } -{ $notes "This error usually indicates a run-away recursion, however if you legitimately need a data stack larger than the default, see " { $link "runtime-cli-args" } "." } ; - -HELP: retainstack-underflow. -{ $error-description "Thrown by the runtime if " { $link r> } " is called while the retain stack is empty." } -{ $notes "You can use the stack effect tool to statically check stack effects of quotations. See " { $link "inference" } "." } ; - -HELP: retainstack-overflow. -{ $error-description "Thrown by the runtime if " { $link >r } " is called when the retain stack is full." } -{ $notes "This error usually indicates a run-away recursion, however if you legitimately need a retain stack larger than the default, see " { $link "runtime-cli-args" } "." } ; - -HELP: callstack-overflow. -{ $error-description "Thrown by the runtime if the call stack is full." } -{ $notes "This error usually indicates a run-away recursion, however if you legitimately need a call stack larger than the default, see " { $link "runtime-cli-args" } "." } ; +HELP: :edit +{ $description "If the most recent error was a " { $link parse-error } " thrown while parsing a source file, opens the source file at the failing line in the default editor using " { $link edit-location } "." } ; diff --git a/core/tools/definitions.factor b/core/tools/definitions.factor index 1ad37b2d58..2cb8bd7051 100644 --- a/core/tools/definitions.factor +++ b/core/tools/definitions.factor @@ -3,7 +3,7 @@ IN: definitions USING: arrays errors generic hashtables io kernel math namespaces parser prettyprint prettyprint-internals sequences -styles words ; +styles words help ; : reload ( defspec -- ) where first [ run-file ] when* ; @@ -25,8 +25,6 @@ SYMBOL: edit-hook "Not from a source file" throw ] if* ; -GENERIC: synopsis* ( defspec -- ) - : write-vocab ( vocab -- ) dup presented associate styled-text ; @@ -125,3 +123,30 @@ M: word see-class* drop ; : see-subdefs ( word -- ) subdefs [ terpri see ] each ; M: word see dup (see) dup see-class see-subdefs ; + +M: link where link-name article article-loc ; + +M: link synopsis* + \ ARTICLE: pprint-word + dup link-name pprint* + article-title pprint* ; + +M: link definition article-content t ; + +M: link see (see) ; + +PREDICATE: link word-link link-name word? ; + +M: word-link where link-name "help-loc" word-prop ; + +M: word-link synopsis* + \ HELP: pprint-word + link-name dup pprint-word + stack-effect effect>string comment. ; + +M: word-link definition + link-name "help" word-prop t ; + +M: link forget link-name remove-article ; + +M: word-link forget f "help" set-word-prop ; diff --git a/core/bootstrap/image.factor b/core/tools/image.factor similarity index 100% rename from core/bootstrap/image.factor rename to core/tools/image.factor diff --git a/core/bootstrap/image.facts b/core/tools/image.facts similarity index 100% rename from core/bootstrap/image.facts rename to core/tools/image.facts diff --git a/core/tools/load.factor b/core/tools/load.factor new file mode 100644 index 0000000000..edd70d87e8 --- /dev/null +++ b/core/tools/load.factor @@ -0,0 +1,30 @@ +PROVIDE: core/tools +{ +files+ { + "definitions.factor" + "completion.factor" + "memory.factor" + "inspector.factor" + "word-tools.factor" + "test.factor" + "modules.factor" + "image.factor" + "interpreter.factor" + "errors.factor" + "debugger.factor" + "image.facts" + "definitions.facts" + "word-tools.facts" + "inspector.facts" + "memory.facts" + "test.facts" + "modules.facts" + "image.facts" + "debugger.facts" +} } +{ +tests+ { + "test/annotate.factor" + "test/inspector.factor" + "test/interpreter.factor" + "test/memory.factor" + "test/tools.factor" +} } ; diff --git a/core/tools/modules.factor b/core/tools/modules.factor new file mode 100644 index 0000000000..a8ad8742b1 --- /dev/null +++ b/core/tools/modules.factor @@ -0,0 +1,74 @@ +! Copyright (C) 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +IN: modules +USING: hashtables io kernel namespaces parser sequences +words strings arrays math help errors prettyprint-internals styles test definitions ; + +! For presentations +TUPLE: module-link name ; + +M: module-link module-name module-link-name ; + +: module-tests* ( module -- seq ) + dup module-name swap module-tests process-files ; + +: test-module ( name -- ) + dup require + module module-tests* run-tests ; + +: test-modules ( -- ) + modules get [ module-tests* ] map concat run-tests ; + +: run-module ( name -- ) + dup require + dup module module-main [ + assert-depth + ] [ + "The module " write write + " does not define an entry point." print + "To define one, see the documentation for the " write + \ MAIN: ($link) " word." print + ] ?if ; + +: modules-help ( -- seq ) + modules get [ module-help ] map [ ] subset ; + +M: module synopsis* + \ PROVIDE: pprint-word + [ module-name ] keep presented associate styled-text ; + +M: module definition module>alist t ; + +M: module where module-loc ; + +: module-dir? ( path -- ? ) + "load.factor" path+ resource-path exists? ; + +: (available-modules) ( path -- ) + dup resource-path directory [ path+ ] map-with + dup [ module-dir? ] subset % + [ (available-modules) ] each ; + +: small-modules ( path -- seq ) + dup resource-path directory [ path+ ] map-with + [ ".factor" tail? ] subset + [ ".factor" ?tail drop ] map ; + +: available-modules ( -- seq ) + [ + "core" (available-modules) + "apps" (available-modules) + "apps" small-modules % + "libs" (available-modules) + "libs" small-modules % + "demos" (available-modules) + "demos" small-modules % + ] { } make natural-sort + [ dup module [ ] [ ] ?if ] map ; + +: module-string ( obj -- str ) + dup module-name swap module? [ " (loaded)" append ] when ; + +: modules. ( -- ) + available-modules + [ [ module-string ] keep write-object terpri ] each ; diff --git a/core/tools/modules.facts b/core/tools/modules.facts new file mode 100644 index 0000000000..ea415bdc7c --- /dev/null +++ b/core/tools/modules.facts @@ -0,0 +1,17 @@ +IN: modules +USING: help ; + +HELP: test-module +{ $values { "name" "a module name string" } } +{ $description "Runs the unit test files associated to the module by a previous call to " { $link provide } " or " { $link POSTPONE: PROVIDE: } "." } ; + +HELP: test-modules +{ $description "Runs unit test files for all loaded modules." } ; + +HELP: run-module +{ $values { "name" "a module name string" } } +{ $description "Runs the main entry point of the module, first loading the module if necessary using " { $link require } ". Entry points can be defined with the " { $link POSTPONE: MAIN: } " word." } ; + +HELP: modules-help +{ $values { "seq" "a new sequence" } } +{ $description "Outputs a sequence of help articles which are the main entry points into the documentation of loaded modules. Modules can define documentation entry points with the " { $link +help+ } " key of the association list given in " { $link POSTPONE: PROVIDE: } "." } ; diff --git a/core/tools/test.factor b/core/tools/test.factor index f71cb8a10a..8a47cab772 100644 --- a/core/tools/test.factor +++ b/core/tools/test.factor @@ -5,12 +5,6 @@ USING: arrays errors hashtables tools io kernel math memory namespaces parser prettyprint sequences strings words vectors ; -TUPLE: assert got expect ; - -: assert ( got expect -- * ) throw ; - -: assert= ( a b -- ) 2dup = [ 2drop ] [ assert ] if ; - : print-test ( input output -- ) "----> Quotation: " write . "Expected output: " write . flush ; @@ -35,8 +29,6 @@ TUPLE: assert got expect ; [ f ] swap [ [ call t ] [ 2drop f ] recover ] curry unit-test ; -: assert-depth ( quot -- ) depth slip depth swap assert= ; - SYMBOL: failures : failure failures [ ?push ] change ; diff --git a/core/tools/test.facts b/core/tools/test.facts index 12a1d55e90..a99e503480 100644 --- a/core/tools/test.facts +++ b/core/tools/test.facts @@ -1,12 +1,6 @@ IN: test USING: help kernel ; -HELP: assert -{ $values { "got" "the obtained value" } { "expect" "the expected value" } } -{ $description "Throws an " { $link assert } " error." } -{ $error-description "Thrown when a unit test or other assertion fails." } -{ $see-also unit-test unit-test-fails assert-depth } ; - HELP: benchmark { $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." } @@ -27,7 +21,3 @@ HELP: unit-test-fails { $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 -{ $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." } ; diff --git a/core/test/annotate.factor b/core/tools/test/annotate.factor similarity index 100% rename from core/test/annotate.factor rename to core/tools/test/annotate.factor diff --git a/core/test/inspector.factor b/core/tools/test/inspector.factor similarity index 100% rename from core/test/inspector.factor rename to core/tools/test/inspector.factor diff --git a/core/test/interpreter.factor b/core/tools/test/interpreter.factor similarity index 100% rename from core/test/interpreter.factor rename to core/tools/test/interpreter.factor diff --git a/core/test/memory.factor b/core/tools/test/memory.factor similarity index 100% rename from core/test/memory.factor rename to core/tools/test/memory.factor diff --git a/core/test/tools.factor b/core/tools/test/tools.factor similarity index 100% rename from core/test/tools.factor rename to core/tools/test/tools.factor diff --git a/core/ui/cocoa/load.factor b/core/ui/cocoa/load.factor index 90d6469c63..d41b5234f1 100644 --- a/core/ui/cocoa/load.factor +++ b/core/ui/cocoa/load.factor @@ -1,6 +1,6 @@ USING: compiler io parser sequences words ; -REQUIRES: core/compiler/alien/objc ; +REQUIRES: core/compiler/alien/objc core/ui/tools ; PROVIDE: core/ui/cocoa { +files+ { diff --git a/core/ui/debugger.factor b/core/ui/debugger.factor index 771f4821d9..a8e910848b 100644 --- a/core/ui/debugger.factor +++ b/core/ui/debugger.factor @@ -1,8 +1,5 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -IN: gadgets-listener -DEFER: call-listener - IN: gadgets USING: arrays errors gadgets gadgets-buttons gadgets-labels gadgets-panes gadgets-presentations @@ -10,9 +7,6 @@ gadgets-scrolling gadgets-theme gadgets-viewports gadgets-lists generic hashtables io kernel math models namespaces prettyprint queues sequences test threads help sequences words timers ; -: - [ call-listener drop ] curry ; - : ( error restart-hook -- gadget ) [ restart-name ] rot compute-restarts ; @@ -21,7 +15,7 @@ TUPLE: debugger restarts ; : ( error restart-list -- gadget ) >r [ print-error ] make-pane r> 2array make-filled-pile ; -C: debugger ( error restart-hook -- gadget ) +C: debugger ( error restarts restart-hook -- gadget ) { { [ gadget get { debugger } ] @@ -38,18 +32,9 @@ C: debugger ( error restart-hook -- gadget ) M: debugger focusable-child* debugger-restarts ; -debugger "toolbar" { - { "Data stack" T{ key-down f f "s" } [ :s ] } - { "Retain stack" T{ key-down f f "r" } [ :r ] } - { "Call stack" T{ key-down f f "c" } [ :c ] } - { "Help" T{ key-down f f "h" } [ :help ] } - { "Edit" T{ key-down f f "e" } [ :edit ] } -} [ - first3 [ call-listener drop ] curry 3array -] map define-commands - : debugger-window ( error -- ) - [ drop ] + #! No restarts for the debugger window + f [ drop ] "Error" open-titled-window ; : ui-try ( quot -- ) diff --git a/core/ui/gadgets/presentations.factor b/core/ui/gadgets/presentations.factor index c0ac80c82b..2c08affd0b 100644 --- a/core/ui/gadgets/presentations.factor +++ b/core/ui/gadgets/presentations.factor @@ -1,8 +1,5 @@ ! Copyright (C) 2005, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -IN: gadgets-listener -DEFER: call-listener - IN: gadgets-presentations USING: arrays definitions gadgets gadgets-borders gadgets-buttons gadgets-labels gadgets-outliner diff --git a/core/ui/load.factor b/core/ui/load.factor index 61f47a11c1..a4d31baf5f 100644 --- a/core/ui/load.factor +++ b/core/ui/load.factor @@ -42,16 +42,6 @@ PROVIDE: core/ui "text/interactor.factor" "debugger.factor" "ui.factor" - "tools/tools.factor" - "tools/messages.factor" - "tools/listener.factor" - "tools/walker.factor" - "tools/browser.factor" - "tools/help.factor" - "tools/dataflow.factor" - "tools/workspace.factor" - "tools/search.factor" - "tools/operations.factor" "text/editor.facts" } } { +tests+ { @@ -59,7 +49,6 @@ PROVIDE: core/ui "test/gadgets.factor" "test/models.factor" "test/document.factor" - "test/listener.factor" "test/lists.factor" "test/rectangles.factor" "test/commands.factor" diff --git a/core/ui/tools/listener.factor b/core/ui/tools/listener.factor index 4ecc823478..4c7f5b1b73 100644 --- a/core/ui/tools/listener.factor +++ b/core/ui/tools/listener.factor @@ -131,3 +131,13 @@ listener-gadget "toolbar" { } { "Send EOF" f [ listener-eof ] } } define-commands + +debugger "toolbar" { + { "Data stack" T{ key-down f f "s" } [ :s ] } + { "Retain stack" T{ key-down f f "r" } [ :r ] } + { "Call stack" T{ key-down f f "c" } [ :c ] } + { "Help" T{ key-down f f "h" } [ :help ] } + { "Edit" T{ key-down f f "e" } [ :edit ] } +} [ + first3 [ call-listener drop ] curry 3array +] map define-commands diff --git a/core/ui/tools/load.factor b/core/ui/tools/load.factor new file mode 100644 index 0000000000..6aa4ce20be --- /dev/null +++ b/core/ui/tools/load.factor @@ -0,0 +1,18 @@ +REQUIRES: core/ui ; + +PROVIDE: core/ui/tools +{ +files+ { + "tools.factor" + "messages.factor" + "listener.factor" + "walker.factor" + "browser.factor" + "help.factor" + "dataflow.factor" + "workspace.factor" + "search.factor" + "operations.factor" +} } +{ +tests+ { + "test/listener.factor" +} } ; diff --git a/core/ui/tools/search.factor b/core/ui/tools/search.factor index b1c4b583c3..9fea970028 100644 --- a/core/ui/tools/search.factor +++ b/core/ui/tools/search.factor @@ -80,8 +80,7 @@ M: live-search focusable-child* live-search-field ; [ first ] map ; : ( string -- gadget ) - all-articles [ dup article-title 2array ] map - [ [ second ] 2apply <=> ] sort + all-articles [ dup article-title 2array ] map sort-values [ help-completions ] [ article-title ] ; diff --git a/core/ui/test/listener.factor b/core/ui/tools/test/listener.factor similarity index 100% rename from core/ui/test/listener.factor rename to core/ui/tools/test/listener.factor diff --git a/core/ui/tools/workspace.factor b/core/ui/tools/workspace.factor index 62134096a3..becfe93e26 100644 --- a/core/ui/tools/workspace.factor +++ b/core/ui/tools/workspace.factor @@ -136,6 +136,7 @@ workspace "scrolling" { workspace "tool-switch" { { "Hide popup" T{ key-down f f "ESCAPE" } [ hide-popup ] } + { "Hide popup" T{ key-down f f "ENTER" } [ hide-popup ] } { "Listener" T{ key-down f f "F2" } [ listener-gadget select-tool ] } { "Messages" T{ key-down f f "F3" } [ messages select-tool ] } { "Definitions" T{ key-down f f "F4" } [ browser select-tool ] } diff --git a/core/ui/windows/load.factor b/core/ui/windows/load.factor index 6c0cce586a..b9d7474145 100644 --- a/core/ui/windows/load.factor +++ b/core/ui/windows/load.factor @@ -1,4 +1,4 @@ -REQUIRES: core/windows ; +REQUIRES: core/windows core/ui/tools ; PROVIDE: core/ui/windows { +files+ { "clipboard.factor" diff --git a/core/ui/x11/load.factor b/core/ui/x11/load.factor index 1dfd125e45..648453afae 100644 --- a/core/ui/x11/load.factor +++ b/core/ui/x11/load.factor @@ -1,6 +1,8 @@ ! Copyright (C) 2005, 2006 Eduardo Cavazos ! See http://factorcode.org/license.txt for BSD license. +REQUIRES: core/ui/tools ; + PROVIDE: core/ui/x11 { +files+ { "xlib.factor"