update help-lint to complain when $quotation effect doesn't match declared effect on corresponding input parameter of stack effect
parent
b9bced9a5e
commit
4367b15c4a
|
@ -36,11 +36,27 @@ SYMBOL: vocab-articles
|
|||
first rest [ first ] map
|
||||
] unless ;
|
||||
|
||||
: extract-value-effects ( element -- seq )
|
||||
\ $values swap elements dup empty? [
|
||||
first rest [
|
||||
\ $quotation swap elements dup empty? [ drop f ] [
|
||||
first second
|
||||
] if
|
||||
] map
|
||||
] unless ;
|
||||
|
||||
: effect-values ( word -- seq )
|
||||
stack-effect
|
||||
[ in>> ] [ out>> ] bi append
|
||||
[ dup pair? [ first ] when effect>string ] map prune ;
|
||||
|
||||
: effect-effects ( word -- seq )
|
||||
stack-effect in>> [
|
||||
dup pair?
|
||||
[ second dup effect? [ effect>string ] [ drop f ] if ]
|
||||
[ drop f ] if
|
||||
] map ;
|
||||
|
||||
: contains-funky-elements? ( element -- ? )
|
||||
{
|
||||
$shuffle
|
||||
|
@ -70,9 +86,16 @@ 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 -- )
|
||||
[ effect-effects ]
|
||||
[ extract-value-effects ]
|
||||
bi* [ 2dup and [ = ] [ 2drop t ] if ] 2all?
|
||||
[ "$quotation documentation in $values don't match stack effect" simple-lint-error ]
|
||||
unless ;
|
||||
|
||||
: check-nulls ( element -- )
|
||||
\ $values swap elements
|
||||
null swap deep-member?
|
||||
|
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs continuations fry help help.lint.checks
|
||||
help.topics io kernel namespaces parser sequences
|
||||
source-files.errors vocabs.hierarchy vocabs words classes
|
||||
locals tools.errors listener ;
|
||||
USING: assocs combinators continuations fry help
|
||||
help.lint.checks help.topics io kernel namespaces parser
|
||||
sequences source-files.errors vocabs.hierarchy vocabs words
|
||||
classes locals tools.errors listener ;
|
||||
FROM: help.lint.checks => all-vocabs ;
|
||||
FROM: vocabs => child-vocabs ;
|
||||
IN: help.lint
|
||||
|
@ -49,10 +49,12 @@ PRIVATE>
|
|||
[ with-file-vocabs ] vocabs-quot set
|
||||
dup word-help [
|
||||
[ >link ] keep '[
|
||||
_ dup word-help
|
||||
[ check-values ]
|
||||
[ check-class-description ]
|
||||
[ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ] 2tri
|
||||
_ dup word-help {
|
||||
[ check-values ]
|
||||
[ check-value-effects ]
|
||||
[ check-class-description ]
|
||||
[ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ]
|
||||
} 2cleave
|
||||
] check-something
|
||||
] [ drop ] if ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue