From 80ed1dd9542d420992c7f1ee9a197a3fd0674939 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 20 Aug 2009 15:10:42 -0500
Subject: [PATCH] "deprecated" declaration, "deprecation" vocab to track
 deprecations in the error log

---
 basis/deprecation/authors.txt                 |   1 +
 basis/deprecation/deprecation.factor          |  72 ++++++++++++++++++
 basis/deprecation/summary.txt                 |   1 +
 basis/see/see.factor                          |   3 +-
 .../error-list/icons/deprecation-note.tiff    | Bin 0 -> 2542 bytes
 core/bootstrap/syntax.factor                  |   1 +
 core/syntax/syntax-docs.factor                |   4 +
 core/syntax/syntax.factor                     |   1 +
 core/words/words-docs.factor                  |  10 +++
 core/words/words.factor                       |  10 ++-
 10 files changed, 100 insertions(+), 3 deletions(-)
 create mode 100644 basis/deprecation/authors.txt
 create mode 100644 basis/deprecation/deprecation.factor
 create mode 100644 basis/deprecation/summary.txt
 create mode 100644 basis/ui/tools/error-list/icons/deprecation-note.tiff

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
+
+: <deprecation-note> ( error word -- deprecation-note )
+    \ deprecation-note <definition-error> ;
+
+: deprecation-note ( word usages -- )
+    [ deprecated-usages boa ]
+    [ drop <deprecation-note> ]
+    [ 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 0000000000000000000000000000000000000000..1eef0ef52ce5283374bdda2f33871ba4fd9dbcfe
GIT binary patch
literal 2542
zcmebEWzb?^;N<xK|3AYh9{yp#z`$S*#9M**F%UnZ0PhCswMI@eK)x&xzX9U^#9$##
z=Ksu$c-6iInxhS~1IV5P#D9q~8>A*cgZKZ@B!&OVf^7KQvlPkvlf;@0Gyi|R*8eY6
z8voOb1##JN1KoUmaSpKCK<>kb+nvS!gUpBFEm3m+C3slS?ZGgAhL0p%4@@ty^qVsE
z|G}Dk$aYZGe3&~H1xo+tXJ-Q0Lv{220mE#Pr^J6w7DlR@|F}@~zl#z#-tZweewPMG
z{}<q3Mm8JW{m02kpKpP28m5gBr^t3(M@pZyK=XeQYX>OpZjYAxFNv8ZVdjJK>Leud
zg@F85#M;5j22LL^v(V{3KyzLLu`JAd5Df$%J3#&bg%v12lY>tH^|b=AD6-k3?BQEK
zG6*m-FfapSoRL8SNH8L?nZRroU@PeyBQsPSsF;xr%4Pzx1sQ<yK)nnM9E?IpYDA%I
zpe&;pgv}ZXWQ)Vpb22bWF|b1Pa$aMUhO_T6${?Ae0cC^i3PNHBgV`XrJp-Bnv>gIH
NAO<qPXrRl$5CDbm<6i&(

literal 0
HcmV?d00001

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 <wrapper> ;
 
-INSTANCE: word definition
\ No newline at end of file
+INSTANCE: word definition