122 lines
		
	
	
		
			3.2 KiB
		
	
	
	
		
			Factor
		
	
	
		
		
			
		
	
	
			122 lines
		
	
	
		
			3.2 KiB
		
	
	
	
		
			Factor
		
	
	
| 
								 | 
							
								! Copyright (C) 2006, 2007 Slava Pestov.
							 | 
						||
| 
								 | 
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						||
| 
								 | 
							
								USING: sequences parser kernel help help.markup help.topics
							 | 
						||
| 
								 | 
							
								words strings classes tools.browser namespaces io
							 | 
						||
| 
								 | 
							
								io.streams.string prettyprint definitions arrays vectors
							 | 
						||
| 
								 | 
							
								combinators splitting debugger hashtables sorting effects vocabs
							 | 
						||
| 
								 | 
							
								vocabs.loader assocs editors continuations classes.predicate ;
							 | 
						||
| 
								 | 
							
								IN: help.lint
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: check-example ( element -- )
							 | 
						||
| 
								 | 
							
								    1 tail [
							 | 
						||
| 
								 | 
							
								        1 head* "\n" join 1vector
							 | 
						||
| 
								 | 
							
								        [
							 | 
						||
| 
								 | 
							
								            use [ clone ] change
							 | 
						||
| 
								 | 
							
								            [ eval>string ] with-datastack
							 | 
						||
| 
								 | 
							
								        ] with-scope peek "\n" ?tail drop
							 | 
						||
| 
								 | 
							
								    ] keep
							 | 
						||
| 
								 | 
							
								    peek assert= ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: check-examples ( word element -- )
							 | 
						||
| 
								 | 
							
								    nip \ $example swap elements [ check-example ] each ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: extract-values ( element -- seq )
							 | 
						||
| 
								 | 
							
								    \ $values swap elements dup empty? [
							 | 
						||
| 
								 | 
							
								        first 1 tail [ first ] map prune natural-sort
							 | 
						||
| 
								 | 
							
								    ] unless ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: effect-values ( word -- seq )
							 | 
						||
| 
								 | 
							
								    stack-effect dup effect-in swap effect-out
							 | 
						||
| 
								 | 
							
								    append [ string? ] subset prune natural-sort ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: check-values ( word element -- )
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $shuffle
							 | 
						||
| 
								 | 
							
								        $values-x/y
							 | 
						||
| 
								 | 
							
								        $slot-reader
							 | 
						||
| 
								 | 
							
								        $slot-writer
							 | 
						||
| 
								 | 
							
								        $predicate
							 | 
						||
| 
								 | 
							
								        $class-description
							 | 
						||
| 
								 | 
							
								        $error-description
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    over [ elements empty? ] curry all?
							 | 
						||
| 
								 | 
							
								    pick "declared-effect" word-prop and
							 | 
						||
| 
								 | 
							
								    [ extract-values >array >r effect-values >array r> assert= ]
							 | 
						||
| 
								 | 
							
								    [ 2drop ] if ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: check-see-also ( word element -- )
							 | 
						||
| 
								 | 
							
								    nip \ $see-also swap elements [
							 | 
						||
| 
								 | 
							
								        1 tail dup prune [ length ] 2apply assert=
							 | 
						||
| 
								 | 
							
								    ] each ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: vocab-exists? ( name -- ? )
							 | 
						||
| 
								 | 
							
								    dup vocab swap "all-vocabs" get member? or ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: check-modules ( word element -- )
							 | 
						||
| 
								 | 
							
								    nip \ $vocab-link swap elements [
							 | 
						||
| 
								 | 
							
								        second
							 | 
						||
| 
								 | 
							
								        vocab-exists? [ "Missing vocabulary" throw ] unless
							 | 
						||
| 
								 | 
							
								    ] each ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: check-rendering ( word element -- )
							 | 
						||
| 
								 | 
							
								    [ help ] string-out drop ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: all-word-help ( -- seq )
							 | 
						||
| 
								 | 
							
								    all-words [ word-help ] subset ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: help-error topic ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: <help-error> ( topic delegate -- error )
							 | 
						||
| 
								 | 
							
								    { set-help-error-topic set-delegate } help-error construct ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: fix-help ( error -- )
							 | 
						||
| 
								 | 
							
								    dup delegate error.
							 | 
						||
| 
								 | 
							
								    help-error-topic >link edit
							 | 
						||
| 
								 | 
							
								    "Press ENTER when done." print flush readln drop
							 | 
						||
| 
								 | 
							
								    refresh-all ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: check-word ( word -- )
							 | 
						||
| 
								 | 
							
								    dup . flush
							 | 
						||
| 
								 | 
							
								    [
							 | 
						||
| 
								 | 
							
								        dup word-help [
							 | 
						||
| 
								 | 
							
								            2dup check-examples
							 | 
						||
| 
								 | 
							
								            2dup check-values
							 | 
						||
| 
								 | 
							
								            2dup check-see-also
							 | 
						||
| 
								 | 
							
								            2dup check-modules
							 | 
						||
| 
								 | 
							
								            2dup drop check-rendering
							 | 
						||
| 
								 | 
							
								        ] assert-depth 2drop
							 | 
						||
| 
								 | 
							
								    ] [
							 | 
						||
| 
								 | 
							
								        dupd <help-error> fix-help check-word
							 | 
						||
| 
								 | 
							
								    ] recover ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: check-words ( -- )
							 | 
						||
| 
								 | 
							
								    [
							 | 
						||
| 
								 | 
							
								        all-vocabs-seq [ vocab-name ] map
							 | 
						||
| 
								 | 
							
								        "all-vocabs" set
							 | 
						||
| 
								 | 
							
								        all-word-help [ check-word ] each
							 | 
						||
| 
								 | 
							
								    ] with-scope ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: check-article ( article -- )
							 | 
						||
| 
								 | 
							
								    dup . flush
							 | 
						||
| 
								 | 
							
								    [
							 | 
						||
| 
								 | 
							
								        [ dup check-rendering ] assert-depth drop
							 | 
						||
| 
								 | 
							
								    ] [
							 | 
						||
| 
								 | 
							
								        dupd <help-error> fix-help check-article
							 | 
						||
| 
								 | 
							
								    ] recover ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: check-articles ( -- )
							 | 
						||
| 
								 | 
							
								    articles get keys [ check-article ] each ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: check-help ( -- ) check-words check-articles ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: unlinked-words ( -- seq )
							 | 
						||
| 
								 | 
							
								    all-word-help [ article-parent not ] subset ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: linked-undocumented-words ( -- seq )
							 | 
						||
| 
								 | 
							
								    all-words
							 | 
						||
| 
								 | 
							
								    [ word-help not ] subset
							 | 
						||
| 
								 | 
							
								    [ article-parent ] subset
							 | 
						||
| 
								 | 
							
								    [ "predicating" word-prop not ] subset ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								MAIN: check-help
							 |