steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Refactor error code so that error types are registered; listener prints a summary of errors

db4
Slava Pestov 2009-04-12 16:08:46 -05:00
parent 0b52638dfc
commit c4be8bd65a
20 changed files with 122 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/bootstrap/stage2.factor
View File

@ -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

4
basis/compiler/codegen/codegen.factor
View File

@ -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

15
basis/compiler/compiler.factor
View File

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

4
basis/help/lint/checks/checks.factor
View File

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

19
basis/help/lint/lint.factor
View File

@ -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+ ;
<PRIVATE
@ -66,8 +70,7 @@ PRIVATE>
: 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 ;

8
basis/listener/listener.factor
View File

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

2
basis/memoize/memoize.factor
View File

@ -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

2
basis/stack-checker/errors/errors.factor
View File

@ -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

3
basis/stack-checker/known-words/known-words.factor
View File

@ -218,9 +218,6 @@ 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
: non-inline-word ( word -- )
dup called-dependency depends-on
{

11
basis/tools/errors/errors-docs.factor
View File

@ -15,18 +15,11 @@ $nl
"Words to view warnings and errors:"
{ $subsection :errors }
{ $subsection :warnings }
{ $subsection :linkage }
"Words such as " { $link require } " use a combinator which counts errors and prints a report at the end:"
{ $subsection with-compiler-errors } ;
{ $subsection :linkage } ;
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 } "." } ;

17
basis/tools/test/test.factor
View File

@ -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
test-failures get [
":failures - show " write length pprint " failing tests." print
] unless-empty ;
child-vocabs [ run-vocab-tests ] each ;
: test-all ( -- ) "" test ;

2
basis/tools/vocabs/vocabs.factor
View File

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

14
basis/ui/tools/error-list/error-list.factor
View File

@ -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
@ -192,4 +192,10 @@ M: updater definitions-changed
: error-list-window ( -- )
compiler-error-model get-global <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

17
basis/ui/tools/listener/listener.factor
View File

@ -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* ;

1
basis/ui/tools/tools.factor
View File

@ -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

3
core/compiler/errors/errors-docs.factor
View File

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

60
core/compiler/errors/errors.factor
View File

@ -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
: <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

8
core/parser/parser.factor
View File

@ -281,11 +281,9 @@ print-use-hook [ [ ] ] initialize
: parse-file ( file -- quot )
[
[
[ parsing-file ] keep
[ utf8 <file-reader> ] keep
parse-stream
] with-compiler-errors
[ parsing-file ] keep
[ utf8 <file-reader> ] keep
parse-stream
] [
over parse-file-restarts rethrow-restarts
drop parse-file

33
core/source-files/errors/errors.factor
View File

@ -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,31 @@ 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
error-types get values
[ quot>> call( -- seq ) ] map
concat ;

8
core/vocabs/loader/loader.factor
View File

@ -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