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.
! 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 vocabs vocabs.loader words
words.symbol summary debugger io ;
USING: accessors arrays assocs classes classes.tuple combinators
combinators.short-circuit debugger definitions effects eval fry
grouping help help.markup help.topics io io.streams.string
kernel macros namespaces sequences sequences.deep sets splitting
strings summary unicode.categories vocabs vocabs.loader words
words.constant words.symbol ;
FROM: sets => members ;
IN: help.lint.checks
@ -74,6 +74,7 @@ SYMBOL: vocab-articles
[ symbol? ]
[ parsing-word? ]
[ "declared-effect" word-prop not ]
[ constant? ]
} 1|| ;
: check-values ( word element -- )
@ -86,7 +87,7 @@ SYMBOL: vocab-articles
[ effect-values ]
[ extract-values ]
bi* sequence=
]
]
} 2|| [ "$values don't match stack effect" simple-lint-error ] unless ;
: check-value-effects ( word element -- )
@ -144,10 +145,23 @@ SYMBOL: vocab-articles
simple-lint-error
] when ;
: extract-slots ( elements -- seq )
[ dup pair? [ first \ $slot = ] [ drop f ] if ] deep-filter
[ second ] map ;
: 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" simple-lint-error ] when ;
\ $class-description swap elements over class? [
[ all-slots [ name>> ] map ] [ extract-slots ] bi*
[ 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 -- )
article-title first LETTER?

View File

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