Merge branch 'smarter_error_list' of git://factorcode.org/git/factor into smarter_error_list

basis/bootstrap/stage2.factor

@@ -81,13 +81,11 @@ SYMBOL: bootstrap-time
         "none" require
     ] if
 
-    [
     load-components
 
     millis over - core-bootstrap-time set-global
 
     run-bootstrap-init
-    ] with-compiler-errors
 
     f error set-global
     f error-continuation set-global

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

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 )

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 -- )
     {

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"

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+
+T{ error-type
-"vocab:ui/tools/error-list/icons/help-lint-error.tiff"
+   { type +help-lint-failure+ }
-[ lint-failures get values ] define-error-type
+   { 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+ ;
 
 <PRIVATE
 
@@ -66,8 +70,7 @@ PRIVATE>
 
 : check-vocab ( vocab -- )
     "Checking " write dup write "..." print
-    vocab
+    [ vocab check-about ]
-    [ 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 ;
 

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
+
 <PRIVATE
 
 : title. ( string -- )
@@ -105,8 +107,10 @@ SYMBOL: max-stack-items
     "( " in get auto-use? get [ " - auto" append ] when " )" 3append
     H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
 
+[ error-summary ] error-summary-hook set-global
+
 : listen ( -- )
-    visible-vars. stacks. prompt.
+    error-summary-hook get call( -- ) visible-vars. stacks. prompt.
     [ read-quot [ [ call-error-hook ] recover ] [ bye ] if* ]
     [ dup lexer-error? [ call-error-hook ] [ rethrow ] if ] recover ;
 

basis/memoize/memoize.factor

@@ -61,3 +61,5 @@ M: memoized reset-word
 
 : invalidate-memoized ( inputs... word -- )
     [ stack-effect in>> packer call ] [ "memoize" word-prop delete-at ] bi ;
+
+\ invalidate-memoized t "no-compile" set-word-prop

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

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 }
+\ clear t "no-compile" set-word-prop
-[ t "no-compile" set-word-prop ] each
 
 : non-inline-word ( word -- )
     dup called-dependency depends-on

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."
+    ":errors - print 2 compiler errors"
-    ":warnings - print 50 compiler warnings."
+    ":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."
+"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
-"The precise 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:"
+"Compiler warnings and errors are also shown in the " { $link "ui.tools.error-list" } "." ;
-{ $subsection with-compiler-errors } ;
 
 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." } ;
+{ $description "Saves the error for future persual via " { $link :errors } ", " { $link :warnings } " and " { $link :linkage } "." } ;
-
-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." } ;
 
 HELP: :errors
 { $description "Prints all serious compiler errors from the most recent compile to " { $link output-stream } "." } ;

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." } ;

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
 
 <PRIVATE
 
@@ -130,12 +136,9 @@ M: test-failure error. ( error -- )
     [ traceback-button. ]
     bi ;
 
-: :failures ( -- ) test-failures get errors. ;
+: :test-failures ( -- ) test-failures get errors. ;
 
 : test ( prefix -- )
-    [ child-vocabs [ run-vocab-tests ] each ] with-compiler-errors
+    child-vocabs [ run-vocab-tests ] each ;
-    test-failures get [
-        ":failures - show " write length pprint " failing tests." print
-    ] unless-empty ;
 
 : test-all ( -- ) "" test ;

basis/tools/vocabs/vocabs.factor

@@ -78,7 +78,7 @@ SYMBOL: failures
             recover
         ] each
         failures get
-    ] with-compiler-errors ;
+    ] with-scope ;
 
 : source-modified? ( path -- ? )
     dup source-files get at [

basis/tools/walker/walker.factor

@@ -92,6 +92,18 @@ M: object add-breakpoint ;
 : (step-into-call-next-method) ( method -- )
     next-method-quot (step-into-quot) ;
 
+{
+    (step-into-quot)
+    (step-into-dip)
+    (step-into-2dip)
+    (step-into-3dip)
+    (step-into-if)
+    (step-into-dispatch)
+    (step-into-execute)
+    (step-into-continuation)
+    (step-into-call-next-method)
+} [ t "no-compile" set-word-prop ] each
+
 ! Messages sent to walker thread
 SYMBOL: step
 SYMBOL: step-out

basis/ui/backend/cocoa/tools/tools.factor

@@ -70,7 +70,7 @@ CLASS: {
 ! Service support; evaluate Factor code from other apps
 :: do-service ( pboard error quot -- )
     pboard error ?pasteboard-string
-    dup [ quot call ] when
+    dup [ quot call( string -- result/f ) ] when
     [ pboard set-pasteboard-string ] when* ;
 
 CLASS: {

basis/ui/gadgets/presentations/presentations.factor

@@ -10,7 +10,7 @@ IN: ui.gadgets.presentations
 TUPLE: presentation < button object hook ;
 
 : invoke-presentation ( presentation command -- )
-    [ [ dup hook>> call ] [ object>> ] bi ] dip
+    [ [ dup hook>> call( presentation -- ) ] [ object>> ] bi ] dip
     invoke-command ;
 
 : invoke-primary ( presentation -- )

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 ;

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. ;
 

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" }

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 )
 
 : <error-toggle> ( -- model gadget )
     #! Linkage errors are not shown by default.
-    error-types [ dup +linkage-error+ eq? not <model> ] { } map>assoc
+    error-types get keys [ dup +linkage-error+ eq? not <model> ] { } map>assoc
     [ [ [ error-icon ] dip ] assoc-map <checkboxes> ]
     [ <mapping> ] 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 {
     [ <toolbar> ] [ error-toggle>> "Show errors:" label-on-left add-gadget ] bi ;
 
 : <error-model> ( visible-errors model -- model' )
-    [ swap '[ source-file-error-type _ at ] filter ] <smart-arrow> ;
+    [ swap '[ error-type _ at ] filter ] <smart-arrow> ;
 
 :: <error-list-gadget> ( 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 <model> ] initialize
+error-list-model [ f <model> ] initialize
 
 SINGLETON: updater
 
-M: updater definitions-changed
+M: updater errors-changed
-    2drop
+    drop f error-list-model get-global set-model ;
-    all-errors
-    compiler-error-model get-global
-    set-model ;
 
-[
+[ updater add-error-observer ] "ui.tools.error-list" add-init-hook
-    updater remove-definition-observer
+
-    updater add-definition-observer
+: <error-list-model> ( -- model )
-] "ui.tools.error-list" add-init-hook
+    error-list-model get-global
+    1/2 seconds <delay> [ drop all-errors ] <arrow> ;
 
 : error-list-window ( -- )
-    compiler-error-model get-global <error-list-gadget>
+    <error-list-model> <error-list-gadget> "Errors" open-status-window ;
-    "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

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
+source-files.errors colors.constants combinators.short-circuit
-help.tips concurrency.flags concurrency.mailboxes continuations
+compiler.units help.tips concurrency.flags concurrency.mailboxes
-destructors documents documents.elements fry hashtables help
+continuations destructors documents documents.elements fry hashtables
-help.markup io io.styles kernel lexer listener math models
+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* ;

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

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 ] }

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"

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
+USING: accessors source-files.errors kernel namespaces assocs ;
-continuations math math.parser accessors definitions
-source-files.errors ;
 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 -- )
+T{ error-type
-    over errors-of-type assoc-empty? [ 3drop ] [
+   { type +compiler-error+ }
-        [
+   { word ":errors" }
-            ":" %
+   { plural "compiler errors" }
-            %
+   { icon "vocab:ui/tools/error-list/icons/compiler-error.tiff" }
-            " - print " %
+   { quot [ +compiler-error+ errors-of-type values ] }
-            errors-of-type assoc-size #
+} define-error-type
-            " " %
-            %
-            "." %
-        ] "" make print
-    ] if ;
 
-: compiler-report ( -- )
+T{ error-type
-    "compiler errors" +compiler-error+ "errors" (compiler-report)
+   { type +compiler-warning+ }
-    "compiler warnings" +compiler-warning+ "warnings" (compiler-report)
+   { word ":warnings" }
-    "linkage errors" +linkage-error+ "linkage" (compiler-report) ;
+   { 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
 
 : <compiler-error> ( error word -- compiler-error )
     \ compiler-error <definition-error> ;
@@ -50,11 +48,3 @@ SYMBOL: with-compiler-errors?
 : compiler-error ( error word -- )
     compiler-errors get-global pick
     [ [ [ <compiler-error> ] 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

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

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> continuation
     [ set-datastack ] dip
     set-callstack ;
 
+\ (continue) t "no-compile" set-word-prop
+
 PRIVATE>
 
 : continue-with ( obj continuation -- * )

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 ;

core/parser/parser.factor

@@ -280,12 +280,10 @@ print-use-hook [ [ ] ] initialize
     "Load " " again" surround t 2array 1array ;
 
 : parse-file ( file -- quot )
-    [
     [
         [ parsing-file ] keep
         [ utf8 <file-reader> ] keep
         parse-stream
-        ] with-compiler-errors
     ] [
         over parse-file-restarts rethrow-restarts
         drop parse-file

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 )
 
 : <definition-error> ( 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 ( error-type -- )
-
+    dup type>> error-types get set-at ;
-: define-error-type ( type icon quot -- )
-    2array swap source-file-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 [
+    error-types get [ nip dup quot>> call( -- seq ) length ] assoc-map
-        [ name>> "+" ?head drop "+" ?tail drop ]
-        [ second call length ] bi*
-    ] assoc-map
     [ nip 0 > ] assoc-filter
     [
         over
-        [ ":" write write ]
+        [ word>> write ]
-        [ " - print " write number>string write bl ]
+        [ " - show " write number>string write bl ]
-        [ { { CHAR: - CHAR: \s } } substitute write "s" print ] tri*
+        [ plural>> print ] tri*
     ] assoc-each ;
 
 : all-errors ( -- errors )
-    source-file-error-types get
+    error-types get values
-    [ second second call( -- seq ) ] map
+    [ 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 ;

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 ]
+        [ (load-vocab) ] [ dup vocab [ ] [ no-vocab ] ?if ] if
-        [ dup vocab [ ] [ no-vocab ] ?if ]
-        if
     ] if
 ] load-vocab-hook set-global