]> gitweb.factorcode.org Git - factor.git/commitdiff
Re-defining a tuple class now invalidates cached quotation stack effects
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Fri, 29 Jan 2010 08:53:14 +0000 (21:53 +1300)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Fri, 29 Jan 2010 20:28:59 +0000 (09:28 +1300)
basis/compiler/crossref/crossref.factor
basis/compiler/tree/propagation/call-effect/call-effect-tests.factor
basis/compiler/tree/propagation/known-words/known-words.factor
basis/compiler/tree/propagation/simple/simple.factor
basis/compiler/tree/propagation/transforms/transforms.factor
basis/stack-checker/dependencies/dependencies.factor
basis/stack-checker/transforms/transforms.factor
core/compiler/units/units.factor

index b7a48a9d511c28757e5b361d6887f5ffc4c25acb..72e2c07c34262b8192e1e937cf2216bd300e7ea3 100644 (file)
@@ -36,7 +36,7 @@ compiled-generic-crossref [ H{ } clone ] initialize
     [
         drop
         compiled-usage
-        [ nip class-dependency dependency>= ] assoc-filter
+        [ nip conditional-dependency dependency>= ] assoc-filter
         [ drop dependencies-satisfied? not ] assoc-filter
     ] { } assoc>map ;
 
index 4a543fb87a1e427bffbdff157faffea8e8831a28..4b524fd0d48c4a81b9e86edaf6ed262251d492be 100644 (file)
@@ -79,3 +79,16 @@ TUPLE: a-tuple x ;
 [ ] [ "IN: compiler.tree.propagation.call-effect.tests USE: math : call(-redefine-test ( a -- c ) 1 + ;" eval( -- ) ] unit-test
 
 [ 1 3 test-quotatation inline-cache-invalidation-test ] [ T{ wrong-values f (( a b -- c )) } = ] must-fail-with
