diff --git a/basis/deprecation/authors.txt b/basis/deprecation/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/basis/deprecation/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/basis/deprecation/deprecation.factor b/basis/deprecation/deprecation.factor new file mode 100644 index 0000000000..4774ba7ff9 --- /dev/null +++ b/basis/deprecation/deprecation.factor @@ -0,0 +1,72 @@ +! (c)2009 Joe Groff bsd license +USING: accessors arrays assocs compiler.units +debugger io kernel namespaces prettyprint sequences +source-files.errors summary tools.crossref.private +tools.errors words ; +IN: 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 + { 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 ] } +} define-error-type + +: ( error word -- deprecation-note ) + \ deprecation-note ; + +: deprecation-note ( word usages -- ) + [ deprecated-usages boa ] + [ drop ] + [ drop deprecation-notes get-global set-at ] 2tri ; + +: clear-deprecation-note ( word -- ) + deprecation-notes get-global delete-at ; + +: check-deprecations ( word -- ) + dup "forgotten" word-prop + [ clear-deprecation-note ] [ + dup def>> [ deprecated? ] filter + [ clear-deprecation-note ] [ >array deprecation-note ] if-empty + ] 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 [ keys [ check-deprecations ] each ] each ; + +M: deprecation-observer definitions-changed + drop keys [ word? ] filter + dup [ deprecated? ] filter empty? + [ [ check-deprecations ] each ] + [ drop initialize-deprecation-notes ] if ; + +\ deprecation-observer add-definition-observer + +initialize-deprecation-notes diff --git a/basis/deprecation/summary.txt b/basis/deprecation/summary.txt new file mode 100644 index 0000000000..513938d044 --- /dev/null +++ b/basis/deprecation/summary.txt @@ -0,0 +1 @@ +Tracking usage of deprecated words diff --git a/basis/see/see.factor b/basis/see/see.factor index 206bdbb906..1b3bd4bfb5 100644 --- a/basis/see/see.factor +++ b/basis/see/see.factor @@ -101,6 +101,7 @@ M: object declarations. drop ; M: word declarations. { POSTPONE: delimiter + POSTPONE: deprecated POSTPONE: inline POSTPONE: recursive POSTPONE: foldable @@ -229,4 +230,4 @@ PRIVATE> ] { } make prune ; : see-methods ( word -- ) - methods see-all nl ; \ No newline at end of file + methods see-all nl ; diff --git a/basis/ui/tools/error-list/icons/deprecation-note.tiff b/basis/ui/tools/error-list/icons/deprecation-note.tiff new file mode 100644 index 0000000000..1eef0ef52c Binary files /dev/null and b/basis/ui/tools/error-list/icons/deprecation-note.tiff differ diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor index f5182a0210..906b73934e 100644 --- a/core/bootstrap/syntax.factor +++ b/core/bootstrap/syntax.factor @@ -67,6 +67,7 @@ IN: bootstrap.syntax "M\\" "]" "delimiter" + "deprecated" "f" "flushable" "foldable" diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 70905ceda9..320387e506 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -191,6 +191,10 @@ HELP: delimiter { $syntax ": foo ... ; delimiter" } { $description "Declares the most recently defined word as a delimiter. Delimiters are words which are only ever valid as the end of a nested block to be read by " { $link parse-until } ". An unpaired occurrence of a delimiter is a parse error." } ; +HELP: deprecated +{ $syntax ": foo ... ; deprecated" } +{ $description "Declares the most recently defined word as deprecated. If the " { $vocab-link "deprecation" } " vocabulary is loaded, usages of deprecated words will be noted as they are made." } ; + HELP: SYNTAX: { $syntax "SYNTAX: foo ... ;" } { $description "Defines a parsing word." } diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 7b9a0d36ef..f01f90c027 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -111,6 +111,7 @@ IN: bootstrap.syntax "foldable" [ word make-foldable ] define-core-syntax "flushable" [ word make-flushable ] define-core-syntax "delimiter" [ word t "delimiter" set-word-prop ] define-core-syntax + "deprecated" [ word make-deprecated ] define-core-syntax "SYNTAX:" [ CREATE-WORD parse-definition define-syntax diff --git a/core/words/words-docs.factor b/core/words/words-docs.factor index 806d09bf9e..b756c0b681 100644 --- a/core/words/words-docs.factor +++ b/core/words/words-docs.factor @@ -294,6 +294,16 @@ HELP: delimiter? { $description "Tests if an object is a delimiter word declared by " { $link POSTPONE: delimiter } "." } { $notes "Outputs " { $link f } " if the object is not a word." } ; +HELP: deprecated? +{ $values { "obj" object } { "?" "a boolean" } } +{ $description "Tests if an object is " { $link POSTPONE: deprecated } "." } +{ $notes "Outputs " { $link f } " if the object is not a word." } ; + +HELP: make-deprecated +{ $values { "word" word } } +{ $description "Declares a word as " { $link POSTPONE: deprecated } "." } +{ $side-effects "word" } ; + HELP: make-flushable { $values { "word" word } } { $description "Declares a word as " { $link POSTPONE: flushable } "." } diff --git a/core/words/words.factor b/core/words/words.factor index 19a2ce551d..df5bc84ede 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -123,6 +123,9 @@ M: word subwords drop f ; : define-declared ( word def effect -- ) [ nip swap set-stack-effect ] [ drop define ] 3bi ; +: make-deprecated ( word -- ) + t "deprecated" set-word-prop ; + : make-inline ( word -- ) dup inline? [ drop ] [ [ t "inline" set-word-prop ] @@ -148,7 +151,7 @@ M: word reset-word { "unannotated-def" "parsing" "inline" "recursive" "foldable" "flushable" "reading" "writing" "reader" - "writer" "delimiter" + "writer" "delimiter" "deprecated" } reset-props ; : reset-generic ( word -- ) @@ -200,6 +203,9 @@ M: parsing-word definer drop \ SYNTAX: \ ; ; : delimiter? ( obj -- ? ) dup word? [ "delimiter" word-prop ] [ drop f ] if ; +: deprecated? ( obj -- ? ) + dup word? [ "deprecated" word-prop ] [ drop f ] if ; + ! Definition protocol M: word where "loc" word-prop ; @@ -217,4 +223,4 @@ M: word hashcode* M: word literalize ; -INSTANCE: word definition \ No newline at end of file +INSTANCE: word definition