Method usages cleanup

core/bootstrap/image/image.factor

@@ -203,14 +203,8 @@ M: f '
 
 ! Words
 
-DEFER: emit-word
-
-: emit-generic ( generic -- )
-    dup "default-method" word-prop method-word emit-word
-    "methods" word-prop [ nip method-word emit-word ] assoc-each ;
-
 : emit-word ( word -- )
-    dup generic? [ dup emit-generic ] when
+    dup subwords [ emit-word ] each
     [
         dup hashcode ' ,
         dup word-name ' ,

core/bootstrap/stage2.factor

@@ -24,6 +24,7 @@ IN: bootstrap.stage2
         "Cross-referencing..." print flush
         H{ } clone crossref set-global
         xref-words
+        xref-generics
         xref-sources
     ] unless
 

core/compiler/units/units-docs.factor

@@ -28,9 +28,7 @@ HELP: redefine-error
 
 HELP: remember-definition
 { $values { "definition" "a definition specifier" } { "loc" "a " { $snippet "{ path line# }" } " pair" } }
-{ $description "Saves the location of a definition and associates this definition with the current source file."
+{ $description "Saves the location of a definition and associates this definition with the current source file." } ;
-$nl
-"This is the book-keeping required to detect " { $link redefine-error } " and " { $link forward-error } "." } ;
 
 HELP: old-definitions
 { $var-description "Stores an assoc where the keys form the set of definitions which were defined by " { $link file } " the most recent time it was loaded." } ;
@@ -38,11 +36,6 @@ HELP: old-definitions
 HELP: new-definitions
 { $var-description "Stores an assoc where the keys form the set of definitions which were defined so far by the current parsing of " { $link file } "." } ;
 
-HELP: forward-error
-{ $values { "word" word } }
-{ $description "Throws a " { $link forward-error } "." }
-{ $description "Indicates a word is being referenced prior to the location of its most recent definition. This can only happen if a source file is loaded, and subsequently edited such that two dependent definitions are reversed." } ;
-
 HELP: with-compilation-unit
 { $values { "quot" quotation } }
 { $description "Calls a quotation in a new compilation unit. The quotation can define new words and classes, as well as forget words. When the quotation returns, any changed words are recompiled, and changes are applied atomically." }

core/compiler/units/units.factor

@@ -26,11 +26,6 @@ TUPLE: redefine-error def ;
     over new-definitions get first key? [ dup redefine-error ] when
     new-definitions get second (remember-definition) ;
 
-TUPLE: forward-error word ;
-
-: forward-error ( word -- )
-    \ forward-error construct-boa throw ;
-
 : forward-reference? ( word -- ? )
     dup old-definitions get assoc-stack
     [ new-definitions get assoc-stack not ]

core/definitions/definitions-docs.factor

@@ -52,9 +52,7 @@ $nl
 $nl
 "If the parser did not have special checks for this case, then the modified source file would still load, because when the definition of " { $snippet "hello-world" } " on line 4 is being parsed, the " { $snippet "world" } " word is already present in the dictionary from an earlier run. The developer would then not discover this mistake until attempting to load the source file into a fresh image."
 $nl
-"Since this is undesirable, the parser explicitly raises an error if a source file refers to a word which is in the dictionary, but defined after it is used."
+"Since this is undesirable, the parser explicitly raises a " { $link no-word } " error if a source file refers to a word which is in the dictionary, but defined after it is used."
-{ $subsection forward-error }
-"If a source file raises a " { $link forward-error } " when loaded into a development image, then it would have raised a " { $link no-word } " error when loaded into a fresh image."
 $nl
 "The parser also catches duplicate definitions. If an artifact is defined twice in the same source file, the earlier definition will never be accessible, and this is almost always a mistake, perhaps due to a bad choice of word names, or a copy and paste error. The parser raises an error in this case."
 { $subsection redefine-error } ;

core/definitions/definitions-tests.factor

@@ -6,6 +6,8 @@ TUPLE: combination-1 ;
 
 M: combination-1 perform-combination 2drop { } [ ] each [ ] ;
 
