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