From c02704685721f3f35ef3a56afe59cba79622a273 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 29 Jan 2010 21:40:09 +1300
Subject: [PATCH] New 'conditional dependency' mechanism for more accurate
 recording of recompilation information

---
 basis/compiler/compiler.factor                | 15 +++---
 basis/compiler/crossref/crossref.factor       | 23 +++++++--
 basis/compiler/tests/redefine10.factor        |  2 -
 basis/compiler/tree/cleanup/cleanup.factor    | 25 +++++++---
 .../tree/dead-code/simple/simple.factor       |  8 ---
 .../known-words/known-words.factor            |  2 +-
 .../tree/propagation/simple/simple.factor     |  7 +--
 .../propagation/transforms/transforms.factor  |  2 +-
 .../dependencies/dependencies.factor          | 49 +++++++++++++++++--
 .../transforms/transforms.factor              |  2 +-
 basis/tools/deploy/shaker/shaker.factor       |  3 +-
 core/classes/classes.factor                   |  2 +
 core/classes/mixin/mixin.factor               | 13 +++--
 core/classes/tuple/tuple.factor               |  2 +-
 core/classes/union/union.factor               |  2 +-
 core/compiler/units/units.factor              |  3 ++
 core/definitions/definitions.factor           |  5 ++
 core/generic/generic.factor                   |  3 ++
 core/words/words.factor                       |  4 ++
 19 files changed, 122 insertions(+), 50 deletions(-)

diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor
index 7fc171859c..90197b207c 100644
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@@ -49,8 +49,7 @@ SYMBOL: compiled
 
 : start ( word -- )
     dup name>> compiler-message
-    H{ } clone dependencies set
-    H{ } clone generic-dependencies set
+    init-dependencies
     clear-compiler-error ;
 
 GENERIC: no-compile? ( word -- ? )
@@ -86,15 +85,15 @@ M: word combinator? inline? ;
     [ compiled-unxref ]
     [
         dup crossref? [
-            dependencies get
-            generic-dependencies get
-            compiled-xref
+            [ dependencies get generic-dependencies get compiled-xref ]
+            [ conditional-dependencies get save-conditional-dependencies ]
+            bi
         ] [ drop ] if
     ] tri ;
 
 : deoptimize-with ( word def -- * )
     #! If the word failed to infer, compile it with the
-    #! non-optimizing compiler. 
+    #! non-optimizing compiler.
     swap [ finish ] [ compiled get set-at ] bi return ;
 
 : not-compiled-def ( word error -- def )
@@ -203,7 +202,9 @@ M: optimizing-compiler recompile ( words -- alist )
     "--- compile done" compiler-message ;
 
 M: optimizing-compiler to-recompile ( -- words )
-    changed-definitions get compiled-usages assoc-combine keys ;
+    changed-definitions get compiled-usages
+    changed-classes get outdated-class-usages
+    append assoc-combine keys ;
 
 M: optimizing-compiler process-forgotten-words
     [ delete-compiled-xref ] each ;
diff --git a/basis/compiler/crossref/crossref.factor b/basis/compiler/crossref/crossref.factor
index bd6e25999a..b7a48a9d51 100644
--- a/basis/compiler/crossref/crossref.factor
+++ b/basis/compiler/crossref/crossref.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs classes.algebra compiler.units definitions graphs
-grouping kernel namespaces sequences words fry
+USING: arrays assocs classes.algebra compiler.units definitions
+graphs grouping kernel namespaces sequences words fry
 stack-checker.dependencies ;
 IN: compiler.crossref
 
@@ -25,10 +25,21 @@ compiled-generic-crossref [ H{ } clone ] initialize
     [ "flushable" word-prop inlined-dependency flushed-dependency ? ] bi
     '[ nip _ dependency>= ] assoc-filter ;
 
-: compiled-usages ( seq -- assocs )
+: compiled-usages ( assoc -- assocs )
     [ drop word? ] assoc-filter
     [ [ drop (compiled-usages) ] { } assoc>map ] keep suffix ;
 
