Cleaning up and debugging corss-referencing

diff --git a/core/compiler/compiler.factor b/core/compiler/compiler.factor
index ef00e94dd52070d052bb3bb2618844f2b15238a1..8c653b866e4e4e7d99e1c73a72e2b9a1e42b3e83 100755 (executable)
--- a/core/compiler/compiler.factor
+++ b/core/compiler/compiler.factor
@@ -35,7 +35,7 @@ IN: compiler
     [ swap save-effect ]
     [ compiled-unxref ]
     [
-        dup compiled-crossref?
+        dup crossref?
         [ dependencies get compiled-xref ] [ drop ] if
     ] tri ;
 

diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor
index c2e84429cf5ed873de0bd4f5b4d40d461d88c694..6acd3a6415a4c49afe885a6096bd74d93672fe16 100755 (executable)
--- a/core/compiler/units/units.factor
+++ b/core/compiler/units/units.factor
@@ -66,7 +66,7 @@ GENERIC: definitions-changed ( assoc obj -- )
 
 : compile ( words -- )
     recompile-hook get call
-    dup [ drop compiled-crossref? ] assoc-contains?
+    dup [ drop crossref? ] assoc-contains?
     modify-code-heap ;
 
 SYMBOL: outdated-tuples
@@ -82,7 +82,7 @@ SYMBOL: update-tuples-hook
 : finish-compilation-unit ( -- )
     call-recompile-hook
     call-update-tuples-hook
-    dup [ drop compiled-crossref? ] assoc-contains? modify-code-heap
+    dup [ drop crossref? ] assoc-contains? modify-code-heap
      ;
 
 : with-nested-compilation-unit ( quot -- )

diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor
index 459512b83a29ef9e5907425c13ec2926c058b20d..122205eb26f8682c5de355999cb17b5a38665789 100755 (executable)
--- a/core/definitions/definitions.factor
+++ b/core/definitions/definitions.factor
@@ -47,7 +47,17 @@ M: object uses drop f ;
 
 : xref ( defspec -- ) dup uses crossref get add-vertex ;
 
-: usage ( defspec -- seq ) \ f or crossref get at keys ;
+: usage ( defspec -- seq ) crossref get at keys ;
+
+GENERIC: irrelevant? ( defspec -- ? )
+
+M: object irrelevant? drop f ;
+
+GENERIC: smart-usage ( defspec -- seq )
+
+M: f smart-usage drop \ f smart-usage ;
+
+M: object smart-usage usage [ irrelevant? not ] filter ;
 
 : unxref ( defspec -- )
     dup uses crossref get remove-vertex ;

diff --git a/core/generic/generic.factor b/core/generic/generic.factor
index b9a556e316298e127868bb4be6ba01155275ea08..c99de94ded4cb9430315a6f283a47066d2f461f5 100755 (executable)
--- a/core/generic/generic.factor
+++ b/core/generic/generic.factor
@@ -117,6 +117,9 @@ M: method-spec definition
 M: method-spec forget*
     first2 method forget* ;
 
+M: method-spec smart-usage
+    second smart-usage ;
+
 M: method-body definer
     drop \ M: \ ; ;
 
@@ -134,6 +137,9 @@ M: method-body forget*
         [ t "forgotten" set-word-prop ] bi
     ] if ;
 
