Redefining methods didn't always update callers if more than one method on the same generic was redefined in a compilation unit

db4
Slava Pestov 2009-03-06 23:33:30 -06:00
parent 44815fd981
commit 37bc52afa8
4 changed files with 38 additions and 27 deletions

View File

@ -1,24 +1,42 @@
USING: accessors compiler compiler.units tools.test math parser
kernel sequences sequences.private classes.mixin generic
definitions arrays words assocs eval ;
definitions arrays words assocs eval strings ;
IN: compiler.tests
GENERIC: method-redefine-test ( a -- b )
GENERIC: method-redefine-generic-1 ( a -- b )
M: integer method-redefine-test 3 + ;
M: integer method-redefine-generic-1 3 + ;
: method-redefine-test-1 ( -- b ) 3 method-redefine-test ;
: method-redefine-test-1 ( -- b ) 3 method-redefine-generic-1 ;
[ 6 ] [ method-redefine-test-1 ] unit-test
[ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-test 4 + ;" eval ] unit-test
[ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-generic-1 4 + ;" eval ] unit-test
[ 7 ] [ method-redefine-test-1 ] unit-test
[ ] [ [ fixnum \ method-redefine-test method forget ] with-compilation-unit ] unit-test
[ ] [ [ fixnum \ method-redefine-generic-1 method forget ] with-compilation-unit ] unit-test
[ 6 ] [ method-redefine-test-1 ] unit-test
GENERIC: method-redefine-generic-2 ( a -- b )
M: integer method-redefine-generic-2 3 + ;
: method-redefine-test-2 ( -- b ) 3 method-redefine-generic-2 ;
[ 6 ] [ method-redefine-test-2 ] unit-test
[ ] [ "IN: compiler.tests USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" eval ] unit-test
[ 7 ] [ method-redefine-test-2 ] unit-test
[ ] [
[
fixnum string [ \ method-redefine-generic-2 method forget ] bi@
] with-compilation-unit
] unit-test
! Test ripple-up behavior
: hey ( -- ) ;
: there ( -- ) hey ;

View File

@ -72,14 +72,12 @@ SYMBOL: outdated-tuples
SYMBOL: update-tuples-hook
SYMBOL: remake-generics-hook
: index>= ( obj1 obj2 seq -- ? )
[ index ] curry bi@ >= ;
: dependency>= ( how1 how2 -- ? )
[
{
called-dependency
flushed-dependency
inlined-dependency
} index
] bi@ >= ;
{ called-dependency flushed-dependency inlined-dependency }
index>= ;
: strongest-dependency ( how1 how2 -- how )
[ called-dependency or ] bi@ [ dependency>= ] most ;

View File

@ -9,13 +9,9 @@ SYMBOL: inlined-dependency
SYMBOL: flushed-dependency
SYMBOL: called-dependency
<PRIVATE
: set-in-unit ( value key assoc -- )
[ set-at ] [ no-compilation-unit ] if* ;
PRIVATE>
SYMBOL: changed-definitions
: changed-definition ( defspec -- )
@ -23,14 +19,8 @@ SYMBOL: changed-definitions
SYMBOL: changed-generics
: changed-generic ( class generic -- )
changed-generics get set-in-unit ;
SYMBOL: remake-generics
: remake-generic ( generic -- )
dup remake-generics get set-in-unit ;
SYMBOL: new-classes
: new-class ( word -- )
@ -52,11 +42,9 @@ M: object forget* drop ;
SYMBOL: forgotten-definitions
: forgotten-definition ( defspec -- )
dup forgotten-definitions get
[ no-compilation-unit ] unless*
set-at ;
dup forgotten-definitions get set-in-unit ;
: forget ( defspec -- ) dup forgotten-definition forget* ;
: forget ( defspec -- ) [ forgotten-definition ] [ forget* ] bi ;
: forget-all ( definitions -- ) [ forget ] each ;

View File

@ -71,6 +71,13 @@ TUPLE: check-method class generic ;
\ check-method boa throw
] unless ; inline
: changed-generic ( class generic -- )
changed-generics get
[ [ [ class-or ] when* ] change-at ] [ no-compilation-unit ] if* ;
: remake-generic ( generic -- )
dup remake-generics get set-in-unit ;
: with-methods ( class generic quot -- )
[ drop changed-generic ]
[ [ "methods" word-prop ] dip call ]