+
+! See if redefining a tuple class bumps effect counter
+TUPLE: my-tuple a b c ;
+
+: my-quot ( -- quot ) [ my-tuple boa ] ;
+
+: my-word ( a b c q -- result ) call( a b c -- result ) ;
+
+[ T{ my-tuple f 1 2 3 } ] [ 1 2 3 my-quot my-word ] unit-test
+
+[ ] [ "IN: compiler.tree.propagation.call-effect.tests TUPLE: my-tuple a b ;" eval( -- ) ] unit-test
+
+[ 1 2 3 my-quot my-word ] [ wrong-values? ] must-fail-with
index 2a84d41f3c14f0395ed82b0a6f2d9c355569a8bf..252c5d892be6b8de72dc2448108d9b82f64b5a91 100644 (file)
@@ -318,7 +318,7 @@ generic-comparison-ops [
     dup literal>> class?
     [
         literal>>
-        [ class-dependency depends-on ]
+        [ conditional-dependency depends-on ]
         [ predicate-output-infos ]
         bi
     ] [ 2drop object-info ] if
index 8df6621dc20a0c1dd5e4347a041e1de52c0c9128..da973e785c62e04638c7f9a00a892d260a975eb8 100644 (file)
@@ -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>> [
-        [ class-dependency depends-on ]
+        [ conditional-dependency depends-on ]
         [ <class-info> swap refine-value-info ]
         bi
     ] assoc-each ;
@@ -111,7 +111,7 @@ M: #declare propagate-before
     #! class definition itself.
     [ in-d>> first value-info ]
     [ "predicating" word-prop ] bi*
-    [ nip class-dependency depends-on ]
+    [ nip conditional-dependency depends-on ]
     [ predicate-output-infos 1array ] 2bi ;
 
 : default-output-value-infos ( #call word -- infos )
index f387b2b1df33cbf92378893b680f5dc780603633..414c553290321f6d0b01596644d1894c59000caf 100644 (file)
@@ -163,7 +163,7 @@ ERROR: bad-partial-eval quot word ;
 
 : inline-new ( class -- quot/f )
     dup tuple-class? [
-        dup class-dependency depends-on
+        dup conditional-dependency depends-on
         [ all-slots [ initial>> literalize ] map ]
         [ tuple-layout '[ _ <tuple-boa> ] ]
         bi append >quotation
index 838a97a944b7f13858aca1873b44bbc60e591304..97c151ac9dd729821b98ab892e75afc25e198525 100644 (file)
@@ -7,13 +7,13 @@ IN: stack-checker.dependencies
 ! Words that the current quotation depends on
 SYMBOL: dependencies
 
-SYMBOLS: inlined-dependency class-dependency flushed-dependency called-dependency ;
+SYMBOLS: inlined-dependency conditional-dependency flushed-dependency called-dependency ;
 
 : index>= ( obj1 obj2 seq -- ? )
     [ index ] curry bi@ >= ;
 
 : dependency>= ( how1 how2 -- ? )
-    { called-dependency class-dependency flushed-dependency inlined-dependency }
+    { called-dependency conditional-dependency flushed-dependency inlined-dependency }
     index>= ;
 
 : strongest-dependency ( how1 how2 -- how )
@@ -42,14 +42,14 @@ SYMBOL: conditional-dependencies
 
 GENERIC: satisfied? ( dependency -- ? )
 
-: conditional-dependency ( ... class -- )
+: add-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 ;
+    \ depends-on-class<= add-conditional-dependency ;
 
 M: depends-on-class<= satisfied?
     [ class1>> ] [ class2>> ] bi class<= ;
@@ -57,7 +57,7 @@ M: depends-on-class<= satisfied?
 TUPLE: depends-on-classes-disjoint class1 class2 ;
 
 : depends-on-classes-disjoint ( class1 class2 -- )
-    \ depends-on-classes-disjoint conditional-dependency ;
+    \ depends-on-classes-disjoint add-conditional-dependency ;
 
 M: depends-on-classes-disjoint satisfied?
     [ class1>> ] [ class2>> ] bi classes-intersect? not ;
@@ -65,7 +65,7 @@ M: depends-on-classes-disjoint satisfied?
 TUPLE: depends-on-method class generic method ;
 
 : depends-on-method ( class generic method -- )
-    \ depends-on-method conditional-dependency ;
+    \ depends-on-method add-conditional-dependency ;
 
 M: depends-on-method satisfied?
     [ [ class>> ] [ generic>> ] bi method-for-class ] [ method>> ] bi eq? ;
index 8610bbf66acd5b85c5943b3a5ac1382ccf9d11d6..5426ac9e19729d41a1de457847d1c6f9e08e142d 100644 (file)
@@ -140,7 +140,7 @@ IN: stack-checker.transforms
 ! Constructors
 \ boa [
     dup tuple-class? [
-        dup class-dependency depends-on
+        dup conditional-dependency depends-on
         [ "boa-check" word-prop [ ] or ]
         [ tuple-layout '[ _ <tuple-boa> ] ]
         bi append
index 40cb235e8a6d285371825a6a61845c8cd2b62d5c..21ab578ccc19cc09b84916cbe08a30d851b850b8 100644 (file)
@@ -54,8 +54,7 @@ M: generic update-generic ( class generic -- )
     2bi ;
 
 M: sequence update-methods ( class seq -- )
-    [ [ predicate-word changed-call-sites ] with each ]
-    [ implementors [ update-generic ] with each ] 2bi ;
+    implementors [ update-generic ] with each ;
 
 HOOK: recompile compiler-impl ( words -- alist )
 
@@ -108,9 +107,9 @@ GENERIC: definitions-changed ( assoc obj -- )
 ! inline caching
 : effect-counter ( -- n ) 47 special-object ; inline
 
-GENERIC: bump-effect-counter* ( defspec -- ? )
+GENERIC: always-bump-effect-counter? ( defspec -- ? )
 
-M: object bump-effect-counter* drop f ;
+M: object always-bump-effect-counter? drop f ;
 
 <PRIVATE
 
@@ -134,9 +133,10 @@ M: object bump-effect-counter* drop f ;
     bi ;
 
 : bump-effect-counter? ( -- ? )
-    changed-effects get new-words get assoc-diff assoc-empty? not
-    changed-definitions get [ drop bump-effect-counter* ] assoc-any?
-    or ;
+    changed-effects get
+    changed-classes get
+    changed-definitions get [ drop always-bump-effect-counter? ] assoc-filter
+    3array assoc-combine new-words get assoc-diff assoc-empty? not ;
 
 : bump-effect-counter ( -- )
     bump-effect-counter? [