+M: method-body smart-usage
+    "method-generic" word-prop smart-usage ;
+
 : implementors* ( classes -- words )
     all-words [
         "methods" word-prop keys

diff --git a/core/generic/standard/engines/tuple/tuple.factor b/core/generic/standard/engines/tuple/tuple.factor
index 51ea4f8225cec8c64eb22f1294bfbf6659a728a8..24fb8ba4f4f464430dad6a7e8c4bafa262569c03 100644 (file)
--- a/core/generic/standard/engines/tuple/tuple.factor
+++ b/core/generic/standard/engines/tuple/tuple.factor
@@ -4,7 +4,7 @@ USING: kernel classes.tuple.private hashtables assocs sorting
 accessors combinators sequences slots.private math.parser words
 effects namespaces generic generic.standard.engines
 classes.algebra math math.private kernel.private
-quotations arrays ;
+quotations arrays definitions ;
 IN: generic.standard.engines.tuple
 
 TUPLE: echelon-dispatch-engine n methods ;
@@ -64,8 +64,9 @@ M: engine-word stack-effect
     [ extra-values ] [ stack-effect ] bi
     dup [ clone [ length + ] change-in ] [ 2drop f ] if ;
 
-M: engine-word compiled-crossref?
-    drop t ;
+M: engine-word crossref? drop t ;
+
+M: engine-word irrelevant? drop t ;
 
 : remember-engine ( word -- )
     generic get "engines" word-prop push ;

diff --git a/core/generic/standard/standard-tests.factor b/core/generic/standard/standard-tests.factor
index 1bff9ae15d716260360639e03b8bb4e96b0aa7fe..66f191a93f05e4a4c2e5664284f3585a238f35ec 100644 (file)
--- a/core/generic/standard/standard-tests.factor
+++ b/core/generic/standard/standard-tests.factor
@@ -3,7 +3,8 @@ USING: tools.test math math.functions math.constants
 generic.standard strings sequences arrays kernel accessors
 words float-arrays byte-arrays bit-arrays parser namespaces
 quotations inference vectors growable hashtables sbufs
-prettyprint byte-vectors bit-vectors float-vectors ;
+prettyprint byte-vectors bit-vectors float-vectors definitions
+generic sets graphs assocs ;
 
 GENERIC: lo-tag-test
 
@@ -287,3 +288,24 @@ M: sbuf no-stack-effect-decl ;
 [ ] [ \ no-stack-effect-decl see ] unit-test
 
 [ ] [ \ no-stack-effect-decl word-def . ] unit-test
+
+! Cross-referencing with generic words
+TUPLE: xref-tuple-1 ;
+TUPLE: xref-tuple-2 < xref-tuple-1 ;
+
+: (xref-test) drop ;
+
+GENERIC: xref-test ( obj -- )
+
+M: xref-tuple-1 xref-test (xref-test) ;
+M: xref-tuple-2 xref-test (xref-test) ;
+
+[ t ] [
+    \ xref-test
+    \ xref-tuple-1 \ xref-test method [ usage unique ] closure key?
+] unit-test
+
+[ t ] [
+    \ xref-test
+    \ xref-tuple-2 \ xref-test method [ usage unique ] closure key?
+] unit-test

diff --git a/core/inference/backend/backend.factor b/core/inference/backend/backend.factor
index c49e7fda8ab19642513e1825f2a5c010be5653ce..9a0f4c772ef104d13616810e17e81e1eca2fce42 100755 (executable)
--- a/core/inference/backend/backend.factor
+++ b/core/inference/backend/backend.factor
@@ -4,7 +4,7 @@ USING: inference.dataflow inference.state arrays generic io
 io.streams.string kernel math namespaces parser prettyprint
 sequences strings vectors words quotations effects classes
 continuations debugger assocs combinators compiler.errors
-generic.standard.engines.tuple accessors math.order ;
+generic.standard.engines.tuple accessors math.order definitions ;
 IN: inference.backend
 
 : recursive-label ( word -- label/f )
@@ -21,6 +21,28 @@ M: engine-word inline?
 M: word inline?
     "inline" word-prop ;
 
+SYMBOL: visited
+
+: reset-on-redefine { "inferred-effect" "no-effect" } ; inline
+
+: (redefined) ( word -- )
+    dup visited get key? [ drop ] [
+        [ reset-on-redefine reset-props ]
+        [ dup visited get set-at ]
+        [
+            crossref get at keys
+            [ word? ] filter
+            [
+                [ reset-on-redefine [ word-prop ] with contains? ]
+                [ inline? ]
+                bi or
+            ] filter
+            [ (redefined) ] each
+        ] tri
+    ] if ;
+
+M: word redefined H{ } clone visited [ (redefined) ] with-variable ;
+
 : local-recursive-state ( -- assoc )
     recursive-state get dup keys
     [ dup word? [ inline? ] when not ] find drop

diff --git a/core/inference/inference-tests.factor b/core/inference/inference-tests.factor
index 0d3eb03cf43e510a5aac289dbba529562ae8c4ad..4ce354bdcc9a8d5c5d1f991be43e9771c3227d58 100755 (executable)
--- a/core/inference/inference-tests.factor
+++ b/core/inference/inference-tests.factor
@@ -549,10 +549,34 @@ ERROR: custom-error ;
 { 1 0 } [ [ ] map-children ] must-infer-as
 
 ! Corner case
-! [ [ [ f dup ] [ dup ] [ ] unfold ] infer ] must-fail
+[ [ [ f dup ] [ dup ] [ ] unfold ] infer ] must-fail
 
-! [ [ [ f dup ] [ ] [ ] while ] infer ] must-fail
+[ [ [ f dup ] [ ] [ ] while ] infer ] must-fail
 
-! : erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline
+: erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline
 
-! [ [ erg's-inference-bug ] infer ] must-fail
+[ [ erg's-inference-bug ] infer ] must-fail
+
+: inference-invalidation-a ;
+: inference-invalidation-b [ inference-invalidation-a ] dip call ; inline
+: inference-invalidation-c [ + ] inference-invalidation-b ;
+
+[ 7 ] [ 4 3 inference-invalidation-c ] unit-test
+
+{ 2 1 } [ inference-invalidation-c ] must-infer-as
+
+[ ] [ "IN: inference.tests : inference-invalidation-a 1 2 ;" eval ] unit-test
+
+[ 3 ] [ inference-invalidation-c ] unit-test
+
+{ 0 1 } [ inference-invalidation-c ] must-infer-as
+
+GENERIC: inference-invalidation-d ( obj -- )
+
+M: object inference-invalidation-d inference-invalidation-c 2drop ;
+
+\ inference-invalidation-d must-infer
+
+[ ] [ "IN: inference.tests : inference-invalidation-a ;" eval ] unit-test
+
+[ [ inference-invalidation-d ] infer ] must-fail

diff --git a/core/words/words.factor b/core/words/words.factor
index 5549f980106b91df23ee9918b93aac3bce5ee4f5..bc4b2ede72051f9629e6f30e9da13b3e22f0708c 100755 (executable)
--- a/core/words/words.factor
+++ b/core/words/words.factor
@@ -102,7 +102,7 @@ SYMBOL: compiled-crossref
 compiled-crossref global [ H{ } assoc-like ] change-at
 
 : compiled-xref ( word dependencies -- )
-    [ drop compiled-crossref? ] assoc-filter
+    [ drop crossref? ] assoc-filter
     2dup "compiled-uses" set-word-prop
     compiled-crossref get add-vertex* ;
 
@@ -125,28 +125,9 @@ SYMBOL: +called+
         compiled-usage [ nip +inlined+ eq? ] assoc-filter update
     ] with each keys ;
 
-<PRIVATE
+GENERIC: redefined ( word -- )
 
-SYMBOL: visited
-
-: reset-on-redefine { "inferred-effect" "no-effect" } ; inline
-
-: (redefined) ( word -- )
-    dup visited get key? [ drop ] [
-        [ reset-on-redefine reset-props ]
-        [ dup visited get set-at ]
-        [
-            crossref get at keys
-            [ word? ] filter
-            [ reset-on-redefine [ word-prop ] with contains? ] filter
-            [ (redefined) ] each
-        ] tri
-    ] if ;
-
-PRIVATE>
-
-: redefined ( word -- )
-    H{ } clone visited [ (redefined) ] with-variable ;
+M: object redefined drop ;
 
 : define ( word def -- )
     [ ] like

diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor
index a15a12830cb84eeae84594094c95b42e32a91e8f..25bd560d429b1b71c63816f3895b9d5c322b0f57 100755 (executable)
--- a/extra/editors/editors.factor
+++ b/extra/editors/editors.factor
@@ -53,7 +53,7 @@ M: object find-parse-error
 
 : fix ( word -- )
     [ "Fixing " write pprint " and all usages..." print nl ]
-    [ [ usage ] keep prefix ] bi
+    [ [ smart-usage ] keep prefix ] bi
     [
         [ "Editing " write . ]
         [

diff --git a/extra/tools/crossref/crossref.factor b/extra/tools/crossref/crossref.factor
index f4515a9ebeed2250c5c2c31ac409880f078cada3..3ff22cb0c659257f974f8a42d8752dc7be5cc1ca 100755 (executable)
--- a/extra/tools/crossref/crossref.factor
+++ b/extra/tools/crossref/crossref.factor
@@ -7,7 +7,7 @@ sorting hashtables vocabs parser source-files ;
 IN: tools.crossref
 
 : usage. ( word -- )
-    usage sorted-definitions. ;
+    smart-usage sorted-definitions. ;
 
 : words-matching ( str -- seq )
     all-words [ dup word-name ] { } map>assoc completions ;

diff --git a/extra/tools/profiler/profiler-docs.factor b/extra/tools/profiler/profiler-docs.factor
index 50bbc527d1d760f86aa1feb38a1a1fbab6621c52..69edf1a7e0f6cabd5afe21adef663048ff281870 100755 (executable)
--- a/extra/tools/profiler/profiler-docs.factor
+++ b/extra/tools/profiler/profiler-docs.factor
@@ -44,7 +44,7 @@ HELP: vocab-profile.
 HELP: usage-profile.
 { $values { "word" word } }
 { $description "Prints a table of call counts from the most recent invocation of " { $link profile } ", for words which directly call " { $snippet "word" } " only." }
-{ $notes "This word obtains the list of static usages with the " { $link usage } " word, and is not aware of dynamic call history. Consider the following scenario. A word " { $snippet "X" } " can execute word " { $snippet "Y" } " in a conditional branch, and " { $snippet "X" } " is executed many times during the profiling run, but this particular branch executing " { $snippet "Y" } " is never taken. However, some other word does execute " { $snippet "Y" } " multiple times. Then " { $snippet "\\ Y usage-profile." } " will list a number of calls to " { $snippet "X" } ", even though " { $snippet "Y" } " was never executed " { $emphasis "from" } " " { $snippet "X" } "." }
+{ $notes "This word obtains the list of static usages with the " { $link smart-usage } " word, and is not aware of dynamic call history. Consider the following scenario. A word " { $snippet "X" } " can execute word " { $snippet "Y" } " in a conditional branch, and " { $snippet "X" } " is executed many times during the profiling run, but this particular branch executing " { $snippet "Y" } " is never taken. However, some other word does execute " { $snippet "Y" } " multiple times. Then " { $snippet "\\ Y usage-profile." } " will list a number of calls to " { $snippet "X" } ", even though " { $snippet "Y" } " was never executed " { $emphasis "from" } " " { $snippet "X" } "." }
 { $examples { $code "\\ + usage-profile." } } ;
 
 HELP: vocabs-profile.

diff --git a/extra/tools/profiler/profiler.factor b/extra/tools/profiler/profiler.factor
index 6a5fce6281e955ef0460a8342962a412a5d39b9e..4ae3666829429dfb7b0810f46e915297286f3d49 100755 (executable)
--- a/extra/tools/profiler/profiler.factor
+++ b/extra/tools/profiler/profiler.factor
@@ -58,7 +58,7 @@ M: method-body (profile.)
     "Call counts for words which call " write
     dup pprint
     ":" print
-    usage [ word? ] filter counters counters. ;
+    smart-usage [ word? ] filter counters counters. ;
 
 : vocabs-profile. ( -- )
     "Call counts for all vocabularies:" print

diff --git a/extra/ui/tools/search/search.factor b/extra/ui/tools/search/search.factor
index b18c0c1ad689af4cdace8cbf6a1dbad25817e579..695727e3145d7c04725aff2f375f1af8c04952f8 100755 (executable)
--- a/extra/ui/tools/search/search.factor
+++ b/extra/ui/tools/search/search.factor
@@ -94,7 +94,7 @@ M: live-search pref-dim* drop { 400 200 } ;
     "Words in " rot vocab-name append show-titled-popup ;
 
 : show-word-usage ( workspace word -- )
-    "" over usage f <definition-search>
+    "" over smart-usage f <definition-search>
     "Words and methods using " rot word-name append
     show-titled-popup ;