82 lines
2.4 KiB
Factor
82 lines
2.4 KiB
Factor
! Copyright (C) 2009 Joe Groff.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors arrays assocs combinators.short-circuit
|
|
compiler.units debugger init io io.streams.null kernel
|
|
namespaces prettyprint sequences sets source-files.errors
|
|
summary tools.crossref tools.crossref.private tools.errors
|
|
words ;
|
|
IN: tools.deprecation
|
|
|
|
SYMBOL: +deprecation-note+
|
|
SYMBOL: deprecation-notes
|
|
|
|
deprecation-notes [ H{ } clone ] initialize
|
|
|
|
TUPLE: deprecation-note < source-file-error ;
|
|
|
|
M: deprecation-note error-type drop +deprecation-note+ ;
|
|
|
|
TUPLE: deprecated-usages asset usages ;
|
|
|
|
: :deprecations ( -- )
|
|
deprecation-notes get-global values errors. ;
|
|
|
|
T{ error-type-holder
|
|
{ type +deprecation-note+ }
|
|
{ word ":deprecations" }
|
|
{ plural "deprecated word usages" }
|
|
{ icon "vocab:ui/tools/error-list/icons/deprecation-note.tiff" }
|
|
{ quot [ deprecation-notes get values ] }
|
|
{ forget-quot [ deprecation-notes get delete-at ] }
|
|
{ fatal? f }
|
|
} define-error-type
|
|
|
|
: <deprecation-note> ( error word -- deprecation-note )
|
|
deprecation-note new-source-file-error ;
|
|
|
|
: 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 ;
|
|
|
|
: check-deprecations ( usage -- )
|
|
dup word? [
|
|
dup { [ "forgotten" word-prop ] [ deprecated? ] } 1||
|
|
[ clear-deprecation-note ] [
|
|
dup def>> uses [ deprecated? ] filter
|
|
[ clear-deprecation-note ]
|
|
[ store-deprecation-note ] if-empty
|
|
] if
|
|
] [ drop ] if ;
|
|
|
|
M: deprecated-usages summary
|
|
drop "Deprecated words used" ;
|
|
|
|
M: deprecated-usages error.
|
|
"The definition of " write
|
|
dup asset>> pprint
|
|
" uses these deprecated words:" write nl
|
|
usages>> [ " " write pprint nl ] each ;
|
|
|
|
SINGLETON: deprecation-observer
|
|
|
|
: initialize-deprecation-notes ( -- )
|
|
[
|
|
get-crossref [ drop deprecated? ] assoc-filter
|
|
values [ members [ check-deprecations ] each ] each
|
|
] with-null-writer ;
|
|
|
|
M: deprecation-observer definitions-changed
|
|
drop filter-word-defs
|
|
dup [ deprecated? ] none?
|
|
[ [ check-deprecations ] each ]
|
|
[ drop initialize-deprecation-notes ] if ;
|
|
|
|
[ deprecation-observer add-definition-observer ]
|
|
"tools.deprecation" add-startup-hook
|
|
|
|
initialize-deprecation-notes
|