+M: combination-1 make-default-method 2drop [ "No method" throw ] ;
+
 SYMBOL: generic-1
 
 [
@@ -20,7 +22,7 @@ SYMBOL: generic-1
     ] with-compilation-unit
 ] unit-test
 
-GENERIC: some-generic
+GENERIC: some-generic ( a -- b )
 
 USE: arrays
 

core/generic/generic-tests.factor

@@ -177,7 +177,7 @@ M: f tag-and-f 4 ;
 TUPLE: debug-combination ;
 
 M: debug-combination make-default-method
-    2drop [ "Oops" throw ] when ;
+    2drop [ "Oops" throw ] ;
 
 M: debug-combination perform-combination
     drop

core/generic/generic.factor

@@ -73,7 +73,8 @@ M: method-body stack-effect
 : <method-word> ( quot class generic -- word )
     [ make-method-def ] 2keep
     method-word-name f <word>
-    dup rot define ;
+    dup rot define
+    dup xref ;
 
 : <method> ( quot class generic -- method )
     check-method
@@ -135,12 +136,14 @@ M: assoc update-methods ( assoc -- )
         make-generic
     ] if ;
 
-: subwords ( generic -- seq )
+GENERIC: subwords ( word -- seq )
+
+M: word subwords drop f ;
+
+M: generic subwords
     dup "methods" word-prop values
     swap "default-method" word-prop add
     [ method-word ] map ;
 
 : xref-generics ( -- )
-    all-words
+    all-words [ subwords [ xref ] each ] each ;
-    [ generic? ] subset
-    [ subwords [ xref ] each ] each ;

core/generic/standard/standard.factor

@@ -91,7 +91,7 @@ TUPLE: no-method object generic ;
 
 : class-hash-dispatch-quot ( methods quot picker -- quot )
     >r >r hash-methods r> map
-    hash-dispatch-quot r> [ class-hash ] rot 3append ;
+    hash-dispatch-quot r> [ class-hash ] rot 3append ; inline
 
 : big-generic ( methods -- quot )
     [ small-generic ] picker class-hash-dispatch-quot ;

core/inference/inference.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: inference.backend inference.state inference.dataflow
 inference.known-words inference.transforms inference.errors
-sequences prettyprint io effects kernel namespaces quotations
+kernel io effects namespaces sequences quotations vocabs
-words vocabs ;
+generic words ;
 IN: inference
 
 GENERIC: infer ( quot -- effect )
@@ -28,4 +28,7 @@ M: callable dataflow-with
     ] with-infer nip ;
 
 : forget-errors ( -- )
-    all-words [ f "no-effect" set-word-prop ] each ;
+    all-words [
+        dup subwords [ f "no-effect" set-word-prop ] each
+        f "no-effect" set-word-prop
+    ] each ;

core/optimizer/backend/backend.factor

@@ -256,7 +256,7 @@ M: #dispatch optimize-node*
     tuck dispatching-class dup [
         swap [ 2array ] 2keep
         method method-word
-        dup word-def flat-length 5 >=
+        dup word-def flat-length 6 >=
         [ 1quotation ] [ word-def ] if
     ] [
         2drop t t

core/parser/parser-docs.factor

@@ -202,9 +202,7 @@ HELP: location
 
 HELP: save-location
 { $values { "definition" "a definition specifier" } }
-{ $description "Saves the location of a definition and associates this definition with the current source file."
+{ $description "Saves the location of a definition and associates this definition with the current source file." } ;
-$nl
-"This is the book-keeping required to detect " { $link redefine-error } " and " { $link forward-error } "." } ;
 
 HELP: parser-notes
 { $var-description "A boolean controlling whether the parser will print various notes and warnings. Switched on by default. If a source file is being run for its effect on the " { $link stdio } " stream, this variable should be switched off, to prevent parser notes from polluting the output." } ;

core/parser/parser-tests.factor

@@ -342,7 +342,7 @@ IN: temporary
         [
             "IN: temporary \\ class-fwd-test"
             <string-reader> "redefining-a-class-3" parse-stream drop
-        ] catch [ forward-error? ] is?
+        ] catch [ no-word? ] is?
     ] unit-test
 
     [ ] [
@@ -354,7 +354,7 @@ IN: temporary
         [
             "IN: temporary \\ class-fwd-test"
             <string-reader> "redefining-a-class-3" parse-stream drop
-        ] catch [ forward-error? ] is?
+        ] catch [ no-word? ] is?
     ] unit-test
 
     [ t ] [

core/parser/parser.factor

@@ -235,7 +235,8 @@ M: no-word summary
 
 : no-word ( name -- newword )
     dup \ no-word construct-boa
-    swap words-named word-restarts throw-restarts
+    swap words-named [ forward-reference? not ] subset
+    word-restarts throw-restarts
     dup word-vocabulary (use+) ;
 
 : check-forward ( str word -- word )
@@ -244,7 +245,7 @@ M: no-word summary
         dup use get
         [ at ] with map [ ] subset
         [ forward-reference? not ] find nip
-        [ ] [ forward-error ] ?if
+        [ ] [ no-word ] ?if
     ] [
         nip
     ] if ;
@@ -415,11 +416,6 @@ SYMBOL: interactive-vocabs
         over stack.
     ] when 2drop ;
 
-: outside-usages ( seq -- usages )
-    dup [
-        over usage [ pathname? not ] subset seq-diff
-    ] curry { } map>assoc ;
-
 : filter-moved ( assoc -- newassoc )
     [
         drop where dup [ first ] when

core/source-files/source-files.factor

@@ -96,3 +96,17 @@ SYMBOL: file
         source-file-definitions old-definitions set
         [ ] [ file get rollback-source-file ] cleanup
     ] with-scope ; inline
+
+: smart-usage ( word -- definitions )
+    \ f or usage [
+        dup method-body? [
+            "method" word-prop
+            { method-specializer method-generic } get-slots
+            2array
+        ] when
+    ] map ;
+
+: outside-usages ( seq -- usages )
+    dup [
+        over smart-usage [ pathname? not ] subset seq-diff
+    ] curry { } map>assoc ;

core/vocabs/loader/loader-tests.factor

@@ -79,7 +79,7 @@ IN: temporary
         <string-reader>
         "resource:core/vocabs/loader/test/a/a.factor"
         parse-stream
-    ] catch [ forward-error? ] is?
+    ] catch [ no-word? ] is?
 ] unit-test
 
 0 "count-me" set-global

core/words/words-tests.factor

@@ -87,7 +87,8 @@ FORGET: foe
 ] unit-test
 
 [ t ] [
-    \ * usage [ word? ] subset [ interned? not ] subset empty?
+    \ * usage [ word? ] subset
+    [ dup interned? swap method-body? or ] all?
 ] unit-test
 
 DEFER: calls-a-gensym

extra/tools/browser/browser.factor

@@ -238,7 +238,7 @@ C: <vocab-author> vocab-author
 : vocab-xref ( vocab quot -- vocabs )
     >r dup vocab-name swap words r> map
     [ [ word? ] subset [ word-vocabulary ] map ] map>set
-    remove [ vocab ] map ; inline
+    remove [ ] subset [ vocab ] map ; inline
 
 : vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
 

extra/tools/crossref/crossref.factor

@@ -3,7 +3,7 @@
 USING: arrays definitions assocs io kernel
 math namespaces prettyprint sequences strings io.styles words
 generic tools.completion quotations parser inspector
-sorting hashtables vocabs ;
+sorting hashtables vocabs parser source-files ;
 IN: tools.crossref
 
 : synopsis-alist ( definitions -- alist )
@@ -12,21 +12,6 @@ IN: tools.crossref
 : definitions. ( alist -- )
     [ write-object nl ] assoc-each ;
 
-: (method-usage) ( word generic -- methods )
-    tuck methods
-    [ second uses member? ] with subset keys
-    swap [ 2array ] curry map ;
-
-: method-usage ( word seq -- methods )
-    [ generic? ] subset [ (method-usage) ] with map concat ;
-
-: compound-usage ( words -- seq )
-    [ generic? not ] subset ;
-
-: smart-usage ( word -- definitions )
-    \ f or
-    dup usage dup compound-usage -rot method-usage append ;
-
 : usage. ( word -- )
     smart-usage synopsis-alist sort-keys definitions. ;