Redefining methods didn't always update callers if more than one method on the same generic was redefined in a compilation unit
parent
44815fd981
commit
37bc52afa8
|
@ -1,24 +1,42 @@
|
||||||
USING: accessors compiler compiler.units tools.test math parser
|
USING: accessors compiler compiler.units tools.test math parser
|
||||||
kernel sequences sequences.private classes.mixin generic
|
kernel sequences sequences.private classes.mixin generic
|
||||||
definitions arrays words assocs eval ;
|
definitions arrays words assocs eval strings ;
|
||||||
IN: compiler.tests
|
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
|
[ 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
|
[ 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
|
[ 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
|
! Test ripple-up behavior
|
||||||
: hey ( -- ) ;
|
: hey ( -- ) ;
|
||||||
: there ( -- ) hey ;
|
: there ( -- ) hey ;
|
||||||
|
|
|
@ -72,14 +72,12 @@ SYMBOL: outdated-tuples
|
||||||
SYMBOL: update-tuples-hook
|
SYMBOL: update-tuples-hook
|
||||||
SYMBOL: remake-generics-hook
|
SYMBOL: remake-generics-hook
|
||||||
|
|
||||||
|
: index>= ( obj1 obj2 seq -- ? )
|
||||||
|
[ index ] curry bi@ >= ;
|
||||||
|
|
||||||
: dependency>= ( how1 how2 -- ? )
|
: dependency>= ( how1 how2 -- ? )
|
||||||
[
|
{ called-dependency flushed-dependency inlined-dependency }
|
||||||
{
|
index>= ;
|
||||||
called-dependency
|
|
||||||
flushed-dependency
|
|
||||||
inlined-dependency
|
|
||||||
} index
|
|
||||||
] bi@ >= ;
|
|
||||||
|
|
||||||
: strongest-dependency ( how1 how2 -- how )
|
: strongest-dependency ( how1 how2 -- how )
|
||||||
[ called-dependency or ] bi@ [ dependency>= ] most ;
|
[ called-dependency or ] bi@ [ dependency>= ] most ;
|
||||||
|
|
|
@ -9,13 +9,9 @@ SYMBOL: inlined-dependency
|
||||||
SYMBOL: flushed-dependency
|
SYMBOL: flushed-dependency
|
||||||
SYMBOL: called-dependency
|
SYMBOL: called-dependency
|
||||||
|
|
||||||
<PRIVATE
|
|
||||||
|
|
||||||
: set-in-unit ( value key assoc -- )
|
: set-in-unit ( value key assoc -- )
|
||||||
[ set-at ] [ no-compilation-unit ] if* ;
|
[ set-at ] [ no-compilation-unit ] if* ;
|
||||||
|
|
||||||
PRIVATE>
|
|
||||||
|
|
||||||
SYMBOL: changed-definitions
|
SYMBOL: changed-definitions
|
||||||
|
|
||||||
: changed-definition ( defspec -- )
|
: changed-definition ( defspec -- )
|
||||||
|
@ -23,14 +19,8 @@ SYMBOL: changed-definitions
|
||||||
|
|
||||||
SYMBOL: changed-generics
|
SYMBOL: changed-generics
|
||||||
|
|
||||||
: changed-generic ( class generic -- )
|
|
||||||
changed-generics get set-in-unit ;
|
|
||||||
|
|
||||||
SYMBOL: remake-generics
|
SYMBOL: remake-generics
|
||||||
|
|
||||||
: remake-generic ( generic -- )
|
|
||||||
dup remake-generics get set-in-unit ;
|
|
||||||
|
|
||||||
SYMBOL: new-classes
|
SYMBOL: new-classes
|
||||||
|
|
||||||
: new-class ( word -- )
|
: new-class ( word -- )
|
||||||
|
@ -52,11 +42,9 @@ M: object forget* drop ;
|
||||||
SYMBOL: forgotten-definitions
|
SYMBOL: forgotten-definitions
|
||||||
|
|
||||||
: forgotten-definition ( defspec -- )
|
: forgotten-definition ( defspec -- )
|
||||||
dup forgotten-definitions get
|
dup forgotten-definitions get set-in-unit ;
|
||||||
[ no-compilation-unit ] unless*
|
|
||||||
set-at ;
|
|
||||||
|
|
||||||
: forget ( defspec -- ) dup forgotten-definition forget* ;
|
: forget ( defspec -- ) [ forgotten-definition ] [ forget* ] bi ;
|
||||||
|
|
||||||
: forget-all ( definitions -- ) [ forget ] each ;
|
: forget-all ( definitions -- ) [ forget ] each ;
|
||||||
|
|
||||||
|
|
|
@ -71,6 +71,13 @@ TUPLE: check-method class generic ;
|
||||||
\ check-method boa throw
|
\ check-method boa throw
|
||||||
] unless ; inline
|
] 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 -- )
|
: with-methods ( class generic quot -- )
|
||||||
[ drop changed-generic ]
|
[ drop changed-generic ]
|
||||||
[ [ "methods" word-prop ] dip call ]
|
[ [ "methods" word-prop ] dip call ]
|
||||||
|
|
Loading…
Reference in New Issue