From 800bcdecf569ecaf469182097839def8554c99d9 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 20 Aug 2009 08:44:19 -0500
Subject: [PATCH 01/11] convert alien.struct fields to classes.struct fields;
 add tests

---
 extra/classes/struct/struct-tests.factor | 100 +++++++++++++++++------
 extra/classes/struct/struct.factor       |  24 ++++--
 2 files changed, 93 insertions(+), 31 deletions(-)

diff --git a/extra/classes/struct/struct-tests.factor b/extra/classes/struct/struct-tests.factor
index 1f8d0cc482..912d33c7bc 100644
--- a/extra/classes/struct/struct-tests.factor
+++ b/extra/classes/struct/struct-tests.factor
@@ -1,25 +1,25 @@
 ! (c)Joe Groff bsd license
-USING: accessors alien.c-types classes.c-types classes.struct
-combinators io.streams.string kernel libc math multiline namespaces
-prettyprint prettyprint.config see tools.test ;
+USING: accessors alien.c-types alien.structs.fields classes.c-types
+classes.struct combinators io.streams.string kernel libc literals math
+multiline namespaces prettyprint prettyprint.config see tools.test ;
 IN: classes.struct.tests
 
-STRUCT: foo
+STRUCT: struct-test-foo
     { x char }
     { y int initial: 123 }
     { z boolean } ;
 
-STRUCT: bar
+STRUCT: struct-test-bar
     { w ushort initial: HEX: ffff }
-    { foo foo } ;
+    { foo struct-test-foo } ;
 
-[ 12 ] [ foo heap-size ] unit-test
-[ 16 ] [ bar heap-size ] unit-test
-[ 123 ] [ foo <struct> y>> ] unit-test
-[ 123 ] [ bar <struct> foo>> y>> ] unit-test
+[ 12 ] [ struct-test-foo heap-size ] unit-test
+[ 16 ] [ struct-test-bar heap-size ] unit-test
+[ 123 ] [ struct-test-foo <struct> y>> ] unit-test
+[ 123 ] [ struct-test-bar <struct> foo>> y>> ] unit-test
 
 [ 1 2 3 t ] [
-    1   2 3 t foo <struct-boa>   bar <struct-boa>
+    1   2 3 t struct-test-foo <struct-boa>   struct-test-bar <struct-boa>
     {
         [ w>> ] 
         [ foo>> x>> ]
@@ -28,35 +28,85 @@ STRUCT: bar
     } cleave
 ] unit-test
 
-[ 7654 ] [ S{ foo f 98 7654 f } y>> ] unit-test
-[ 7654 ] [ S{ foo { y 7654 } } y>> ] unit-test
+[ 7654 ] [ S{ struct-test-foo f 98 7654 f } y>> ] unit-test
+[ 7654 ] [ S{ struct-test-foo { y 7654 } } y>> ] unit-test
 
-UNION-STRUCT: float-and-bits
+UNION-STRUCT: struct-test-float-and-bits
     { f single-float }
     { bits uint } ;
 
