Re-defining a tuple class now invalidates cached quotation stack effects
parent
c027046857
commit
26f311279c
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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? ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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? [
|
||||
|
|
Loading…
Reference in New Issue