help.lint: add slot checking, don't check constants for $values.
							parent
							
								
									e0bbe0df38
								
							
						
					
					
						commit
						b88755769b
					
				| 
						 | 
				
			
			@ -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?
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue