Fix a smudging bug

core/definitions/definitions.factor

@@ -43,7 +43,7 @@ M: object uses drop f ;
 
 : xref ( defspec -- ) dup uses crossref get add-vertex ;
 
-: usage ( defspec -- seq ) crossref get at keys ;
+: usage ( defspec -- seq ) \ f or crossref get at keys ;
 
 GENERIC: redefined* ( defspec -- )
 

core/generic/generic.factor

@@ -102,11 +102,13 @@ M: method-body stack-effect
 
 ! Definition protocol
 M: method-spec where
-    dup first2 method [ method-loc ] [ second where ] ?if ;
+    dup first2 method [ method-word ] [ second ] ?if where ;
 
-M: method-spec set-where first2 method set-method-loc ;
+M: method-spec set-where
+    first2 method method-word set-where ;
 
-M: method-spec definer drop \ M: \ ; ;
+M: method-spec definer
+    drop \ M: \ ; ;
 
 M: method-spec definition
     first2 method dup [ method-def ] when ;
@@ -116,7 +118,19 @@ M: method-spec definition
     [ delete-at* ] with-methods
     [ method-word forget ] [ drop ] if ;
 
-M: method-spec forget* first2 forget-method ;
+M: method-spec forget*
+    first2 forget-method ;
+
+M: method-body definer
+    drop \ M: \ ; ;
+
+M: method-body definition
+    "method" word-prop method-def ;
+
+M: method-body forget*
+    "method" word-prop
+    { method-specializer method-generic } get-slots
+    forget-method ;
 
 : implementors* ( classes -- words )
     all-words [

core/parser/parser-tests.factor

@@ -351,13 +351,18 @@ IN: temporary
     << file get parsed >> file set
 
     : ~a ;
-    : ~b ~a ;
+
+    DEFER: ~b
+
+    "IN: temporary : ~b ~a ;" <string-reader>
+    "smudgy" parse-stream drop
+
     : ~c ;
     : ~d ;
 
-    { H{ { ~a ~a } { ~c ~c } { ~d ~d } } H{ } } old-definitions set
+    { H{ { ~a ~a } { ~b ~b } { ~c ~c } { ~d ~d } } H{ } } old-definitions set
     
-    { H{ { ~d ~d } } H{ } } new-definitions set
+    { H{ { ~b ~b } { ~d ~d } } H{ } } new-definitions set
     
     [ V{ ~b } { ~a } { ~a ~c } ] [
         smudged-usage
@@ -365,6 +370,24 @@ IN: temporary
     ] unit-test
 ] with-scope
 
+[
+    << file get parsed >> file set
+
+    GENERIC: ~e
+
+    : ~f ~e ;
+
+    : ~g ;
+
+    { H{ { ~e ~e } { ~f ~f } { ~g ~g } } H{ } } old-definitions set
+    
+    { H{ { ~g ~g } } H{ } } new-definitions set
+
+    [ V{ } { } { ~e ~f } ]
+    [ smudged-usage natural-sort ]
+    unit-test
+] with-scope
+
 [ ] [
     "IN: temporary USE: kernel PREDICATE: object foo ( x -- y ) ;" eval
 ] unit-test

core/parser/parser.factor

@@ -439,11 +439,12 @@ SYMBOL: interactive-vocabs
         "Warning: the following definitions were removed from sources," print
         "but are still referenced from other definitions:" print
         nl
-        dup stack.
+        dup sorted-definitions.
         nl
         "The following definitions need to be updated:" print
         nl
-        over stack.
+        over sorted-definitions.
+        nl
     ] when 2drop ;
 
 : filter-moved ( assoc -- newassoc )

core/prettyprint/prettyprint.factor

@@ -174,6 +174,12 @@ M: hook-generic synopsis*
 M: method-spec synopsis*
     dup definer. [ pprint-word ] each ;
 
+M: method-body synopsis*
+    dup definer.
+    "method" word-prop dup
+    method-specializer pprint*
+    method-generic pprint* ;
+
 M: mixin-instance synopsis*
     dup definer.
     dup mixin-instance-class pprint-word
