diff --git a/basis/compiler/tests/redefine1.factor b/basis/compiler/tests/redefine1.factor index b5835de5fd..0875967bd2 100644 --- a/basis/compiler/tests/redefine1.factor +++ b/basis/compiler/tests/redefine1.factor @@ -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 ; diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index 0577f8b83c..6fb7fc8ad5 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -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 ; diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor index 726116909f..db99d7e3a3 100644 --- a/core/definitions/definitions.factor +++ b/core/definitions/definitions.factor @@ -9,13 +9,9 @@ SYMBOL: inlined-dependency SYMBOL: flushed-dependency SYMBOL: called-dependency - - 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 ; diff --git a/core/generic/generic.factor b/core/generic/generic.factor index c520b4aaac..93c3e7f75c 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -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 ]