Re-defining a tuple class now invalidates cached quotation stack effects

release
Slava Pestov 2010-01-29 21:53:14 +13:00
parent c027046857
commit 26f311279c
8 changed files with 32 additions and 19 deletions

View 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 ;

View 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

View 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

View 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 )

View 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

View 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? ;

View 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

View 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? [