Fix some compiled-usage issues

core/compiler/compiler.factor

@@ -13,33 +13,22 @@ compiled-crossref global [ H{ } assoc-like ] change-at
 
 : compiled-xref ( word dependencies -- )
     2dup "compiled-uses" set-word-prop
-    compiled-crossref get add-vertex ;
+    compiled-crossref get add-vertex* ;
 
 : compiled-unxref ( word -- )
     dup "compiled-uses" word-prop
-    compiled-crossref get remove-vertex ;
+    compiled-crossref get remove-vertex* ;
 
-: compiled-usage ( word -- seq )
+: compiled-usage ( word -- assoc )
-    compiled-crossref get at keys ;
+    compiled-crossref get at ;
-
-: sensitive? ( word -- ? )
-    dup "inline" word-prop
-    over "infer" word-prop
-    pick "specializer" word-prop
-    roll generic?
-    or or or ;
 
 : compiled-usages ( words -- seq )
-    compiled-crossref get [
+    [ [ dup ] H{ } map>assoc dup ] keep [
-        [
+        compiled-usage [ nip +inlined+ eq? ] assoc-subset update
-            over dup set
+    ] with each keys ;
-            over sensitive?
-            [ at namespace swap update ] [ 2drop ] if
-        ] curry each
-    ] H{ } make-assoc keys ;
 
 : ripple-up ( word -- )
-    compiled-usage [ queue-compile ] each ;
+    compiled-usage [ drop queue-compile ] assoc-each ;
 
 : save-effect ( word effect -- )
     over "compiled-uses" word-prop [
@@ -60,7 +49,6 @@ compiled-crossref global [ H{ } assoc-like ] change-at
     ] computing-dependencies ;
 
 : compile-failed ( word error -- )
-    ! dup inference-error? [ rethrow ] unless
     f pick compiled get set-at
     swap compiler-error ;
 

core/compiler/test/redefine.factor

@@ -92,7 +92,7 @@ DEFER: x-4
 
 [ t ] [ \ x-3 "compiled-uses" word-prop >boolean ] unit-test
 
-[ t ] [ \ x-3 "compiled-uses" word-prop [ interned? ] all? ] unit-test
+[ t ] [ \ x-3 "compiled-uses" word-prop [ drop interned? ] assoc-all? ] unit-test
 
 DEFER: g-test-1
 
@@ -190,3 +190,18 @@ DEFER: inline-then-not-inline-test-2
 [ f ] [ \ inline-then-not-inline-test-2 word-xt "a" get = ] unit-test
 
 [ 6 6 9 ] [ inline-then-not-inline-test-2 ] unit-test
+
+DEFER: generic-then-not-generic-test-1
+DEFER: generic-then-not-generic-test-2
+
+[ ] [ "IN: temporary GENERIC: generic-then-not-generic-test-1 ( a -- b )" eval ] unit-test
+
+[ ] [ "IN: temporary USE: math M: integer generic-then-not-generic-test-1 sq ;" eval ] unit-test
+
+[ ] [ "IN: temporary : generic-then-not-generic-test-2 3 generic-then-not-generic-test-1 ;" eval ] unit-test
+
+[ 9 ] [ generic-then-not-generic-test-2 ] unit-test
+
+[ ] [ "IN: temporary USE: math : generic-then-not-generic-test-1 1 + ;" eval ] unit-test
+
+[ 4 ] [ generic-then-not-generic-test-2 ] unit-test

core/graphs/graphs-tests.factor

@@ -16,3 +16,35 @@ H{
 [ { 2 3 4 5 } ] [
     2 [ "g" get at ] closure keys natural-sort 
 ] unit-test
+
+H{ } "g" set
+
+[ ] [
+    "mary"
+    H{ { "billy" "one" } { "joey" "two" } }
+    "g" get add-vertex*
+] unit-test
+
+[ H{ { "mary" "one" } } ] [
+    "billy" "g" get at
+] unit-test
+
+[ ] [
+    "liz"
+    H{ { "billy" "four" } { "fred" "three" } }
+    "g" get add-vertex*
+] unit-test
+
+[ H{ { "mary" "one" } { "liz" "four" } } ] [
+    "billy" "g" get at
+] unit-test
+
+[ ] [
+    "mary"
+    H{ { "billy" "one" } { "joey" "two" } }
+    "g" get remove-vertex*
+] unit-test
+
+[ H{ { "liz" "four" } } ] [
+    "billy" "g" get at
+] unit-test

core/graphs/graphs.factor

@@ -16,9 +16,25 @@ SYMBOL: graph
 : add-vertex ( vertex edges graph -- )
     [ [ dupd nest set-at ] with each ] if-graph ; inline
 
+: (add-vertex) ( key value vertex -- )
+    rot nest set-at ;
+
+: add-vertex* ( vertex edges graph -- )
+    [
+        swap [ (add-vertex) ] curry assoc-each
+    ] if-graph ; inline
+
 : remove-vertex ( vertex edges graph -- )
     [ [ graph get at delete-at ] with each ] if-graph ; inline
 
+: (remove-vertex) ( key value vertex -- )
+    rot graph get at delete-at drop ;
+
+: remove-vertex* ( vertex edges graph -- )
+    [
+        swap [ (remove-vertex) ] curry assoc-each
+    ] if-graph ; inline
+
 SYMBOL: previous
 
 : (closure) ( obj quot -- )

core/inference/backend/backend.factor

@@ -76,7 +76,8 @@ GENERIC: apply-object ( obj -- )
 
 M: object apply-object apply-literal ;
 
-M: wrapper apply-object wrapped dup depends-on apply-literal ;
+M: wrapper apply-object
+    wrapped dup +called+ depends-on apply-literal ;
 
 : terminate ( -- )
     terminated? on #terminate node, ;
@@ -372,6 +373,7 @@ TUPLE: effect-error word effect ;
 
 : custom-infer ( word -- )
     #! Customized inference behavior
+    dup +inlined+ depends-on
     "infer" word-prop call ;
 
 : cached-infer ( word -- )
@@ -449,10 +451,12 @@ M: #call-label collect-recursion*
     ] if ;
 
 M: word apply-object
-    dup depends-on [
+    [
+        dup +inlined+ depends-on
         dup inline-recursive-label
         [ declared-infer ] [ inline-word ] if
     ] [
+        dup +called+ depends-on
         dup recursive-label
         [ declared-infer ] [ apply-word ] if
     ] if-inline ;

core/inference/state/state-tests.factor

@@ -0,0 +1,25 @@
+IN: temporary
+USING: tools.test inference.state ;
+
+SYMBOL: a
+SYMBOL: b
+
+[ ] [ a +called+ depends-on ] unit-test
+
+[ H{ { a +called+ } } ] [
+    [ a +called+ depends-on ] computing-dependencies
+] unit-test
+
+[ H{ { a +called+ } { b +inlined+ } } ] [
+    [
+        a +called+ depends-on b +inlined+ depends-on
+    ] computing-dependencies
+] unit-test
+
+[ H{ { a +inlined+ } { b +inlined+ } } ] [
+    [
+        a +inlined+ depends-on
+        a +called+ depends-on
+        b +inlined+ depends-on
+    ] computing-dependencies
+] unit-test

core/inference/state/state.factor

@@ -31,11 +31,16 @@ SYMBOL: current-node
 ! Words that the current dataflow IR depends on
 SYMBOL: dependencies
 
-: depends-on ( word -- )
+SYMBOL: +inlined+
-    dup dependencies get dup [ set-at ] [ 3drop ] if ;
+SYMBOL: +called+
+
+: depends-on ( word how -- )
+    swap dependencies get dup [
+        2dup at +inlined+ eq? [ 3drop ] [ set-at ] if
+    ] [ 3drop ] if ;
 
 : computing-dependencies ( quot -- dependencies )
-    H{ } clone [ dependencies rot with-variable ] keep keys ;
+    H{ } clone [ dependencies rot with-variable ] keep ;
     inline
 
 ! Did the current control-flow path throw an error?

core/optimizer/backend/backend.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: arrays generic assocs inference inference.class
-inference.dataflow inference.backend io kernel math namespaces
+inference.dataflow inference.backend inference.state io kernel
-sequences vectors words quotations hashtables combinators
+math namespaces sequences vectors words quotations hashtables
-classes generic.math continuations optimizer.def-use
+combinators classes generic.math continuations optimizer.def-use
 optimizer.pattern-match generic.standard ;
 IN: optimizer.backend
 
@@ -173,8 +173,8 @@ M: node remember-method*
     2drop ;
 
 : remember-method ( method-spec node -- )
-    swap dup
+    swap dup second +inlined+ depends-on
-    [ [ swap remember-method* ] curry each-node ] [ 2drop ] if ;
+    [ swap remember-method* ] curry each-node ;
 
 : (splice-method) ( #call method-spec quot -- node )
     #! Must remember the method before splicing in, otherwise
@@ -184,7 +184,10 @@ M: node remember-method*
     [ swap infer-classes/node ] 2keep
     [ substitute-node ] keep ;
 
-: splice-quot ( #call quot -- node ) f swap (splice-method) ;
+: splice-quot ( #call quot -- node )
+    over node-in-d dataflow-with
+    [ swap infer-classes/node ] 2keep
+    [ substitute-node ] keep ;
 
 : drop-inputs ( node -- #shuffle )
     node-in-d clone \ #shuffle in-node ;
@@ -358,7 +361,8 @@ M: #dispatch optimize-node*
     ] if ;
 
 : optimistic-inline ( #call -- node )
-    dup node-param word-def splice-quot ;
+    dup node-param dup +inlined+ depends-on
+    word-def splice-quot ;
 
 M: #call optimize-node*
     {