source-files.errors: rename <definition-error> to new-source-file-error.
							parent
							
								
									86778b349c
								
							
						
					
					
						commit
						013adec055
					
				| 
						 | 
				
			
			@ -39,10 +39,10 @@ T{ error-type-holder
 | 
			
		|||
} define-error-type
 | 
			
		||||
 | 
			
		||||
: <compiler-error> ( error word -- compiler-error )
 | 
			
		||||
    \ compiler-error <definition-error> ;
 | 
			
		||||
    compiler-error new-source-file-error ;
 | 
			
		||||
 | 
			
		||||
: <linkage-error> ( error word -- linkage-error )
 | 
			
		||||
    \ linkage-error <definition-error> ;
 | 
			
		||||
    linkage-error new-source-file-error ;
 | 
			
		||||
 | 
			
		||||
: set-linkage-error ( name message word class -- )
 | 
			
		||||
    '[ _ boa ] dip <linkage-error> dup asset>> linkage-errors get set-at ; inline
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -28,7 +28,7 @@ M: help-lint-error error-type drop +help-lint-failure+ ;
 | 
			
		|||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: <help-lint-error> ( error topic -- help-lint-error )
 | 
			
		||||
    \ help-lint-error <definition-error> ;
 | 
			
		||||
    help-lint-error new-source-file-error ;
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -12,9 +12,9 @@ SYMBOL: deprecation-notes
 | 
			
		|||
 | 
			
		||||
deprecation-notes [ H{ } clone ] initialize
 | 
			
		||||
 | 
			
		||||
TUPLE: deprecation-note-error < source-file-error ;
 | 
			
		||||
TUPLE: deprecation-note < source-file-error ;
 | 
			
		||||
 | 
			
		||||
M: deprecation-note-error error-type drop +deprecation-note+ ;
 | 
			
		||||
M: deprecation-note error-type drop +deprecation-note+ ;
 | 
			
		||||
 | 
			
		||||
TUPLE: deprecated-usages asset usages ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -31,13 +31,13 @@ T{ error-type-holder
 | 
			
		|||
    { fatal? f }
 | 
			
		||||
} define-error-type
 | 
			
		||||
 | 
			
		||||
: <deprecation-note-error> ( error word -- deprecation-note )
 | 
			
		||||
    \ deprecation-note-error <definition-error> ;
 | 
			
		||||
: <deprecation-note> ( error word -- deprecation-note )
 | 
			
		||||
    deprecation-note new-source-file-error ;
 | 
			
		||||
 | 
			
		||||
: deprecation-note ( word usages -- )
 | 
			
		||||
    [ deprecated-usages boa ]
 | 
			
		||||
    [ drop <deprecation-note-error> ]
 | 
			
		||||
    [ drop deprecation-notes get-global set-at ] 2tri ;
 | 
			
		||||
: store-deprecation-note ( word usages -- )
 | 
			
		||||
    over [ deprecated-usages boa ] dip
 | 
			
		||||
    [ <deprecation-note> ]
 | 
			
		||||
    [ deprecation-notes get-global set-at ] bi ;
 | 
			
		||||
 | 
			
		||||
: clear-deprecation-note ( word -- )
 | 
			
		||||
    deprecation-notes get-global delete-at ;
 | 
			
		||||
| 
						 | 
				
			
			@ -47,7 +47,8 @@ T{ error-type-holder
 | 
			
		|||
        dup { [ "forgotten" word-prop ] [ deprecated? ] } 1||
 | 
			
		||||
        [ clear-deprecation-note ] [
 | 
			
		||||
            dup def>> uses [ deprecated? ] filter
 | 
			
		||||
            [ clear-deprecation-note ] [ >array deprecation-note ] if-empty
 | 
			
		||||
            [ clear-deprecation-note ]
 | 
			
		||||
            [ store-deprecation-note ] if-empty
 | 
			
		||||
        ] if
 | 
			
		||||
    ] [ drop ] if ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -74,7 +75,7 @@ M: deprecation-observer definitions-changed
 | 
			
		|||
    [ [ check-deprecations ] each ]
 | 
			
		||||
    [ drop initialize-deprecation-notes ] if ;
 | 
			
		||||
 | 
			
		||||
[ \ deprecation-observer add-definition-observer ]
 | 
			
		||||
[ deprecation-observer add-definition-observer ]
 | 
			
		||||
"tools.deprecation" add-startup-hook
 | 
			
		||||
 | 
			
		||||
initialize-deprecation-notes
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -33,7 +33,7 @@ HELP: :linkage
 | 
			
		|||
{ :errors :linkage } related-words
 | 
			
		||||
 | 
			
		||||
HELP: errors.
 | 
			
		||||
{ $values { "errors" "a sequence of " { $link source-file-error } " instances" } }
 | 
			
		||||
{ $values { "errors" { $sequence source-file-error } } }
 | 
			
		||||
{ $description "Prints a list of errors, grouped by source file." } ;
 | 
			
		||||
 | 
			
		||||
ARTICLE: "tools.errors" "Batch error reporting"
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -32,11 +32,11 @@ HELP: error-file
 | 
			
		|||
{ $values { "error" "an error" } { "file" "a file path" } }
 | 
			
		||||
{ $description "File in which the error occurred." } ;
 | 
			
		||||
 | 
			
		||||
HELP: <definition-error>
 | 
			
		||||
HELP: new-source-file-error
 | 
			
		||||
{ $values
 | 
			
		||||
  { "error" "an error." }
 | 
			
		||||
  { "definition" "an asset that contains the error." }
 | 
			
		||||
  { "class" "a tuple class deriving source-file-error." }
 | 
			
		||||
  { "error" "an error" }
 | 
			
		||||
  { "asset" "an asset that contains the error" }
 | 
			
		||||
  { "class" "a tuple class deriving source-file-error" }
 | 
			
		||||
  { "source-file-error" source-file-error }
 | 
			
		||||
}
 | 
			
		||||
{ $description "Creates a new " { $link source-file-error } " instance." } ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -19,6 +19,13 @@ M: source-file-error error-file [ error>> error-file ] [ path>> ] bi or ;
 | 
			
		|||
M: source-file-error error-line [ error>> error-line ] [ line#>> ] bi or ;
 | 
			
		||||
M: source-file-error compute-restarts error>> compute-restarts ;
 | 
			
		||||
 | 
			
		||||
: new-source-file-error ( error asset class -- source-file-error )
 | 
			
		||||
    new
 | 
			
		||||
        swap
 | 
			
		||||
        [ >>asset ]
 | 
			
		||||
        [ where [ first2 [ >>path ] [ >>line# ] bi* ] when* ] bi
 | 
			
		||||
        swap >>error ; inline
 | 
			
		||||
 | 
			
		||||
: sort-errors ( errors -- alist )
 | 
			
		||||
    [ [ line#>> 0 or ] sort-with ] { } assoc-map-as sort-keys ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -29,13 +36,6 @@ TUPLE: error-type-holder type word plural icon quot forget-quot { fatal? initial
 | 
			
		|||
 | 
			
		||||
GENERIC: error-type ( error -- type )
 | 
			
		||||
 | 
			
		||||
: <definition-error> ( error definition class -- source-file-error )
 | 
			
		||||
    new
 | 
			
		||||
        swap
 | 
			
		||||
        [ >>asset ]
 | 
			
		||||
        [ where [ first2 [ >>path ] [ >>line# ] bi* ] when* ] bi
 | 
			
		||||
        swap >>error ; inline
 | 
			
		||||
 | 
			
		||||
SYMBOL: error-types
 | 
			
		||||
 | 
			
		||||
error-types [ V{ } clone ] initialize
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue