help.lint: add slot checking, don't check constants for $values.

db4
John Benediktsson 2013-08-24 11:39:16 -07:00
parent e0bbe0df38
commit b88755769b
2 changed files with 25 additions and 10 deletions

View File

@ -1,11 +1,11 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes combinators USING: accessors arrays assocs classes classes.tuple combinators
combinators.short-circuit definitions effects eval fry grouping combinators.short-circuit debugger definitions effects eval fry
help help.markup help.topics io.streams.string kernel macros grouping help help.markup help.topics io io.streams.string
namespaces sequences sequences.deep sets sorting splitting kernel macros namespaces sequences sequences.deep sets splitting
strings unicode.categories vocabs vocabs.loader words strings summary unicode.categories vocabs vocabs.loader words
words.symbol summary debugger io ; words.constant words.symbol ;
FROM: sets => members ; FROM: sets => members ;
IN: help.lint.checks IN: help.lint.checks
@ -74,6 +74,7 @@ SYMBOL: vocab-articles
[ symbol? ] [ symbol? ]
[ parsing-word? ] [ parsing-word? ]
[ "declared-effect" word-prop not ] [ "declared-effect" word-prop not ]
[ constant? ]
} 1|| ; } 1|| ;
: check-values ( word element -- ) : check-values ( word element -- )
@ -144,10 +145,23 @@ SYMBOL: vocab-articles
simple-lint-error simple-lint-error
] when ; ] when ;
: extract-slots ( elements -- seq )
[ dup pair? [ first \ $slot = ] [ drop f ] if ] deep-filter
[ second ] map ;
: check-class-description ( word element -- ) : check-class-description ( word element -- )
[ class? not ] \ $class-description swap elements over class? [
[ { $class-description } swap elements empty? not ] bi* and [ all-slots [ name>> ] map ] [ extract-slots ] bi*
[ "A word that is not a class has a $class-description" simple-lint-error ] when ; [ swap member? not ] with filter [
", " join "Described $slot does not exist: " prepend
simple-lint-error
] unless-empty
] [
nip empty? not [
"A word that is not a class has a $class-description"
simple-lint-error
] when
] if ;
: check-article-title ( article -- ) : check-article-title ( article -- )
article-title first LETTER? article-title first LETTER?

View File

@ -53,6 +53,7 @@ PRIVATE>
[ check-values ] [ check-values ]
[ check-value-effects ] [ check-value-effects ]
[ check-class-description ] [ check-class-description ]
[ check-class-slots ]
[ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ] [ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ]
} 2cleave } 2cleave
] check-something ] check-something