+: dependencies-satisfied? ( word -- ? )
+    "conditional-dependencies" word-prop [ satisfied? ] all? ;
+
+: outdated-class-usages ( assoc -- assocs )
+    [
+        drop
+        compiled-usage
+        [ nip class-dependency dependency>= ] assoc-filter
+        [ drop dependencies-satisfied? not ] assoc-filter
+    ] { } assoc>map ;
+
 : compiled-generic-usage ( word -- assoc )
     compiled-generic-crossref get at ;
 
@@ -49,10 +60,14 @@ compiled-generic-crossref [ H{ } clone ] initialize
 : compiled-unxref ( word -- )
     [ "compiled-uses" compiled-crossref (compiled-unxref) ]
     [ "compiled-generic-uses" compiled-generic-crossref (compiled-unxref) ]
-    bi ;
+    [ f "conditional-dependencies" set-word-prop ]
+    tri ;
 
 : delete-compiled-xref ( word -- )
     [ compiled-unxref ]
     [ compiled-crossref get delete-at ]
     [ compiled-generic-crossref get delete-at ]
     tri ;
+
+: save-conditional-dependencies ( word deps -- )
+    >array f like "conditional-dependencies" set-word-prop ;
diff --git a/basis/compiler/tests/redefine10.factor b/basis/compiler/tests/redefine10.factor
index c23ce8cd8b..c9e1dc9af8 100644
--- a/basis/compiler/tests/redefine10.factor
+++ b/basis/compiler/tests/redefine10.factor
@@ -76,8 +76,6 @@ M: object fake-float? drop f ;
 
 [ f ] [ 1.0 my-fake-inline-3 ] unit-test
 
-[ f ] [ 1.0 my-baked-inline-3 ] unit-test
-
 [ f ] [ 1.0 my-inline-4 ] unit-test
 
 [ f ] [ 1.0 my-inline-5 ] unit-test
diff --git a/basis/compiler/tree/cleanup/cleanup.factor b/basis/compiler/tree/cleanup/cleanup.factor
index a2481a84e3..74353df483 100644
--- a/basis/compiler/tree/cleanup/cleanup.factor
+++ b/basis/compiler/tree/cleanup/cleanup.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors sequences combinators fry
 classes.algebra namespaces assocs words math math.private
