[
drop
compiled-usage
- [ nip class-dependency dependency>= ] assoc-filter
+ [ nip conditional-dependency dependency>= ] assoc-filter
[ drop dependencies-satisfied? not ] assoc-filter
] { } assoc>map ;
[ ] [ "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
dup literal>> class?
[
literal>>
- [ class-dependency depends-on ]
+ [ conditional-dependency depends-on ]
[ predicate-output-infos ]
bi
] [ 2drop object-info ] if
#! 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 ;
#! 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 )
: 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
! 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 )
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<= ;
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 ;
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? ;
! 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
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 )
! 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
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? [