@@ -188,6 +194,15 @@ M: pathname synopsis* pprint* ;
         [ synopsis* ] with-in
     ] with-string-writer ;
 
+: synopsis-alist ( definitions -- alist )
+    [ dup synopsis swap ] { } map>assoc ;
+
+: definitions. ( alist -- )
+    [ write-object nl ] assoc-each ;
+
+: sorted-definitions. ( definitions -- )
+    synopsis-alist sort-keys definitions. ;
+
 GENERIC: declarations. ( obj -- )
 
 M: object declarations. drop ;
@@ -253,7 +268,9 @@ M: builtin-class see-class*
     natural-sort [ nl see ] each ;
 
 : see-implementors ( class -- seq )
-    dup implementors [ 2array ] with map ;
+    dup implementors
+    [ method method-word ] with map
+    natural-sort ;
 
 : see-class ( class -- )
     dup class? [
@@ -263,8 +280,9 @@ M: builtin-class see-class*
     ] when drop ;
 
 : see-methods ( generic -- seq )
-    [ "methods" word-prop keys natural-sort ] keep
+    "methods" word-prop
-    [ 2array ] curry map ;
+    [ nip method-word ] { } assoc>map
+    natural-sort ;
 
 M: word see
     dup see-class

core/source-files/source-files.factor

@@ -97,16 +97,8 @@ SYMBOL: file
         [ ] [ 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
+        over usage
+        [ dup pathname? not swap where and ] subset seq-diff
     ] curry { } map>assoc ;

extra/editors/editors.factor

@@ -43,7 +43,7 @@ SYMBOL: edit-hook
 
 : fix ( word -- )
     "Fixing " write dup pprint " and all usages..." print nl
-    dup smart-usage swap add* [
+    dup usage swap add* [
         "Editing " write dup .
         "RETURN moves on to the next usage, C+d stops." print
         flush

extra/tools/crossref/crossref-tests.factor

@@ -8,5 +8,5 @@ M: integer foo + ;
 
 "resource:extra/tools/test/foo.factor" run-file
 
-[ t ] [ { integer foo } \ + smart-usage member? ] unit-test
+[ t ] [ integer \ foo method method-word \ + usage member? ] unit-test
-[ t ] [ \ foo smart-usage [ pathname? ] contains? ] unit-test
+[ t ] [ \ foo usage [ pathname? ] contains? ] unit-test

extra/tools/crossref/crossref.factor

@@ -6,14 +6,8 @@ generic tools.completion quotations parser inspector
 sorting hashtables vocabs parser source-files ;
 IN: tools.crossref
 
-: synopsis-alist ( definitions -- alist )
-    [ dup synopsis swap ] { } map>assoc ;
-
-: definitions. ( alist -- )
-    [ write-object nl ] assoc-each ;
-
 : usage. ( word -- )
-    smart-usage synopsis-alist sort-keys definitions. ;
+    usage sorted-definitions. ;
 
 : words-matching ( str -- seq )
     all-words [ dup word-name ] { } map>assoc completions ;

extra/ui/tools/search/search.factor

@@ -3,8 +3,8 @@
 USING: assocs ui.tools.interactor ui.tools.listener
 ui.tools.workspace help help.topics io.files io.styles kernel
 models namespaces prettyprint quotations sequences sorting
-source-files strings tools.completion tools.crossref tuples
+source-files definitions strings tools.completion tools.crossref
-ui.commands ui.gadgets ui.gadgets.editors
+tuples ui.commands ui.gadgets ui.gadgets.editors
 ui.gadgets.lists ui.gadgets.scrollers ui.gadgets.tracks
 ui.gestures ui.operations vocabs words vocabs.loader
 tools.browser unicode.case calendar ;
@@ -93,7 +93,7 @@ M: live-search pref-dim* drop { 400 200 } ;
     "Words in " rot vocab-name append show-titled-popup ;
 
 : show-word-usage ( workspace word -- )
-    "" over smart-usage f <definition-search>
+    "" over usage f <definition-search>
     "Words and methods using " rot word-name append
     show-titled-popup ;