-[ 1.0 ] [ float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
-[ 4 ] [ float-and-bits heap-size ] unit-test
+[ 1.0 ] [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
+[ 4 ] [ struct-test-float-and-bits heap-size ] unit-test
 
-[ ] [ foo malloc-struct free ] unit-test
+[ ] [ struct-test-foo malloc-struct free ] unit-test
 
-[ "S{ foo { y 7654 } }" ]
-[ f boa-tuples? [ foo <struct> 7654 >>y [ pprint ] with-string-writer ] with-variable ] unit-test
+[ "S{ struct-test-foo { y 7654 } }" ]
+[
+    f boa-tuples?
+    [ struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer ]
+    with-variable
+] unit-test
 
-[ "S{ foo f 0 7654 f }" ]
-[ t boa-tuples? [ foo <struct> 7654 >>y [ pprint ] with-string-writer ] with-variable ] unit-test
+[ "S{ struct-test-foo f 0 7654 f }" ]
+[
+    t boa-tuples?
+    [ struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer ]
+    with-variable
+] unit-test
 
 [ <" USING: classes.c-types classes.struct kernel ;
 IN: classes.struct.tests
-STRUCT: foo
+STRUCT: struct-test-foo
     { x char initial: 0 } { y int initial: 123 }
     { z boolean initial: f } ;
 "> ]
-[ [ foo see ] with-string-writer ] unit-test
+[ [ struct-test-foo see ] with-string-writer ] unit-test
 
 [ <" USING: classes.c-types classes.struct ;
 IN: classes.struct.tests
-UNION-STRUCT: float-and-bits
+UNION-STRUCT: struct-test-float-and-bits
     { f single-float initial: 0.0 } { bits uint initial: 0 } ;
 "> ]
-[ [ float-and-bits see ] with-string-writer ] unit-test
+[ [ struct-test-float-and-bits see ] with-string-writer ] unit-test
+
+[ {
+    T{ field-spec
+        { name "x" }
+        { offset 0 }
+        { type $[ char c-type ] }
+        { reader x>> }
+        { writer (>>x) }
+    }
+    T{ field-spec
+        { name "y" }
+        { offset 4 }
+        { type $[ int c-type ] }
+        { reader y>> }
+        { writer (>>y) }
+    }
+    T{ field-spec
+        { name "z" }
+        { offset 8 }
+        { type $[ boolean c-type ] }
+        { reader z>> }
+        { writer (>>z) }
+    }
+} ] [ "struct-test-foo" c-type fields>> ] unit-test
+
+[ {
+    T{ field-spec
+        { name "f" }
+        { offset 0 }
+        { type $[ single-float c-type ] }
+        { reader f>> }
+        { writer (>>f) }
+    }
+    T{ field-spec
+        { name "bits" }
+        { offset 0 }
+        { type $[ uint c-type ] }
+        { reader bits>> }
+        { writer (>>bits) }
+    }
+} ] [ "struct-test-float-and-bits" c-type fields>> ] unit-test
+
diff --git a/extra/classes/struct/struct.factor b/extra/classes/struct/struct.factor
index 2794df1393..3d4ffe138b 100644
--- a/extra/classes/struct/struct.factor
+++ b/extra/classes/struct/struct.factor
@@ -1,10 +1,11 @@
 ! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types alien.structs arrays
+USING: accessors alien alien.c-types alien.structs alien.structs.fields arrays
 byte-arrays classes classes.c-types classes.parser classes.tuple
 classes.tuple.parser classes.tuple.private combinators
 combinators.smart fry generalizations generic.parser kernel
 kernel.private libc macros make math math.order parser
 quotations sequences slots slots.private struct-arrays words ;
+FROM: slots => reader-word writer-word ;
 IN: classes.struct
 
 ! struct class
@@ -92,12 +93,23 @@ M: struct-class writer-quot
 ! Struct as c-type
 
 : slot>field ( slot -- field )
-    [ class>> c-type ] [ name>> ] bi 2array ;
+    field-spec new swap {
+        [ name>> >>name ]
+        [ offset>> >>offset ]
+        [ class>> c-type >>type ]
+        [ name>> reader-word >>reader ]
+        [ name>> writer-word >>writer ]
+    } cleave ;
 
 : define-struct-for-class ( class -- )
     [
-        [ name>> ] [ vocabulary>> ] [ struct-slots [ slot>field ] map ] tri
-        define-struct
+        {
+            [ name>> ]
+            [ "struct-size" word-prop ]
+            [ "struct-align" word-prop ]
+            [ struct-slots [ slot>field ] map ]
+        } cleave
+        (define-struct)
     ] [
         [ name>> c-type ]
         [ (unboxer-quot) >>unboxer-quot ]
@@ -171,8 +183,8 @@ M: struct-class direct-array-of
     [ class>> c-type drop ] each ;
 
 : (define-struct-class) ( class slots offsets-quot -- )
-    [ drop struct f define-tuple-class ] swap
-    '[
+    [ drop struct f define-tuple-class ]
+    swap '[
         make-slots dup
         [ check-struct-slots ] _ [ struct-align [ align ] keep ] tri
         (struct-word-props)

From 400c89daf001d29031bf47c81fc8d03b845e392e Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 20 Aug 2009 15:10:42 -0500
Subject: [PATCH 02/11] "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

From 2760079b6573dcdd8684262e83ef43d0c1745978 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 20 Aug 2009 15:35:11 -0500
Subject: [PATCH 03/11] deprecation docs

---
 basis/deprecation/deprecation-docs.factor | 13 +++++++++++++
 1 file changed, 13 insertions(+)
 create mode 100644 basis/deprecation/deprecation-docs.factor

diff --git a/basis/deprecation/deprecation-docs.factor b/basis/deprecation/deprecation-docs.factor
new file mode 100644
index 0000000000..79ade7ab51
--- /dev/null
+++ b/basis/deprecation/deprecation-docs.factor
@@ -0,0 +1,13 @@
+! (c)2009 Joe Groff bsd license
+USING: help.markup help.syntax kernel words ;
+IN: deprecation
+
+HELP: :deprecations
+{ $description "Prints all deprecation notes." } ;
+
+ARTICLE: "deprecation" "Deprecation tracking"
+"Factor's core syntax defines a " { $link POSTPONE: deprecated } " word that can be applied to words to mark them as deprecated. When the " { $vocab-link "deprecation" } " vocabulary is loaded, notes will be collected and reported by the " { $link "tools.errors" } " mechanism when deprecated words are used to define other words."
+{ $subsection POSTPONE: deprecated }
+{ $subsection :deprecations } ;
+
+ABOUT: "deprecation"

From 6089251574ea2b08164a99b45ffb654770f5b2b0 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 20 Aug 2009 16:17:36 -0500
Subject: [PATCH 04/11] move deprecation to tools.deprecation; load with
 bootstrap.tools

---
 basis/bootstrap/tools/tools.factor                    | 1 +
 basis/{ => tools}/deprecation/authors.txt             | 0
 basis/{ => tools}/deprecation/deprecation-docs.factor | 8 ++++----
 basis/{ => tools}/deprecation/deprecation.factor      | 8 ++++----
 basis/{ => tools}/deprecation/summary.txt             | 0
 core/syntax/syntax-docs.factor                        | 2 +-
 6 files changed, 10 insertions(+), 9 deletions(-)
 rename basis/{ => tools}/deprecation/authors.txt (100%)
 rename basis/{ => tools}/deprecation/deprecation-docs.factor (52%)
 rename basis/{ => tools}/deprecation/deprecation.factor (92%)
 rename basis/{ => tools}/deprecation/summary.txt (100%)

diff --git a/basis/bootstrap/tools/tools.factor b/basis/bootstrap/tools/tools.factor
index 6017469925..da8128de7c 100644
--- a/basis/bootstrap/tools/tools.factor
+++ b/basis/bootstrap/tools/tools.factor
@@ -8,6 +8,7 @@ IN: bootstrap.tools
     "tools.crossref"
     "tools.errors"
     "tools.deploy"
+    "tools.deprecation"
     "tools.disassembler"
     "tools.memory"
     "tools.profiler"
diff --git a/basis/deprecation/authors.txt b/basis/tools/deprecation/authors.txt
similarity index 100%
rename from basis/deprecation/authors.txt
rename to basis/tools/deprecation/authors.txt
diff --git a/basis/deprecation/deprecation-docs.factor b/basis/tools/deprecation/deprecation-docs.factor
similarity index 52%
rename from basis/deprecation/deprecation-docs.factor
rename to basis/tools/deprecation/deprecation-docs.factor
index 79ade7ab51..28d771c170 100644
--- a/basis/deprecation/deprecation-docs.factor
+++ b/basis/tools/deprecation/deprecation-docs.factor
@@ -1,13 +1,13 @@
 ! (c)2009 Joe Groff bsd license
 USING: help.markup help.syntax kernel words ;
-IN: deprecation
+IN: tools.deprecation
 
 HELP: :deprecations
 { $description "Prints all deprecation notes." } ;
 
-ARTICLE: "deprecation" "Deprecation tracking"
-"Factor's core syntax defines a " { $link POSTPONE: deprecated } " word that can be applied to words to mark them as deprecated. When the " { $vocab-link "deprecation" } " vocabulary is loaded, notes will be collected and reported by the " { $link "tools.errors" } " mechanism when deprecated words are used to define other words."
+ARTICLE: "tools.deprecation" "Deprecation tracking"
+"Factor's core syntax defines a " { $link POSTPONE: deprecated } " word that can be applied to words to mark them as deprecated. When the " { $vocab-link "tools.deprecation" } " vocabulary is loaded, notes will be collected and reported by the " { $link "tools.errors" } " mechanism when deprecated words are used to define other words."
 { $subsection POSTPONE: deprecated }
 { $subsection :deprecations } ;
 
-ABOUT: "deprecation"
+ABOUT: "tools.deprecation"
diff --git a/basis/deprecation/deprecation.factor b/basis/tools/deprecation/deprecation.factor
similarity index 92%
rename from basis/deprecation/deprecation.factor
rename to basis/tools/deprecation/deprecation.factor
index 4774ba7ff9..397fc8719d 100644
--- a/basis/deprecation/deprecation.factor
+++ b/basis/tools/deprecation/deprecation.factor
@@ -1,9 +1,9 @@
 ! (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
+source-files.errors summary tools.crossref
+tools.crossref.private tools.errors words ;
+IN: tools.deprecation
 
 SYMBOL: +deprecation-note+
 SYMBOL: deprecation-notes
@@ -42,7 +42,7 @@ T{ error-type
 : check-deprecations ( word -- )
     dup "forgotten" word-prop
     [ clear-deprecation-note ] [
-        dup def>> [ deprecated? ] filter
+        dup def>> uses [ deprecated? ] filter
         [ clear-deprecation-note ] [ >array deprecation-note ] if-empty
     ] if ;
 
diff --git a/basis/deprecation/summary.txt b/basis/tools/deprecation/summary.txt
similarity index 100%
rename from basis/deprecation/summary.txt
rename to basis/tools/deprecation/summary.txt
diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor
index 320387e506..a988e57365 100644
--- a/core/syntax/syntax-docs.factor
+++ b/core/syntax/syntax-docs.factor
@@ -193,7 +193,7 @@ HELP: delimiter
 
 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." } ;
+{ $description "Declares the most recently defined word as deprecated. If the " { $vocab-link "tools.deprecation" } " vocabulary is loaded, usages of deprecated words will be noted as they are made." } ;
 
 HELP: SYNTAX:
 { $syntax "SYNTAX: foo ... ;" }

From 94c50cfaebeb5c2d8b8296ed5a81f3e62e1e5c34 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 20 Aug 2009 16:18:06 -0500
Subject: [PATCH 05/11] install deprecation definition-observer as an init-hook

---
 basis/tools/deprecation/deprecation.factor | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/basis/tools/deprecation/deprecation.factor b/basis/tools/deprecation/deprecation.factor
index 397fc8719d..90dba554cb 100644
--- a/basis/tools/deprecation/deprecation.factor
+++ b/basis/tools/deprecation/deprecation.factor
@@ -1,6 +1,6 @@
 ! (c)2009 Joe Groff bsd license
 USING: accessors arrays assocs compiler.units
-debugger io kernel namespaces prettyprint sequences
+debugger init io kernel namespaces prettyprint sequences
 source-files.errors summary tools.crossref
 tools.crossref.private tools.errors words ;
 IN: tools.deprecation
@@ -67,6 +67,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-init-hook
 
 initialize-deprecation-notes

From 6ca45f07b46a9476d6e6d2f07f7b1a5179774171 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 20 Aug 2009 16:18:28 -0500
Subject: [PATCH 06/11] load tools.deprecation from bootstrap.tools

---
 basis/bootstrap/tools/tools.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/bootstrap/tools/tools.factor b/basis/bootstrap/tools/tools.factor
index da8128de7c..e5e7e869c8 100644
--- a/basis/bootstrap/tools/tools.factor
+++ b/basis/bootstrap/tools/tools.factor
@@ -8,13 +8,13 @@ IN: bootstrap.tools
     "tools.crossref"
     "tools.errors"
     "tools.deploy"
-    "tools.deprecation"
     "tools.disassembler"
     "tools.memory"
     "tools.profiler"
     "tools.test"
     "tools.time"
     "tools.threads"
+    "tools.deprecation"
     "vocabs.hierarchy"
     "vocabs.refresh"
     "vocabs.refresh.monitor"

From 90f8cdc0d1628359e55e3f90f5dfbd4252c7e9a2 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 20 Aug 2009 16:18:47 -0500
Subject: [PATCH 07/11] link tools.deprecation docs into handbook and
 error-list docs

---
 basis/help/handbook/handbook.factor              | 1 +
 basis/ui/tools/error-list/error-list-docs.factor | 1 +
 2 files changed, 2 insertions(+)

diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor
index a18dcd03f7..1c63360025 100644
--- a/basis/help/handbook/handbook.factor
+++ b/basis/help/handbook/handbook.factor
@@ -288,6 +288,7 @@ ARTICLE: "handbook-tools-reference" "Developer tools"
 { $subsection "prettyprint" }
 { $subsection "inspector" }
 { $subsection "tools.annotations" }
+{ $subsection "tools.deprecation" }
 { $subsection "tools.inference" }
 { $heading "Browsing" }
 { $subsection "see" }
diff --git a/basis/ui/tools/error-list/error-list-docs.factor b/basis/ui/tools/error-list/error-list-docs.factor
index ec96ac4078..07c92224b2 100644
--- a/basis/ui/tools/error-list/error-list-docs.factor
+++ b/basis/ui/tools/error-list/error-list-docs.factor
@@ -14,6 +14,7 @@ $nl
     { { $image "vocab:ui/tools/error-list/icons/linkage-error.tiff" } "Linkage error" { $link "loading-libs" } }
     { { $image "vocab:ui/tools/error-list/icons/help-lint-error.tiff" } "Help lint failure" { $link "help.lint" } }
     { { $image "vocab:ui/tools/error-list/icons/unit-test-error.tiff" } "Unit test failure" { $link "tools.test" } }
+    { { $image "vocab:ui/tools/error-list/icons/deprecation-note.tiff" } "Deprecated words used" { $link "tools.deprecation" } }
 } ;
 
 ABOUT: "ui.tools.error-list"

From 49bd2228ec464699ab322cc12e89220589907359 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Aug 2009 17:56:49 -0500
Subject: [PATCH 08/11] compiler.tree.modular-arithmetic: fix regression;
 set-alien-*-1 was not always open-coded

---
 basis/compiler/tests/optimizer.factor                          | 3 ++-
 .../compiler/tree/modular-arithmetic/modular-arithmetic.factor | 2 +-
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor
index 6092a6dca6..45ea841a73 100644
--- a/basis/compiler/tests/optimizer.factor
+++ b/basis/compiler/tests/optimizer.factor
@@ -424,4 +424,5 @@ M: object bad-dispatch-position-test* ;
     ] with-compilation-unit
 ] unit-test
 
-[ t [ [ f ] [ 3 ] if >fixnum ] compile-call ] [ no-method? ] must-fail-with
\ No newline at end of file
+! Not sure if I want to fix this...
+! [ t [ [ f ] [ 3 ] if >fixnum ] compile-call ] [ no-method? ] must-fail-with
\ No newline at end of file
diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor
index 5dbc639430..8ca80ccbae 100644
--- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor
+++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor
@@ -172,7 +172,7 @@ MEMO: fixnum-coercion ( flags -- nodes )
     ] when ;
 
 : optimize-low-order-op ( #call -- nodes )
-    dup in-d>> first fixnum-value? [
+    dup in-d>> first actually-defined-by [ value>> fixnum-value? ] all? [
         [ ] [ in-d>> first ] [ info>> ] tri
         [ drop fixnum <class-info> ] change-at
     ] when ;

From 5197aca215a1be80d8f00cd458a32d7f684a8fa7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 20 Aug 2009 18:15:41 -0500
Subject: [PATCH 09/11] compiler.cfg.dataflow-analysis: when intersecting sets,
 treat uninitialized sets as universal rather than empty; reduces number of
 stack instructions generated by 1%

---
 .../compiler/cfg/dataflow-analysis/dataflow-analysis.factor | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor
index 275a4585b0..dde44fd15d 100644
--- a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor
+++ b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor
@@ -23,7 +23,11 @@ GENERIC# compute-in-set 2 ( bb out-sets dfa -- set )
 M: kill-block compute-in-set 3drop f ;
 
 M:: basic-block compute-in-set ( bb out-sets dfa -- set )
-    bb dfa predecessors [ out-sets at ] map bb dfa join-sets ;
+    ! Only consider initialized sets.
+    bb dfa predecessors
+    [ out-sets key? ] filter
+    [ out-sets at ] map
+    bb dfa join-sets ;
 
 :: update-in-set ( bb in-sets out-sets dfa -- ? )
     bb out-sets dfa compute-in-set

From 9ab8734441eb9849daf4c04ee5996258e2cf8d3a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 21 Aug 2009 18:48:34 -0500
Subject: [PATCH 10/11] cpu.ppc: work in progress

---
 basis/cpu/ppc/ppc.factor | 64 +++++++++++++++++++++-------------------
 1 file changed, 33 insertions(+), 31 deletions(-)

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index dfcb68dfc1..eba2099399 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -89,11 +89,8 @@ HOOK: reserved-area-size os ( -- n )
 : local@ ( n -- x )
     reserved-area-size param-save-size + + ; inline
 
-: spill-integer@ ( n -- offset )
-    spill-integer-offset local@ ;
-
-: spill-float@ ( n -- offset )
-    spill-float-offset local@ ;
+: spill@ ( n -- offset )
+    spill-offset local@ ;
 
 ! Some FP intrinsics need a temporary scratch area in the stack
 ! frame, 8 bytes in size. This is in the param-save area so it
@@ -275,9 +272,11 @@ M:: ppc %float>integer ( dst src -- )
     fp-scratch-reg 1 0 scratch@ STFD
     dst 1 4 scratch@ LWZ ;
 
-M: ppc %copy ( dst src -- ) MR ;
-
-M: ppc %copy-float ( dst src -- ) FMR ;
+M: ppc %copy ( dst src rep -- )
+    {
+        { int-rep [ MR ] }
+        { double-float-rep [ FMR ] }
+    } case ;
 
 M: ppc %unbox-float ( dst src -- ) float-offset LFD ;
 
@@ -478,11 +477,29 @@ M: ppc %compare-branch (%compare) %branch ;
 M: ppc %compare-imm-branch (%compare-imm) %branch ;
 M: ppc %compare-float-branch (%compare-float) %branch ;
 
-M: ppc %spill-integer ( src n -- ) spill-integer@ 1 swap STW ;
-M: ppc %reload-integer ( dst n -- ) spill-integer@ 1 swap LWZ ;
+: load-from-frame ( dst n rep -- )
+    {
+        { int-rep [ [ 1 ] dip LWZ ] }
+        { single-float-rep [ [ 1 ] dip LFS ] }
+        { double-float-rep [ [ 1 ] dip LFD ] }
+        { stack-params [ [ 0 1 ] dip LWZ [ 0 1 ] dip param@ STW ] }
+    } case ;
 
-M: ppc %spill-float ( src n -- ) spill-float@ 1 swap STFD ;
-M: ppc %reload-float ( dst n -- ) spill-float@ 1 swap LFD ;
+: next-param@ ( n -- x ) param@ stack-frame get total-size>> + ;
+
+: store-to-frame ( src n rep -- )
+    {
+        { int-rep [ [ 1 ] dip STW ] }
+        { single-float-rep [ [ 1 ] dip STFS ] }
+        { double-float-rep [ [ 1 ] dip STFD ] }
+        { stack-params [ [ [ 0 1 ] dip next-param@ LWZ 0 1 ] dip STW ] }
+    } case ;
+
+M: ppc %spill ( src n rep -- )
+    [ spill@ ] dip store-to-frame ;
+
+M: ppc %reload ( dst n rep -- )
+    [ spill@ ] dip load-from-frame ;
 
 M: ppc %loop-entry ;
 
@@ -490,26 +507,11 @@ M: int-regs return-reg drop 3 ;
 M: int-regs param-regs drop { 3 4 5 6 7 8 9 10 } ;
 M: float-regs return-reg drop 1 ;
 
-M: int-regs %save-param-reg drop 1 rot local@ STW ;
-M: int-regs %load-param-reg drop 1 rot local@ LWZ ;
+M:: ppc %save-param-reg ( stack reg rep -- )
+    reg stack local@ rep store-to-frame ;
 
-M: single-float-rep %save-param-reg drop 1 rot local@ STFS ;
-M: single-float-rep %load-param-reg 1 rot local@ LFS ;
-
-M: double-float-rep %save-param-reg drop 1 rot local@ STFD ;
-M: double-float-rep %load-param-reg 1 rot local@ LFD ;
-
-M: stack-params %load-param-reg ( stack reg rep -- )
-    drop [ 0 1 rot local@ LWZ 0 1 ] dip param@ STW ;
-
-: next-param@ ( n -- x ) param@ stack-frame get total-size>> + ;
-
-M: stack-params %save-param-reg ( stack reg rep -- )
-    #! Funky. Read the parameter from the caller's stack frame.
-    #! This word is used in callbacks
-    drop
-    [ 0 1 ] dip next-param@ LWZ
-    [ 0 1 ] dip local@ STW ;
+M:: ppc %load-param-reg ( stack reg rep -- )
+    reg stack local@ rep load-from-frame ;
 
 M: ppc %prepare-unbox ( -- )
     ! First parameter is top of stack

From 1961b4da16c319c4f7682ff65e2de32e2e654ca9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 21 Aug 2009 20:15:19 -0500
Subject: [PATCH 11/11] next-fastcall-param word was not being called; on x86
 its equivalent to inc but on ppc there is more logic, this fixes FFI on
 PowerPC

---
 basis/compiler/codegen/codegen.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index d1a09394cd..d1b5558beb 100755
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -267,7 +267,7 @@ M: ##alien-global generate-insn
     %alien-global ;
 
 ! ##alien-invoke
-GENERIC: next-fastcall-param ( reg-class -- )
+GENERIC: next-fastcall-param ( rep -- )
 
 : ?dummy-stack-params ( rep -- )
     dummy-stack-params? [ rep-size cell align stack-params +@ ] [ drop ] if ;
@@ -300,7 +300,7 @@ M: reg-class reg-class-full?
     stack-params dup ;
 
 : alloc-fastcall-param ( rep -- n reg-class rep )
-    [ reg-class-of [ get ] [ inc ] [ ] tri ] keep ;
+    [ [ reg-class-of get ] [ reg-class-of ] [ next-fastcall-param ] tri ] keep ;
 
 : alloc-parameter ( parameter -- reg rep )
     c-type-rep dup reg-class-of reg-class-full?