Working on adding help-lint errors to error list
Slava Pestov
parent
fe8e6b328f
commit
e5df0559eb
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs classes combinators
|
||||
combinators.short-circuit definitions effects eval fry grouping
|
||||
help help.markup help.topics io.streams.string kernel macros
|
||||
namespaces sequences sequences.deep sets sorting splitting
|
||||
strings unicode.categories values vocabs vocabs.loader words
|
||||
words.symbol summary debugger io ;
|
||||
IN: help.lint.checks
|
||||
|
||||
ERROR: simple-lint-error message ;
|
||||
|
||||
M: simple-lint-error summary message>> ;
|
||||
|
||||
M: simple-lint-error error. summary print ;
|
||||
|
||||
SYMBOL: vocabs-quot
|
||||
SYMBOL: all-vocabs
|
||||
SYMBOL: vocab-articles
|
||||
|
||||
: check-example ( element -- )
|
||||
'[
|
||||
_ rest [
|
||||
but-last "\n" join
|
||||
[ (eval>string) ] call( code -- output )
|
||||
"\n" ?tail drop
|
||||
] keep
|
||||
peek assert=
|
||||
] vocabs-quot get call( quot -- ) ;
|
||||
|
||||
: check-examples ( element -- )
|
||||
\ $example swap elements [ check-example ] each ;
|
||||
|
||||
: extract-values ( element -- seq )
|
||||
\ $values swap elements dup empty? [
|
||||
first rest [ first ] map prune natural-sort
|
||||
] unless ;
|
||||
|
||||
: effect-values ( word -- seq )
|
||||
stack-effect
|
||||
[ in>> ] [ out>> ] bi append
|
||||
[ dup pair? [ first ] when effect>string ] map
|
||||
prune natural-sort ;
|
||||
|
||||
: contains-funky-elements? ( element -- ? )
|
||||
{
|
||||
$shuffle
|
||||
$values-x/y
|
||||
$predicate
|
||||
$class-description
|
||||
$error-description
|
||||
} swap '[ _ elements empty? not ] any? ;
|
||||
|
||||
: don't-check-word? ( word -- ? )
|
||||
{
|
||||
[ macro? ]
|
||||
[ symbol? ]
|
||||
[ value-word? ]
|
||||
[ parsing-word? ]
|
||||
[ "declared-effect" word-prop not ]
|
||||
} 1|| ;
|
||||
|
||||
: check-values ( word element -- )
|
||||
{
|
||||
[
|
||||
[ don't-check-word? ]
|
||||
[ contains-funky-elements? ]
|
||||
bi* or
|
||||
] [
|
||||
[ effect-values ]
|
||||
[ extract-values ]
|
||||
bi* sequence=
|
||||
]
|
||||
} 2|| [ "$values don't match stack effect" simple-lint-error ] unless ;
|
||||
|
||||
: check-nulls ( element -- )
|
||||
\ $values swap elements
|
||||
null swap deep-member?
|
||||
[ "$values should not contain null" simple-lint-error ] when ;
|
||||
|
||||
: check-see-also ( element -- )
|
||||
\ $see-also swap elements [
|
||||
rest dup prune [ length ] bi@ assert=
|
||||
] each ;
|
||||
|
||||
: vocab-exists? ( name -- ? )
|
||||
[ vocab ] [ all-vocabs get member? ] bi or ;
|
||||
|
||||
: check-modules ( element -- )
|
||||
\ $vocab-link swap elements [
|
||||
second
|
||||
vocab-exists? [
|
||||
"$vocab-link to non-existent vocabulary"
|
||||
simple-lint-error
|
||||
] unless
|
||||
] each ;
|
||||
|
||||
: check-rendering ( element -- )
|
||||
[ print-content ] with-string-writer drop ;
|
||||
|
||||
: check-strings ( str -- )
|
||||
[
|
||||
"\n\t" intersects? [
|
||||
"Paragraph text should not contain \\n or \\t"
|
||||
simple-lint-error
|
||||
] when
|
||||
] [
|
||||
" " swap subseq? [
|
||||
"Paragraph text should not contain double spaces"
|
||||
simple-lint-error
|
||||
] when
|
||||
] bi ;
|
||||
|
||||
: check-whitespace ( str1 str2 -- )
|
||||
[ " " tail? ] [ " " head? ] bi* or
|
||||
[ "Missing whitespace between strings" simple-lint-error ] unless ;
|
||||
|
||||
: check-bogus-nl ( element -- )
|
||||
{ { $nl } { { $nl } } } [ head? ] with any? [
|
||||
"Simple element should not begin with a paragraph break"
|
||||
simple-lint-error
|
||||
] when ;
|
||||
|
||||
: 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 ;
|
||||
|
||||
: check-article-title ( article -- )
|
||||
article-title first LETTER?
|
||||
[ "Article title must begin with a capital letter" throw ] unless ;
|
||||
|
||||
: check-elements ( element -- )
|
||||
{
|
||||
[ check-bogus-nl ]
|
||||
[ [ string? ] filter [ check-strings ] each ]
|
||||
[ [ simple-element? ] filter [ check-elements ] each ]
|
||||
[ 2 <clumps> [ [ string? ] all? ] filter [ first2 check-whitespace ] each ]
|
||||
} cleave ;
|
||||
|
||||
: check-descriptions ( element -- )
|
||||
{ $description $class-description $var-description }
|
||||
swap '[
|
||||
_ elements [
|
||||
rest { { } { "" } } member?
|
||||
[ "Empty description" throw ] when
|
||||
] each
|
||||
] each ;
|
||||
|
||||
: check-markup ( element -- )
|
||||
{
|
||||
[ check-elements ]
|
||||
[ check-rendering ]
|
||||
[ check-examples ]
|
||||
[ check-modules ]
|
||||
[ check-descriptions ]
|
||||
} cleave ;
|
||||
|
||||
: files>vocabs ( -- assoc )
|
||||
vocabs
|
||||
[ [ [ vocab-docs-path ] keep ] H{ } map>assoc ]
|
||||
[ [ [ vocab-source-path ] keep ] H{ } map>assoc ]
|
||||
bi assoc-union ;
|
||||
|
||||
: group-articles ( -- assoc )
|
||||
articles get keys
|
||||
files>vocabs
|
||||
H{ } clone [
|
||||
'[
|
||||
dup >link where dup
|
||||
[ first _ at _ push-at ] [ 2drop ] if
|
||||
] each
|
||||
] keep ;
|
||||
|
||||
: all-word-help ( words -- seq )
|
||||
[ word-help ] filter ;
|
||||
|
|
@ -1,156 +1,39 @@
|
|||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: fry accessors sequences parser kernel help help.markup
|
||||
help.topics words strings classes tools.vocabs namespaces make
|
||||
io io.streams.string prettyprint definitions arrays vectors
|
||||
combinators combinators.short-circuit splitting debugger
|
||||
hashtables sorting effects vocabs vocabs.loader assocs editors
|
||||
continuations classes.predicate macros math sets eval
|
||||
vocabs.parser words.symbol values grouping unicode.categories
|
||||
sequences.deep ;
|
||||
USING: assocs continuations fry help help.lint.checks
|
||||
help.topics io kernel namespaces parser sequences
|
||||
source-files.errors tools.vocabs vocabs words classes
|
||||
locals ;
|
||||
IN: help.lint
|
||||
|
||||
SYMBOL: vocabs-quot
|
||||
SYMBOL: lint-failures
|
||||
|
||||
: check-example ( element -- )
|
||||
'[
|
||||
_ rest [
|
||||
but-last "\n" join
|
||||
[ (eval>string) ] call( code -- output )
|
||||
"\n" ?tail drop
|
||||
] keep
|
||||
peek assert=
|
||||
] vocabs-quot get call( quot -- ) ;
|
||||
lint-failures [ H{ } clone ] initialize
|
||||
|
||||
: check-examples ( element -- )
|
||||
\ $example swap elements [ check-example ] each ;
|
||||
TUPLE: help-lint-error < source-file-error ;
|
||||
|
||||
: extract-values ( element -- seq )
|
||||
\ $values swap elements dup empty? [
|
||||
first rest [ first ] map prune natural-sort
|
||||
] unless ;
|
||||
SYMBOL: +help-lint-failure+
|
||||
|
||||
: effect-values ( word -- seq )
|
||||
stack-effect
|
||||
[ in>> ] [ out>> ] bi append
|
||||
[ dup pair? [ first ] when effect>string ] map
|
||||
prune natural-sort ;
|
||||
M: help-lint-error source-file-error-type drop +help-lint-failure+ ;
|
||||
|
||||
: contains-funky-elements? ( element -- ? )
|
||||
{
|
||||
$shuffle
|
||||
$values-x/y
|
||||
$predicate
|
||||
$class-description
|
||||
$error-description
|
||||
} swap '[ _ elements empty? not ] any? ;
|
||||
<PRIVATE
|
||||
|
||||
: don't-check-word? ( word -- ? )
|
||||
{
|
||||
[ macro? ]
|
||||
[ symbol? ]
|
||||
[ value-word? ]
|
||||
[ parsing-word? ]
|
||||
[ "declared-effect" word-prop not ]
|
||||
} 1|| ;
|
||||
: <help-lint-error> ( error topic -- help-lint-error )
|
||||
\ help-lint-error <definition-error> ;
|
||||
|
||||
: check-values ( word element -- )
|
||||
{
|
||||
[
|
||||
[ don't-check-word? ]
|
||||
[ contains-funky-elements? ]
|
||||
bi* or
|
||||
] [
|
||||
[ effect-values ]
|
||||
[ extract-values ]
|
||||
bi* sequence=
|
||||
]
|
||||
} 2|| [ "$values don't match stack effect" throw ] unless ;
|
||||
PRIVATE>
|
||||
|
||||
: check-nulls ( element -- )
|
||||
\ $values swap elements
|
||||
null swap deep-member?
|
||||
[ "$values should not contain null" throw ] when ;
|
||||
: help-lint-error ( error topic -- )
|
||||
over [
|
||||
[ <help-lint-error> ] keep
|
||||
lint-failures get set-at
|
||||
] [ nip lint-failures get delete-at ] if ;
|
||||
|
||||
: check-see-also ( element -- )
|
||||
\ $see-also swap elements [
|
||||
rest dup prune [ length ] bi@ assert=
|
||||
] each ;
|
||||
<PRIVATE
|
||||
|
||||
: vocab-exists? ( name -- ? )
|
||||
[ vocab ] [ "all-vocabs" get member? ] bi or ;
|
||||
|
||||
: check-modules ( element -- )
|
||||
\ $vocab-link swap elements [
|
||||
second
|
||||
vocab-exists? [ "$vocab-link to non-existent vocabulary" throw ] unless
|
||||
] each ;
|
||||
|
||||
: check-rendering ( element -- )
|
||||
[ print-content ] with-string-writer drop ;
|
||||
|
||||
: check-strings ( str -- )
|
||||
[
|
||||
"\n\t" intersects?
|
||||
[ "Paragraph text should not contain \\n or \\t" throw ] when
|
||||
] [
|
||||
" " swap subseq?
|
||||
[ "Paragraph text should not contain double spaces" throw ] when
|
||||
] bi ;
|
||||
|
||||
: check-whitespace ( str1 str2 -- )
|
||||
[ " " tail? ] [ " " head? ] bi* or
|
||||
[ "Missing whitespace between strings" throw ] unless ;
|
||||
|
||||
: check-bogus-nl ( element -- )
|
||||
{ { $nl } { { $nl } } } [ head? ] with any?
|
||||
[ "Simple element should not begin with a paragraph break" throw ] when ;
|
||||
|
||||
: check-elements ( element -- )
|
||||
{
|
||||
[ check-bogus-nl ]
|
||||
[ [ string? ] filter [ check-strings ] each ]
|
||||
[ [ simple-element? ] filter [ check-elements ] each ]
|
||||
[ 2 <clumps> [ [ string? ] all? ] filter [ first2 check-whitespace ] each ]
|
||||
} cleave ;
|
||||
|
||||
: check-descriptions ( element -- )
|
||||
{ $description $class-description $var-description }
|
||||
swap '[
|
||||
_ elements [
|
||||
rest { { } { "" } } member?
|
||||
[ "Empty description" throw ] when
|
||||
] each
|
||||
] each ;
|
||||
|
||||
: check-markup ( element -- )
|
||||
{
|
||||
[ check-elements ]
|
||||
[ check-rendering ]
|
||||
[ check-examples ]
|
||||
[ check-modules ]
|
||||
[ check-descriptions ]
|
||||
} cleave ;
|
||||
|
||||
: 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 ;
|
||||
|
||||
: all-word-help ( words -- seq )
|
||||
[ word-help ] filter ;
|
||||
|
||||
TUPLE: help-error error topic ;
|
||||
|
||||
C: <help-error> help-error
|
||||
|
||||
M: help-error error.
|
||||
[ "In " write topic>> pprint nl ]
|
||||
[ error>> error. ]
|
||||
bi ;
|
||||
|
||||
: check-something ( obj quot -- )
|
||||
flush '[ _ call( -- ) ] swap '[ _ <help-error> , ] recover ; inline
|
||||
:: check-something ( topic quot -- )
|
||||
[ quot call( -- ) f ] [ ] recover
|
||||
topic help-lint-error ; inline
|
||||
|
||||
: check-word ( word -- )
|
||||
[ with-file-vocabs ] vocabs-quot set
|
||||
|
|
@ -165,67 +48,35 @@ M: help-error error.
|
|||
|
||||
: check-words ( words -- ) [ check-word ] each ;
|
||||
|
||||
: check-article-title ( article -- )
|
||||
article-title first LETTER?
|
||||
[ "Article title must begin with a capital letter" throw ] unless ;
|
||||
|
||||
: check-article ( article -- )
|
||||
[ with-interactive-vocabs ] vocabs-quot set
|
||||
dup '[
|
||||
>link dup '[
|
||||
_
|
||||
[ check-article-title ]
|
||||
[ article-content check-markup ] bi
|
||||
] check-something ;
|
||||
|
||||
: files>vocabs ( -- assoc )
|
||||
vocabs
|
||||
[ [ [ vocab-docs-path ] keep ] H{ } map>assoc ]
|
||||
[ [ [ vocab-source-path ] keep ] H{ } map>assoc ]
|
||||
bi assoc-union ;
|
||||
|
||||
: group-articles ( -- assoc )
|
||||
articles get keys
|
||||
files>vocabs
|
||||
H{ } clone [
|
||||
'[
|
||||
dup >link where dup
|
||||
[ first _ at _ push-at ] [ 2drop ] if
|
||||
] each
|
||||
] keep ;
|
||||
|
||||
: check-about ( vocab -- )
|
||||
dup '[ _ vocab-help [ article drop ] when* ] check-something ;
|
||||
|
||||
: check-vocab ( vocab -- seq )
|
||||
: check-vocab ( vocab -- )
|
||||
"Checking " write dup write "..." print
|
||||
[
|
||||
[ check-about ]
|
||||
[ words [ check-word ] each ]
|
||||
[ "vocab-articles" get at [ check-article ] each ]
|
||||
tri
|
||||
] { } make ;
|
||||
vocab
|
||||
[ check-about ]
|
||||
[ words [ check-word ] each ]
|
||||
[ vocab-articles get at [ check-article ] each ]
|
||||
tri ;
|
||||
|
||||
: run-help-lint ( prefix -- alist )
|
||||
PRIVATE>
|
||||
|
||||
: help-lint ( prefix -- )
|
||||
[
|
||||
all-vocabs-seq [ vocab-name ] map "all-vocabs" set
|
||||
group-articles "vocab-articles" set
|
||||
all-vocabs-seq [ vocab-name ] map all-vocabs set
|
||||
group-articles vocab-articles set
|
||||
child-vocabs
|
||||
[ dup check-vocab ] { } map>assoc
|
||||
[ nip empty? not ] assoc-filter
|
||||
[ check-vocab ] each
|
||||
] with-scope ;
|
||||
|
||||
: typos. ( assoc -- )
|
||||
[
|
||||
"==== ALL CHECKS PASSED" print
|
||||
] [
|
||||
[
|
||||
swap vocab-heading.
|
||||
[ print-error nl ] each
|
||||
] assoc-each
|
||||
] if-empty ;
|
||||
|
||||
: help-lint ( prefix -- ) run-help-lint typos. ;
|
||||
|
||||
: help-lint-all ( -- ) "" help-lint ;
|
||||
|
||||
: unlinked-words ( words -- seq )
|
||||
|
|
@ -235,6 +86,6 @@ M: help-error error.
|
|||
all-words
|
||||
[ word-help not ] filter
|
||||
[ article-parent ] filter
|
||||
[ "predicating" word-prop not ] filter ;
|
||||
[ predicate? not ] filter ;
|
||||
|
||||
MAIN: help-lint
|
||||
|
|
|
|||
|
|
@ -99,7 +99,7 @@ SYNTAX: TEST:
|
|||
|
||||
: run-test-file ( path -- )
|
||||
dup file [
|
||||
test-failures get [ file>> file get = not ] filter-here
|
||||
test-failures get file get +test-failure+ delete-file-errors
|
||||
'[ _ run-file ] [ file-failure ] recover
|
||||
] with-variable ;
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,8 @@ USING: help.markup help.syntax ;
|
|||
ARTICLE: "ui.tools.error-list" "UI error list tool"
|
||||
"The error list tool displays messages generated by tools which process source files and definitions."
|
||||
$nl
|
||||
"The different types of messages displayed:"
|
||||
"The " { $vocab-link "source-files.errors" } " vocabulary contains backend code used by this tool."
|
||||
{ $heading "Message icons" }
|
||||
{ $table
|
||||
{ "Icon" "Message type" "Reference" }
|
||||
{ { $image "vocab:ui/tools/error-list/icons/note.tiff" } "Parser note" { $link "parser" } }
|
||||
|
|
@ -14,7 +15,6 @@ $nl
|
|||
{ { $image "vocab:ui/tools/error-list/icons/unit-test-error.tiff" } "Unit test failure" { $link "tools.test" } }
|
||||
{ { $image "vocab:ui/tools/error-list/icons/help-lint-error.tiff" } "Help lint failure" { $link "help.lint" } }
|
||||
{ { $image "vocab:ui/tools/error-list/icons/linkage-error.tiff" } "Linkage error" { $link "compiler-errors" } }
|
||||
}
|
||||
"The " { $vocab-link "source-files.errors" } " vocabulary contains backend code used by this tool." ;
|
||||
} ;
|
||||
|
||||
ABOUT: "ui.tools.error-list"
|
||||
|
|
|
|||
|
|
@ -1,17 +1,17 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays sequences sorting assocs colors.constants fry
|
||||
combinators combinators.smart combinators.short-circuit editors memoize
|
||||
compiler.errors compiler.units fonts kernel io.pathnames prettyprint
|
||||
tools.test stack-checker.errors source-files.errors math.parser
|
||||
math.order models models.arrow models.arrow.smart models.search
|
||||
models.mapping 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 ;
|
||||
combinators combinators.smart combinators.short-circuit editors make
|
||||
memoize compiler.errors compiler.units fonts kernel io.pathnames
|
||||
prettyprint tools.test help.lint stack-checker.errors
|
||||
source-files.errors math.parser init math.order models models.arrow
|
||||
models.arrow.smart models.search models.mapping 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 ;
|
||||
IN: ui.tools.error-list
|
||||
|
||||
CONSTANT: error-types
|
||||
|
|
@ -19,6 +19,7 @@ CONSTANT: error-types
|
|||
+compiler-warning+
|
||||
+compiler-error+
|
||||
+test-failure+
|
||||
+help-lint-failure+
|
||||
+linkage-error+
|
||||
}
|
||||
|
||||
|
|
@ -29,8 +30,9 @@ MEMO: error-list-icon ( object -- object )
|
|||
{
|
||||
{ +compiler-error+ [ "compiler-error" ] }
|
||||
{ +compiler-warning+ [ "compiler-warning" ] }
|
||||
{ +linkage-error+ [ "linkage-error" ] }
|
||||
{ +test-failure+ [ "unit-test-error" ] }
|
||||
{ +help-lint-failure+ [ "help-lint-error" ] }
|
||||
{ +linkage-error+ [ "linkage-error" ] }
|
||||
} case error-list-icon ;
|
||||
|
||||
: <checkboxes> ( alist -- gadget )
|
||||
|
|
@ -79,8 +81,8 @@ M: source-file-renderer filled-column drop 1 ;
|
|||
[ invoke-primary-operation ] >>action
|
||||
COLOR: dark-gray >>column-line-color
|
||||
6 >>gap
|
||||
30 >>min-rows
|
||||
30 >>max-rows
|
||||
10 >>min-rows
|
||||
10 >>max-rows
|
||||
60 >>min-cols
|
||||
60 >>max-cols
|
||||
t >>selection-required?
|
||||
|
|
@ -124,8 +126,8 @@ M: error-renderer column-alignment drop { 0 1 0 0 } ;
|
|||
[ invoke-primary-operation ] >>action
|
||||
COLOR: dark-gray >>column-line-color
|
||||
6 >>gap
|
||||
30 >>min-rows
|
||||
30 >>max-rows
|
||||
20 >>min-rows
|
||||
20 >>max-rows
|
||||
60 >>min-cols
|
||||
60 >>max-cols
|
||||
t >>selection-required?
|
||||
|
|
@ -197,13 +199,18 @@ SINGLETON: updater
|
|||
|
||||
M: updater definitions-changed
|
||||
2drop
|
||||
compiler-errors get-global values
|
||||
test-failures get-global append
|
||||
[
|
||||
compiler-errors get-global values %
|
||||
test-failures get-global %
|
||||
lint-failures get-global values %
|
||||
] { } make
|
||||
compiler-error-model get-global
|
||||
set-model ;
|
||||
|
||||
updater remove-definition-observer
|
||||
updater add-definition-observer
|
||||
[
|
||||
updater remove-definition-observer
|
||||
updater add-definition-observer
|
||||
] "ui.tools.error-list" add-init-hook
|
||||
|
||||
: error-list-window ( -- )
|
||||
compiler-error-model get-global <error-list-gadget>
|
||||
|
|
|
|||
|
|
@ -41,11 +41,7 @@ SYMBOL: with-compiler-errors?
|
|||
"linkage errors" +linkage-error+ "linkage" (compiler-report) ;
|
||||
|
||||
: <compiler-error> ( error word -- compiler-error )
|
||||
\ compiler-error new
|
||||
swap
|
||||
[ >>asset ]
|
||||
[ where [ first2 ] [ "<unknown file>" 0 ] if* [ >>file ] [ >>line# ] bi* ] bi
|
||||
swap >>error ;
|
||||
\ compiler-error <definition-error> ;
|
||||
|
||||
: compiler-error ( error word -- )
|
||||
compiler-errors get-global pick
|
||||
|
|
|
|||
|
|
@ -1,14 +1,30 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs kernel math.order sorting sequences ;
|
||||
USING: accessors assocs kernel math.order sorting sequences definitions ;
|
||||
IN: source-files.errors
|
||||
|
||||
TUPLE: source-file-error error asset file line# ;
|
||||
|
||||
: sort-errors ( errors -- alerrors'ist )
|
||||
: sort-errors ( errors -- alist )
|
||||
[ [ [ line#>> ] compare ] sort ] { } assoc-map-as sort-keys ;
|
||||
|
||||
: group-by-source-file ( errors -- assoc )
|
||||
H{ } clone [ [ push-at ] curry [ dup file>> ] prepose each ] keep ;
|
||||
|
||||
GENERIC: source-file-error-type ( error -- type )
|
||||
|
||||
: <definition-error> ( error definition class -- source-file-error )
|
||||
new
|
||||
swap
|
||||
[ >>asset ]
|
||||
[
|
||||
where [ first2 ] [ "<unknown file>" 0 ] if*
|
||||
[ >>file ] [ >>line# ] bi*
|
||||
] bi
|
||||
swap >>error ; inline
|
||||
|
||||
: delete-file-errors ( seq file type -- )
|
||||
[
|
||||
[ swap file>> = ] [ swap source-file-error-type = ]
|
||||
bi-curry* bi and not
|
||||
] 2curry filter-here ;
|
||||
Loading…
Reference in New Issue