@@ -51,9 +51,15 @@ GENERIC: cleanup* ( node -- node/nodes )
     [ in-d>> #drop ]
     bi prefix ;
 
+: record-predicate-folding ( #call -- )
+    [ node-input-infos first class>> ]
+    [ word>> "predicating" word-prop ]
+    [ node-output-infos first literal>> ] tri
+    [ depends-on-class<= ] [ depends-on-classes-disjoint ] if ;
+
 : record-folding ( #call -- )
     dup word>> predicate?
-    [ [ node-input-infos first class>> ] [ word>> ] bi depends-on-generic ]
+    [ record-predicate-folding ]
     [ word>> inlined-dependency depends-on ]
     if ;
 
@@ -63,15 +69,18 @@ GENERIC: cleanup* ( node -- node/nodes )
 ! Method inlining
 : add-method-dependency ( #call -- )
     dup method>> word? [
-        [ class>> ] [ word>> ] bi depends-on-generic
+        [ [ class>> ] [ word>> ] bi depends-on-generic ]
+        [ [ class>> ] [ word>> ] [ method>> ] tri depends-on-method ]
+        bi
     ] [ drop ] if ;
 
+: record-inlining ( #call -- )
+    dup method>>
+    [ add-method-dependency ]
+    [ word>> inlined-dependency depends-on ] if ;
+
 : cleanup-inlining ( #call -- nodes )
-    [
-        dup method>>
-        [ add-method-dependency ]
-        [ word>> inlined-dependency depends-on ] if
-    ] [ body>> cleanup ] bi ;
+    [ record-inlining ] [ body>> cleanup ] bi ;
 
 ! Removing overflow checks
 : (remove-overflow-check?) ( #call -- ? )
diff --git a/basis/compiler/tree/dead-code/simple/simple.factor b/basis/compiler/tree/dead-code/simple/simple.factor
index 77523568d7..0856920679 100644
--- a/basis/compiler/tree/dead-code/simple/simple.factor
+++ b/basis/compiler/tree/dead-code/simple/simple.factor
@@ -9,14 +9,6 @@ compiler.tree.propagation.info
 compiler.tree.dead-code.liveness ;
 IN: compiler.tree.dead-code.simple
 
-GENERIC: flushable? ( word -- ? )
-
-M: predicate flushable? drop t ;
-
-M: word flushable? "flushable" word-prop ;
-
-M: method-body flushable? "method-generic" word-prop flushable? ;
-
 : flushable-call? ( #call -- ? )
     dup word>> dup flushable? [
         "input-classes" word-prop dup [
diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index 6aacbc57da..2a84d41f3c 100644
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -318,7 +318,7 @@ generic-comparison-ops [
     dup literal>> class?
     [
         literal>>
-        [ inlined-dependency depends-on ]
+        [ class-dependency depends-on ]
         [ predicate-output-infos ]
         bi
     ] [ 2drop object-info ] if
diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor
index 225f10d342..8df6621dc2 100644
--- a/basis/compiler/tree/propagation/simple/simple.factor
+++ b/basis/compiler/tree/propagation/simple/simple.factor
@@ -36,7 +36,7 @@ M: #declare propagate-before
     #! classes mentioned in the declaration are redefined, since
     #! now we're making assumptions but their definitions.
     declaration>> [
-        [ inlined-dependency depends-on ]
+        [ class-dependency depends-on ]
         [ <class-info> swap refine-value-info ]
         bi
     ] assoc-each ;
@@ -110,8 +110,9 @@ M: #declare propagate-before
     #! is redefined, since now we're making assumptions but the
     #! class definition itself.
     [ in-d>> first value-info ]
-    [ "predicating" word-prop dup inlined-dependency depends-on ] bi*
-    predicate-output-infos 1array ;
+    [ "predicating" word-prop ] bi*
+    [ nip class-dependency depends-on ]
+    [ predicate-output-infos 1array ] 2bi ;
 
 : default-output-value-infos ( #call word -- infos )
     "default-output-classes" word-prop
diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor
index 63c0aea13e..f387b2b1df 100644
--- a/basis/compiler/tree/propagation/transforms/transforms.factor
+++ b/basis/compiler/tree/propagation/transforms/transforms.factor
@@ -163,7 +163,7 @@ ERROR: bad-partial-eval quot word ;
 
 : inline-new ( class -- quot/f )
     dup tuple-class? [
-        dup inlined-dependency depends-on
+        dup class-dependency depends-on
         [ all-slots [ initial>> literalize ] map ]
         [ tuple-layout '[ _ <tuple-boa> ] ]
         bi append >quotation
diff --git a/basis/stack-checker/dependencies/dependencies.factor b/basis/stack-checker/dependencies/dependencies.factor
index 74cc5f32d4..838a97a944 100644
--- a/basis/stack-checker/dependencies/dependencies.factor
+++ b/basis/stack-checker/dependencies/dependencies.factor
@@ -1,19 +1,19 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs classes.algebra fry kernel math namespaces
-sequences words ;
+USING: assocs accessors classes.algebra fry generic kernel math
+namespaces sequences words ;
 IN: stack-checker.dependencies
 
 ! Words that the current quotation depends on
 SYMBOL: dependencies
 
-SYMBOLS: inlined-dependency flushed-dependency called-dependency ;
+SYMBOLS: inlined-dependency class-dependency flushed-dependency called-dependency ;
 
 : index>= ( obj1 obj2 seq -- ? )
     [ index ] curry bi@ >= ;
 
 : dependency>= ( how1 how2 -- ? )
-    { called-dependency flushed-dependency inlined-dependency }
+    { called-dependency class-dependency flushed-dependency inlined-dependency }
     index>= ;
 
 : strongest-dependency ( how1 how2 -- how )
@@ -36,6 +36,45 @@ SYMBOL: generic-dependencies
     generic-dependencies get dup
     [ [ ?class-or ] change-at ] [ 3drop ] if ;
 
+! Conditional dependencies are re-evaluated when classes change;
+! if any fail, the word is recompiled
+SYMBOL: conditional-dependencies
+
+GENERIC: satisfied? ( dependency -- ? )
+
+: conditional-dependency ( ... class -- )
+    boa conditional-dependencies get
+    dup [ push ] [ 2drop ] if ; inline
+
+TUPLE: depends-on-class<= class1 class2 ;
+
+: depends-on-class<= ( class1 class2 -- )
+    \ depends-on-class<= conditional-dependency ;
+
+M: depends-on-class<= satisfied?
+    [ class1>> ] [ class2>> ] bi class<= ;
+
+TUPLE: depends-on-classes-disjoint class1 class2 ;
+
+: depends-on-classes-disjoint ( class1 class2 -- )
+    \ depends-on-classes-disjoint conditional-dependency ;
+
+M: depends-on-classes-disjoint satisfied?
+    [ class1>> ] [ class2>> ] bi classes-intersect? not ;
+
+TUPLE: depends-on-method class generic method ;
+
+: depends-on-method ( class generic method -- )
+    \ depends-on-method conditional-dependency ;
+
+M: depends-on-method satisfied?
+    [ [ class>> ] [ generic>> ] bi method-for-class ] [ method>> ] bi eq? ;
+
+: init-dependencies ( -- )
+    H{ } clone dependencies set
+    H{ } clone generic-dependencies set
+    V{ } clone conditional-dependencies set ;
+
 : without-dependencies ( quot -- )
     [
         dependencies off
diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor
index 853bf3911c..8610bbf66a 100644
--- a/basis/stack-checker/transforms/transforms.factor
+++ b/basis/stack-checker/transforms/transforms.factor
@@ -140,7 +140,7 @@ IN: stack-checker.transforms
 ! Constructors
 \ boa [
     dup tuple-class? [
-        dup inlined-dependency depends-on
+        dup class-dependency depends-on
         [ "boa-check" word-prop [ ] or ]
         [ tuple-layout '[ _ <tuple-boa> ] ]
         bi append
diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index e4e11a3135..c2db471a23 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2009 Slava Pestov.
+! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays accessors io.backend io.streams.c init fry
 namespaces math make assocs kernel parser parser.notes lexer
@@ -128,6 +128,7 @@ IN: tools.deploy.shaker
                 "combination"
                 "compiled-generic-uses"
                 "compiled-uses"
+                "conditional-dependencies"
                 "constant"
                 "constraints"
                 "custom-inlining"
diff --git a/core/classes/classes.factor b/core/classes/classes.factor
index e4301f6bae..34e65e54db 100644
--- a/core/classes/classes.factor
+++ b/core/classes/classes.factor
@@ -45,6 +45,8 @@ PREDICATE: class < word "class" word-prop ;
 
 PREDICATE: predicate < word "predicating" word-prop >boolean ;
 
+M: predicate flushable? drop t ;
+
 M: predicate forget*
     [ call-next-method ] [ f "predicating" set-word-prop ] bi ;
 
diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor
index 44e66dd79c..16e4ff124e 100644
--- a/core/classes/mixin/mixin.factor
+++ b/core/classes/mixin/mixin.factor
@@ -28,8 +28,9 @@ TUPLE: check-mixin-class class ;
 
 : redefine-mixin-class ( class members -- )
     [ (define-union-class) ]
+    [ drop changed-class ]
     [ drop t "mixin" set-word-prop ]
-    2bi ;
+    2tri ;
 
 : if-mixin-member? ( class mixin true false -- )
     [ check-mixin-class 2dup members member-eq? ] 2dip if ; inline
@@ -80,12 +81,10 @@ M: mixin-class class-forgotten remove-mixin-instance ;
     dup mixin-class? [
         drop
     ] [
-        {
-            [ { } redefine-mixin-class ]
-            [ H{ } clone "instances" set-word-prop ]
-            [ changed-definition ]
-            [ update-classes ]
-        } cleave
+        [ { } redefine-mixin-class ]
+        [ H{ } clone "instances" set-word-prop ]
+        [ update-classes ]
+        tri
     ] if ;
 
 ! Definition protocol implementation ensures that removing an
diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index d5ae145203..12d90e036b 100644
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -223,7 +223,7 @@ M: tuple-class update-class
         2drop
         [
             [ update-tuples-after ]
-            [ changed-definition ]
+            [ changed-class ]
             bi
         ] each-subclass
     ]
diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor
index 94013c32d9..44a1c22774 100644
--- a/core/classes/union/union.factor
+++ b/core/classes/union/union.factor
@@ -32,7 +32,7 @@ PRIVATE>
 
 : define-union-class ( class members -- )
     [ (define-union-class) ]
-    [ drop changed-definition ]
+    [ drop changed-class ]
     [ drop update-classes ]
     2tri ;
 
diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor
index b2926dfb4d..40cb235e8a 100644
--- a/core/compiler/units/units.factor
+++ b/core/compiler/units/units.factor
@@ -124,6 +124,7 @@ M: object bump-effect-counter* drop f ;
     dup new-definitions get first update
     dup new-definitions get second update
     dup changed-definitions get update
+    dup changed-classes get update
     dup dup changed-vocabs update ;
 
 : process-forgotten-definitions ( -- )
@@ -164,6 +165,7 @@ PRIVATE>
 : with-nested-compilation-unit ( quot -- )
     [
         H{ } clone changed-definitions set
+        H{ } clone changed-classes set
         H{ } clone changed-effects set
         H{ } clone outdated-generics set
         H{ } clone outdated-tuples set
@@ -174,6 +176,7 @@ PRIVATE>
 : with-compilation-unit ( quot -- )
     [
         H{ } clone changed-definitions set
+        H{ } clone changed-classes set
         H{ } clone changed-effects set
         H{ } clone outdated-generics set
         H{ } clone forgotten-definitions set
diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor
index 71d6797abd..7110e27e04 100644
--- a/core/definitions/definitions.factor
+++ b/core/definitions/definitions.factor
@@ -15,6 +15,11 @@ SYMBOL: changed-definitions
 : changed-definition ( defspec -- )
     dup changed-definitions get set-in-unit ;
 
+SYMBOL: changed-classes
+
+: changed-class ( class -- )
+    dup changed-classes get set-in-unit ;
+
 SYMBOL: changed-effects
 
 SYMBOL: outdated-generics
diff --git a/core/generic/generic.factor b/core/generic/generic.factor
index 517ccd4775..62ff40acfc 100644
--- a/core/generic/generic.factor
+++ b/core/generic/generic.factor
@@ -104,6 +104,9 @@ GENERIC: update-generic ( class generic -- )
 PREDICATE: method-body < word
     "method-generic" word-prop >boolean ;
 
+M: method-body flushable?
+    "method-generic" word-prop flushable? ;
+
 M: method-body stack-effect
     "method-generic" word-prop stack-effect ;
 
diff --git a/core/words/words.factor b/core/words/words.factor
index cd1b4f4455..106cca29fa 100644
--- a/core/words/words.factor
+++ b/core/words/words.factor
@@ -182,6 +182,10 @@ M: parsing-word definer drop \ SYNTAX: \ ; ;
 : deprecated? ( obj -- ? )
     dup word? [ "deprecated" word-prop ] [ drop f ] if ;
 
+GENERIC: flushable? ( word -- ? )
+
+M: word flushable? "flushable" word-prop ;
+
 ! Definition protocol
 M: word where "loc" word-prop ;