diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor index fd21c9646c..74768c7443 100644 --- a/basis/bootstrap/stage2.factor +++ b/basis/bootstrap/stage2.factor @@ -81,13 +81,11 @@ SYMBOL: bootstrap-time "none" require ] if - [ - load-components + load-components - millis over - core-bootstrap-time set-global + millis over - core-bootstrap-time set-global - run-bootstrap-init - ] with-compiler-errors + run-bootstrap-init f error set-global f error-continuation set-global diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index cf1d81fbc2..a220de476a 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -380,7 +380,7 @@ TUPLE: no-such-library name ; M: no-such-library summary drop "Library not found" ; -M: no-such-library source-file-error-type drop +linkage-error+ ; +M: no-such-library error-type drop +linkage-error+ ; : no-such-library ( name -- ) \ no-such-library boa @@ -391,7 +391,7 @@ TUPLE: no-such-symbol name ; M: no-such-symbol summary drop "Symbol not found" ; -M: no-such-symbol source-file-error-type drop +linkage-error+ ; +M: no-such-symbol error-type drop +linkage-error+ ; : no-such-symbol ( name -- ) \ no-such-symbol boa diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index 2492b6cc23..0afe7f1141 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -53,11 +53,18 @@ SYMBOLS: +optimized+ +unoptimized+ ; f swap compiler-error ; : ignore-error? ( word error -- ? ) - [ [ inline? ] [ macro? ] bi or ] - [ source-file-error-type +compiler-warning+ eq? ] bi* and ; + [ + { + [ inline? ] + [ macro? ] + [ "transform-quot" word-prop ] + [ "no-compile" word-prop ] + [ "special" word-prop ] + } 1|| + ] [ error-type +compiler-warning+ eq? ] bi* and ; : fail ( word error -- * ) - [ 2dup ignore-error? [ 2drop ] [ swap compiler-error ] if ] + [ 2dup ignore-error? [ drop f ] when swap compiler-error ] [ drop [ compiled-unxref ] @@ -122,6 +129,8 @@ t compile-dependencies? set-global : compile-call ( quot -- ) [ dup infer define-temp ] with-compilation-unit execute ; +\ compile-call t "no-compile" set-word-prop + SINGLETON: optimizing-compiler M: optimizing-compiler recompile ( words -- alist ) diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor index 6fa5eae185..4a15f864a6 100644 --- a/basis/help/lint/checks/checks.factor +++ b/basis/help/lint/checks/checks.factor @@ -124,11 +124,11 @@ SYMBOL: vocab-articles : check-class-description ( word element -- ) [ class? not ] [ { $class-description } swap elements empty? not ] bi* and - [ "A word that is not a class has a $class-description" throw ] when ; + [ "A word that is not a class has a $class-description" simple-lint-error ] when ; : check-article-title ( article -- ) article-title first LETTER? - [ "Article title must begin with a capital letter" throw ] unless ; + [ "Article title must begin with a capital letter" simple-lint-error ] unless ; : check-elements ( element -- ) { diff --git a/basis/help/lint/lint-docs.factor b/basis/help/lint/lint-docs.factor index 0c0fcf92d2..ed74748356 100644 --- a/basis/help/lint/lint-docs.factor +++ b/basis/help/lint/lint-docs.factor @@ -14,6 +14,10 @@ $nl "To run help lint, use one of the following two words:" { $subsection help-lint } { $subsection help-lint-all } +"Once a help lint run completes, failures can be listed:" +{ $subsection :lint-failures } +"Help lint failures are also shown in the " { $link "ui.tools.error-list" } "." +$nl "Help lint performs the following checks:" { $list "ensures examples run and produce stated output" diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor index e25070126c..ec373882a2 100755 --- a/basis/help/lint/lint.factor +++ b/basis/help/lint/lint.factor @@ -3,7 +3,7 @@ USING: assocs continuations fry help help.lint.checks help.topics io kernel namespaces parser sequences source-files.errors tools.vocabs vocabs words classes -locals ; +locals tools.errors ; FROM: help.lint.checks => all-vocabs ; IN: help.lint @@ -15,11 +15,15 @@ TUPLE: help-lint-error < source-file-error ; SYMBOL: +help-lint-failure+ -+help-lint-failure+ -"vocab:ui/tools/error-list/icons/help-lint-error.tiff" -[ lint-failures get values ] define-error-type +T{ error-type + { type +help-lint-failure+ } + { word ":lint-failures" } + { plural "help lint failures" } + { icon "vocab:ui/tools/error-list/icons/help-lint-error.tiff" } + { quot [ lint-failures get values ] } +} define-error-type -M: help-lint-error source-file-error-type drop +help-lint-failure+ ; +M: help-lint-error error-type drop +help-lint-failure+ ; : check-vocab ( vocab -- ) "Checking " write dup write "..." print - vocab - [ check-about ] + [ vocab check-about ] [ words [ check-word ] each ] [ vocab-articles get at [ check-article ] each ] tri ; @@ -84,6 +87,8 @@ PRIVATE> : help-lint-all ( -- ) "" help-lint ; +: :lint-failures ( -- ) lint-failures get errors. ; + : unlinked-words ( words -- seq ) all-word-help [ article-parent not ] filter ; diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor index 4f7ccf227e..1f01388c14 100644 --- a/basis/listener/listener.factor +++ b/basis/listener/listener.factor @@ -4,7 +4,7 @@ USING: arrays hashtables io kernel math math.parser memory namespaces parser lexer sequences strings io.styles vectors words generic system combinators continuations debugger definitions compiler.units accessors colors prettyprint fry -sets vocabs.parser ; +sets vocabs.parser source-files.errors ; IN: listener GENERIC: stream-read-quot ( stream -- quot/f ) @@ -68,6 +68,8 @@ SYMBOL: max-stack-items 10 max-stack-items set-global +SYMBOL: error-summary-hook + > packer call ] [ "memoize" word-prop delete-at ] bi ; + +\ invalidate-memoized t "no-compile" set-word-prop \ No newline at end of file diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor index 799e3f73e3..156900f727 100644 --- a/basis/stack-checker/errors/errors.factor +++ b/basis/stack-checker/errors/errors.factor @@ -11,7 +11,7 @@ IN: stack-checker.errors TUPLE: inference-error error type word ; -M: inference-error source-file-error-type type>> ; +M: inference-error error-type type>> ; : (inference-error) ( ... class type -- * ) [ boa ] dip diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index c55e69a8a2..ff7288202a 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -218,8 +218,7 @@ M: object infer-call* alien-callback } [ t "special" set-word-prop ] each -{ call execute dispatch load-locals get-local drop-locals } -[ t "no-compile" set-word-prop ] each +\ clear t "no-compile" set-word-prop : non-inline-word ( word -- ) dup called-dependency depends-on diff --git a/basis/tools/errors/errors-docs.factor b/basis/tools/errors/errors-docs.factor index b66b557a81..456f39c041 100644 --- a/basis/tools/errors/errors-docs.factor +++ b/basis/tools/errors/errors-docs.factor @@ -5,28 +5,20 @@ words quotations io ; ARTICLE: "compiler-errors" "Compiler warnings and errors" "After loading a vocabulary, you might see messages like:" { $code - ":errors - print 2 compiler errors." - ":warnings - print 50 compiler warnings." + ":errors - print 2 compiler errors" + ":warnings - print 50 compiler warnings" } -"These warnings arise from the compiler's stack effect checker. Warnings are non-fatal conditions -- not all code has a static stack effect, so you try to minimize warnings but understand that in many cases they cannot be eliminated. Errors indicate programming mistakes, such as erroneous stack effect declarations." -$nl -"The precise warning and error conditions are documented in " { $link "inference-errors" } "." +"These messages arise from the compiler's stack effect checker. Production code should not have any warnings and errors in it. Warning and error conditions are documented in " { $link "inference-errors" } "." $nl "Words to view warnings and errors:" -{ $subsection :errors } { $subsection :warnings } +{ $subsection :errors } { $subsection :linkage } -"Words such as " { $link require } " use a combinator which counts errors and prints a report at the end:" -{ $subsection with-compiler-errors } ; +"Compiler warnings and errors are also shown in the " { $link "ui.tools.error-list" } "." ; HELP: compiler-error { $values { "error" "an error" } { "word" word } } -{ $description "If inside a " { $link with-compiler-errors } ", saves the error for future persual via " { $link :errors } ", " { $link :warnings } " and " { $link :linkage } ". If not inside a " { $link with-compiler-errors } ", ignores the error." } ; - -HELP: with-compiler-errors -{ $values { "quot" quotation } } -{ $description "Calls the quotation and collects any compiler warnings and errors. Compiler warnings and errors are summarized at the end and can be viewed with " { $link :errors } ", " { $link :warnings } ", and " { $link :linkage } "." } -{ $notes "Nested calls to " { $link with-compiler-errors } " are ignored, and only the outermost call collects warnings and errors." } ; +{ $description "Saves the error for future persual via " { $link :errors } ", " { $link :warnings } " and " { $link :linkage } "." } ; HELP: :errors { $description "Prints all serious compiler errors from the most recent compile to " { $link output-stream } "." } ; diff --git a/basis/tools/test/test-docs.factor b/basis/tools/test/test-docs.factor index 06a54f0868..03e068d795 100644 --- a/basis/tools/test/test-docs.factor +++ b/basis/tools/test/test-docs.factor @@ -16,7 +16,9 @@ ARTICLE: "tools.test.run" "Running unit tests" { $subsection test } { $subsection test-all } "The following word prints failures:" -{ $subsection :failures } +{ $subsection :test-failures } +"Help lint failures are also shown in the " { $link "ui.tools.error-list" } "." +$nl "Unit test failurs are instances of a class, and are stored in a global variable:" { $subsection test-failure } { $subsection test-failures } ; @@ -70,5 +72,5 @@ HELP: test HELP: test-all { $description "Runs unit tests for all loaded vocabularies." } ; -HELP: :failures +HELP: :test-failures { $description "Prints all pending unit test failures." } ; diff --git a/basis/tools/test/test.factor b/basis/tools/test/test.factor index 9a9be7ddd3..b2340a2c52 100644 --- a/basis/tools/test/test.factor +++ b/basis/tools/test/test.factor @@ -13,13 +13,19 @@ TUPLE: test-failure < source-file-error continuation ; SYMBOL: +test-failure+ -M: test-failure source-file-error-type drop +test-failure+ ; +M: test-failure error-type drop +test-failure+ ; SYMBOL: test-failures test-failures [ V{ } clone ] initialize -+test-failure+ "vocab:ui/tools/error-list/icons/unit-test-error.tiff" [ test-failures get ] define-error-type +T{ error-type + { type +test-failure+ } + { word ":test-failures" } + { plural "unit test failures" } + { icon "vocab:ui/tools/error-list/icons/unit-test-error.tiff" } + { quot [ test-failures get ] } +} define-error-type > call ] [ object>> ] bi ] dip + [ [ dup hook>> call( presentation -- ) ] [ object>> ] bi ] dip invoke-command ; : invoke-primary ( presentation -- ) diff --git a/basis/ui/gadgets/slots/slots.factor b/basis/ui/gadgets/slots/slots.factor index 592900d0cb..00023626a7 100644 --- a/basis/ui/gadgets/slots/slots.factor +++ b/basis/ui/gadgets/slots/slots.factor @@ -23,14 +23,14 @@ TUPLE: slot-editor < track ref close-hook update-hook text ; } define-command : close ( slot-editor -- ) - dup close-hook>> call ; + dup close-hook>> call( slot-editor -- ) ; \ close H{ { +description+ "Close the slot editor without saving changes." } } define-command : close-and-update ( slot-editor -- ) - [ update-hook>> call ] [ close ] bi ; + [ update-hook>> call( -- ) ] [ close ] bi ; : slot-editor-value ( slot-editor -- object ) text>> control-value parse-fresh first ; diff --git a/basis/ui/operations/operations-docs.factor b/basis/ui/operations/operations-docs.factor index cfec6613b1..4114a2c3b2 100644 --- a/basis/ui/operations/operations-docs.factor +++ b/basis/ui/operations/operations-docs.factor @@ -4,7 +4,7 @@ ui.gestures ; IN: ui.operations : $operations ( element -- ) - >quotation call + >quotation call( -- obj ) f operations>commands command-map. ; diff --git a/basis/ui/tools/error-list/error-list-docs.factor b/basis/ui/tools/error-list/error-list-docs.factor index e4d15a0ea9..514812ed48 100644 --- a/basis/ui/tools/error-list/error-list-docs.factor +++ b/basis/ui/tools/error-list/error-list-docs.factor @@ -1,8 +1,8 @@ IN: ui.tools.error-list -USING: help.markup help.syntax ; +USING: help.markup help.syntax ui.tools.common ui.commands ; ARTICLE: "ui.tools.error-list" "UI error list tool" -"The error list tool displays messages generated by tools which process source files and definitions." +"The error list tool displays messages generated by tools which process source files and definitions. To display the error list, press " { $command tool "common" show-error-list } " in any UI tool window." $nl "The " { $vocab-link "source-files.errors" } " vocabulary contains backend code used by this tool." { $heading "Message icons" } diff --git a/basis/ui/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor index 23db13533f..ceb5ff0921 100644 --- a/basis/ui/tools/error-list/error-list.factor +++ b/basis/ui/tools/error-list/error-list.factor @@ -4,14 +4,14 @@ USING: accessors arrays sequences sorting assocs colors.constants fry combinators combinators.smart combinators.short-circuit editors make memoize compiler.units fonts kernel io.pathnames prettyprint source-files.errors math.parser init math.order models models.arrow -models.arrow.smart models.search models.mapping debugger namespaces +models.arrow.smart models.search models.mapping models.delay debugger namespaces summary locals ui ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.tables ui.gadgets.labeled ui.gadgets.tracks ui.gestures ui.operations ui.tools.browser ui.tools.common ui.gadgets.scrollers ui.tools.inspector ui.gadgets.status-bar ui.operations ui.gadgets.buttons ui.gadgets.borders ui.gadgets.packs ui.gadgets.labels ui.baseline-alignment ui.images -compiler.errors ; +compiler.errors calendar ; IN: ui.tools.error-list CONSTANT: source-file-icon @@ -26,7 +26,7 @@ MEMO: error-icon ( type -- image-name ) : ( -- model gadget ) #! Linkage errors are not shown by default. - error-types [ dup +linkage-error+ eq? not ] { } map>assoc + error-types get keys [ dup +linkage-error+ eq? not ] { } map>assoc [ [ [ error-icon ] dip ] assoc-map ] [ ] bi ; @@ -75,7 +75,7 @@ SINGLETON: error-renderer M: error-renderer row-columns drop [ { - [ source-file-error-type error-icon ] + [ error-type error-icon ] [ line#>> number>string ] [ asset>> unparse-short ] [ error>> summary ] @@ -142,7 +142,7 @@ error-display "toolbar" f { [ ] [ error-toggle>> "Show errors:" label-on-left add-gadget ] bi ; : ( visible-errors model -- model' ) - [ swap '[ source-file-error-type _ at ] filter ] ; + [ swap '[ error-type _ at ] filter ] ; :: ( model -- gadget ) vertical error-list-gadget new-track @@ -173,23 +173,26 @@ error-list-gadget "toolbar" f { { T{ key-down f f "F1" } error-list-help } } define-command-map -SYMBOL: compiler-error-model +SYMBOL: error-list-model -compiler-error-model [ f ] initialize +error-list-model [ f ] initialize SINGLETON: updater -M: updater definitions-changed - 2drop - all-errors - compiler-error-model get-global - set-model ; +M: updater errors-changed + drop f error-list-model get-global set-model ; -[ - updater remove-definition-observer - updater add-definition-observer -] "ui.tools.error-list" add-init-hook +[ updater add-error-observer ] "ui.tools.error-list" add-init-hook + +: ( -- model ) + error-list-model get-global + 1/2 seconds [ drop all-errors ] ; : error-list-window ( -- ) - compiler-error-model get-global - "Errors" open-status-window ; \ No newline at end of file + "Errors" open-status-window ; + +: show-error-list ( -- ) + [ error-list-gadget? ] find-window + [ raise-window ] [ error-list-window ] if* ; + +\ show-error-list H{ { +nullary+ t } } define-command diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 7cb3c70cbc..97821d61c7 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs calendar combinators locals -colors.constants combinators.short-circuit compiler.units -help.tips concurrency.flags concurrency.mailboxes continuations -destructors documents documents.elements fry hashtables help -help.markup io io.styles kernel lexer listener math models +source-files.errors colors.constants combinators.short-circuit +compiler.units help.tips concurrency.flags concurrency.mailboxes +continuations destructors documents documents.elements fry hashtables +help help.markup io io.styles kernel lexer listener math models models.delay models.arrow namespaces parser prettyprint quotations sequences strings threads tools.vocabs vocabs vocabs.loader vocabs.parser words debugger ui ui.commands ui.pens.solid ui.gadgets @@ -13,7 +13,7 @@ ui.gadgets.labeled ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.borders ui.gestures ui.operations ui.tools.browser ui.tools.common ui.tools.debugger ui.tools.listener.completion ui.tools.listener.popups -ui.tools.listener.history ; +ui.tools.listener.history ui.tools.error-list ; IN: ui.tools.listener ! If waiting is t, we're waiting for user input, and invoking @@ -356,10 +356,17 @@ interactor "completion" f { { T{ key-down f { C+ } "r" } history-completion-popup } } define-command-map +: ui-error-summary ( -- ) + all-errors empty? [ + { "Press " { $command tool "common" show-error-list } " to view errors." } + print-element nl + ] unless ; + : listener-thread ( listener -- ) dup listener-streams [ [ com-browse ] help-hook set '[ [ _ input>> ] 2dip debugger-popup ] error-hook set + [ ui-error-summary ] error-summary-hook set tip-of-the-day. nl listener ] with-streams* ; diff --git a/basis/ui/tools/tools.factor b/basis/ui/tools/tools.factor index cd4216b7a1..c825c60dbb 100644 --- a/basis/ui/tools/tools.factor +++ b/basis/ui/tools/tools.factor @@ -30,4 +30,5 @@ tool "common" f { { T{ key-down f { A+ } "w" } close-window } { T{ key-down f { A+ } "q" } com-exit } { T{ key-down f f "F2" } refresh-all } + { T{ key-down f f "F3" } show-error-list } } define-command-map \ No newline at end of file diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index 4c600e06ca..1438edf3fa 100755 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -86,6 +86,8 @@ ERROR: no-case object ; ] [ callable? ] if ] find nip ; +\ case-find t "no-compile" set-word-prop + : case ( obj assoc -- ) case-find { { [ dup array? ] [ nip second call ] } diff --git a/core/compiler/errors/errors-docs.factor b/core/compiler/errors/errors-docs.factor index 987db582b4..6dbe5193aa 100644 --- a/core/compiler/errors/errors-docs.factor +++ b/core/compiler/errors/errors-docs.factor @@ -2,7 +2,4 @@ IN: compiler.errors USING: help.markup help.syntax vocabs.loader words io quotations words.symbol ; -HELP: compiler-errors -{ $var-description "Global variable holding an assoc mapping words to compiler errors. This variable is set by " { $link with-compiler-errors } "." } ; - ABOUT: "compiler-errors" diff --git a/core/compiler/errors/errors.factor b/core/compiler/errors/errors.factor index 00f9860b3a..7e384d1a71 100644 --- a/core/compiler/errors/errors.factor +++ b/core/compiler/errors/errors.factor @@ -1,13 +1,11 @@ ! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel namespaces make assocs io sequences -continuations math math.parser accessors definitions -source-files.errors ; +USING: accessors source-files.errors kernel namespaces assocs ; IN: compiler.errors TUPLE: compiler-error < source-file-error ; -M: compiler-error source-file-error-type error>> source-file-error-type ; +M: compiler-error error-type error>> error-type ; SYMBOL: compiler-errors @@ -15,34 +13,34 @@ compiler-errors [ H{ } clone ] initialize SYMBOLS: +compiler-error+ +compiler-warning+ +linkage-error+ ; -+compiler-error+ "vocab:ui/tools/error-list/icons/compiler-error.tiff" [ compiler-errors get values ] define-error-type -+compiler-warning+ "vocab:ui/tools/error-list/icons/compiler-warning.tiff" [ f ] define-error-type -+linkage-error+ "vocab:ui/tools/error-list/icons/linkage-error.tiff" [ f ] define-error-type - -SYMBOL: with-compiler-errors? - : errors-of-type ( type -- assoc ) compiler-errors get-global - swap [ [ nip source-file-error-type ] dip eq? ] curry + swap [ [ nip error-type ] dip eq? ] curry assoc-filter ; -: (compiler-report) ( what type word -- ) - over errors-of-type assoc-empty? [ 3drop ] [ - [ - ":" % - % - " - print " % - errors-of-type assoc-size # - " " % - % - "." % - ] "" make print - ] if ; +T{ error-type + { type +compiler-error+ } + { word ":errors" } + { plural "compiler errors" } + { icon "vocab:ui/tools/error-list/icons/compiler-error.tiff" } + { quot [ +compiler-error+ errors-of-type values ] } +} define-error-type -: compiler-report ( -- ) - "compiler errors" +compiler-error+ "errors" (compiler-report) - "compiler warnings" +compiler-warning+ "warnings" (compiler-report) - "linkage errors" +linkage-error+ "linkage" (compiler-report) ; +T{ error-type + { type +compiler-warning+ } + { word ":warnings" } + { plural "compiler warnings" } + { icon "vocab:ui/tools/error-list/icons/compiler-warning.tiff" } + { quot [ +compiler-warning+ errors-of-type values ] } +} define-error-type + +T{ error-type + { type +linkage-error+ } + { word ":linkage" } + { plural "linkage errors" } + { icon "vocab:ui/tools/error-list/icons/linkage-error.tiff" } + { quot [ +linkage-error+ errors-of-type values ] } +} define-error-type : ( error word -- compiler-error ) \ compiler-error ; @@ -50,11 +48,3 @@ SYMBOL: with-compiler-errors? : compiler-error ( error word -- ) compiler-errors get-global pick [ [ [ ] keep ] dip set-at ] [ delete-at drop ] if ; - -: with-compiler-errors ( quot -- ) - with-compiler-errors? get "quiet" get or [ call ] [ - [ - with-compiler-errors? on - [ compiler-report ] [ ] cleanup - ] with-scope - ] if ; inline diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index e8b5b4647d..b5760b8de6 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -62,7 +62,7 @@ GENERIC: definitions-changed ( assoc obj -- ) definition-observers get push ; : remove-definition-observer ( obj -- ) - definition-observers get delete ; + definition-observers get delq ; : notify-definition-observers ( assoc -- ) definition-observers get diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor index 051d28d8c2..e350b24856 100644 --- a/core/continuations/continuations.factor +++ b/core/continuations/continuations.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays vectors kernel kernel.private sequences namespaces make math splitting sorting quotations assocs -combinators combinators.private accessors ; +combinators combinators.private accessors words ; IN: continuations SYMBOL: error @@ -81,6 +81,8 @@ C: continuation [ set-datastack ] dip set-callstack ; +\ (continue) t "no-compile" set-word-prop + PRIVATE> : continue-with ( obj continuation -- * ) diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 65a802dc2d..7fdb339069 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -33,6 +33,8 @@ M: generic definition drop f ; GENERIC: effective-method ( generic -- method ) +\ effective-method t "no-compile" set-word-prop + : next-method-class ( class generic -- class/f ) order [ class<= ] with filter reverse dup length 1 = [ drop f ] [ second ] if ; diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 04fa7fa03f..62a8e01c44 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -281,11 +281,9 @@ print-use-hook [ [ ] ] initialize : parse-file ( file -- quot ) [ - [ - [ parsing-file ] keep - [ utf8 ] keep - parse-stream - ] with-compiler-errors + [ parsing-file ] keep + [ utf8 ] keep + parse-stream ] [ over parse-file-restarts rethrow-restarts drop parse-file diff --git a/core/source-files/errors/errors.factor b/core/source-files/errors/errors.factor index faabc6a37a..880472bc0a 100644 --- a/core/source-files/errors/errors.factor +++ b/core/source-files/errors/errors.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs kernel math.order sorting sequences definitions -namespaces arrays splitting io math.parser math ; +namespaces arrays splitting io math.parser math init ; IN: source-files.errors TUPLE: source-file-error error asset file line# ; @@ -12,7 +12,9 @@ TUPLE: source-file-error error asset file line# ; : group-by-source-file ( errors -- assoc ) H{ } clone [ [ push-at ] curry [ dup file>> ] prepose each ] keep ; -GENERIC: source-file-error-type ( error -- type ) +TUPLE: error-type type word plural icon quot ; + +GENERIC: error-type ( error -- type ) : ( error definition class -- source-file-error ) new @@ -26,36 +28,43 @@ GENERIC: source-file-error-type ( error -- type ) : delete-file-errors ( seq file type -- ) [ - [ swap file>> = ] [ swap source-file-error-type = ] + [ swap file>> = ] [ swap error-type = ] bi-curry* bi and not ] 2curry filter-here ; -SYMBOL: source-file-error-types +SYMBOL: error-types -source-file-error-types [ V{ } clone ] initialize +error-types [ V{ } clone ] initialize -: error-types ( -- seq ) source-file-error-types get keys ; - -: define-error-type ( type icon quot -- ) - 2array swap source-file-error-types get set-at ; +: define-error-type ( error-type -- ) + dup type>> error-types get set-at ; : error-icon-path ( type -- icon ) - source-file-error-types get at first ; + error-types get at icon>> ; : error-summary ( -- ) - source-file-error-types get [ - [ name>> "+" ?head drop "+" ?tail drop ] - [ second call length ] bi* - ] assoc-map + error-types get [ nip dup quot>> call( -- seq ) length ] assoc-map [ nip 0 > ] assoc-filter [ over - [ ":" write write ] - [ " - print " write number>string write bl ] - [ { { CHAR: - CHAR: \s } } substitute write "s" print ] tri* + [ word>> write ] + [ " - show " write number>string write bl ] + [ plural>> print ] tri* ] assoc-each ; : all-errors ( -- errors ) - source-file-error-types get - [ second second call( -- seq ) ] map - concat ; \ No newline at end of file + error-types get values + [ quot>> call( -- seq ) ] map + concat ; + +GENERIC: errors-changed ( observer -- ) + +SYMBOL: error-observers + +[ V{ } clone error-observers set-global ] "source-files.errors" add-init-hook + +: add-error-observer ( observer -- ) error-observers get push ; + +: remove-error-observer ( observer -- ) error-observers get delq ; + +: notify-error-observers ( -- ) error-observers get [ errors-changed ] each ; \ No newline at end of file diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index 4f9005e110..efe8cb2675 100644 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -80,11 +80,11 @@ SYMBOL: load-help? PRIVATE> : require ( vocab -- ) - [ load-vocab drop ] with-compiler-errors ; + load-vocab drop ; : reload ( name -- ) dup vocab - [ [ [ load-source ] [ load-docs ] bi ] with-compiler-errors ] + [ [ load-source ] [ load-docs ] bi ] [ require ] ?if ; @@ -125,9 +125,7 @@ PRIVATE> [ dup vocab-name blacklist get at* [ rethrow ] [ drop dup find-vocab-root - [ [ (load-vocab) ] with-compiler-errors ] - [ dup vocab [ ] [ no-vocab ] ?if ] - if + [ (load-vocab) ] [ dup vocab [ ] [ no-vocab ] ?if ] if ] if ] load-vocab-hook set-global