From 7134fad54cfe4365ac0ff9e23246cc712a524874 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 02:17:22 -0600 Subject: [PATCH 1/5] Add more unit tests highlighting the problem: predicate -vs- union comparison is broken --- core/classes/predicate/predicate-tests.factor | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/core/classes/predicate/predicate-tests.factor b/core/classes/predicate/predicate-tests.factor index 9f3b3e2141..3de073f774 100644 --- a/core/classes/predicate/predicate-tests.factor +++ b/core/classes/predicate/predicate-tests.factor @@ -1,9 +1,16 @@ -USING: math tools.test ; +USING: math tools.test classes.algebra ; IN: classes.predicate PREDICATE: negative < integer 0 < ; PREDICATE: positive < integer 0 > ; +[ t ] [ negative integer class< ] unit-test +[ t ] [ positive integer class< ] unit-test +[ f ] [ integer negative class< ] unit-test +[ f ] [ integer positive class< ] unit-test +[ f ] [ negative negative class< ] unit-test +[ f ] [ positive negative class< ] unit-test + GENERIC: abs ( n -- n ) M: integer abs ; M: negative abs -1 * ; From 9b492b55e0b4f5b944974f71c6bbdc8c2f668cfb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 02:17:37 -0600 Subject: [PATCH 2/5] Fix minor leak: class-caches were not reset if a class was forgotten --- core/classes/classes-tests.factor | 13 ++++++++++++- core/classes/classes.factor | 3 ++- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor index 1dee6a095c..dd12674cc4 100644 --- a/core/classes/classes-tests.factor +++ b/core/classes/classes-tests.factor @@ -3,7 +3,8 @@ kernel math namespaces parser prettyprint sequences strings tools.test vectors words quotations classes classes.private classes.union classes.mixin classes.predicate classes.algebra vectors definitions source-files -compiler.units kernel.private sorting vocabs ; +compiler.units kernel.private sorting vocabs memory eval +accessors ; IN: classes.tests [ t ] [ 3 object instance? ] unit-test @@ -27,3 +28,13 @@ M: method-forget-class method-forget-test ; implementors-map get keys [ natural-sort ] bi@ = ] unit-test + +! Minor leak +[ ] [ "IN: classes.tests TUPLE: forget-me ;" eval ] unit-test +[ ] [ f \ word set-global ] unit-test +[ ] [ "IN: classes.tests USE: kernel USE: classes.algebra forget-me tuple class<= drop" eval ] unit-test +[ ] [ "IN: classes.tests FORGET: forget-me" eval ] unit-test +[ 0 ] [ + [ word? ] instances + [ [ name>> "forget-me" = ] [ vocabulary>> "classes.tests" = ] bi and ] count +] unit-test diff --git a/core/classes/classes.factor b/core/classes/classes.factor index dcb69c9149..70fb869c5c 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -176,7 +176,8 @@ GENERIC: class-forgotten ( use class -- ) [ implementors-map- ] [ update-map- ] [ reset-class ] - } cleave ; + } cleave + reset-caches ; M: class class-forgotten nip forget-class ; From cc94894441c876a406212d6c5ad05d4d01637f1a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 03:38:44 -0600 Subject: [PATCH 3/5] Fix notorious classes-intersect? bug, or at least one manifestation thereof. Turns out that we may temporarily end up with forgotten classes in the compiled-generic-crossref table. This is not a problem, since subsequently the words that reference forgotten classes will presumably be redefined and recompiled, but it does mean that (compiled-generic-usage) does need to handle this case --- core/classes/classes-tests.factor | 51 ++++++++++++++++++++++++++++--- core/compiler/units/units.factor | 9 +++--- 2 files changed, 51 insertions(+), 9 deletions(-) diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor index dd12674cc4..c7900da316 100644 --- a/core/classes/classes-tests.factor +++ b/core/classes/classes-tests.factor @@ -1,10 +1,9 @@ USING: alien arrays definitions generic assocs hashtables io -kernel math namespaces parser prettyprint sequences strings -tools.test vectors words quotations classes +io.streams.string kernel math namespaces parser prettyprint +sequences strings tools.test vectors words quotations classes classes.private classes.union classes.mixin classes.predicate -classes.algebra vectors definitions source-files -compiler.units kernel.private sorting vocabs memory eval -accessors ; +classes.algebra vectors definitions source-files compiler.units +kernel.private sorting vocabs memory eval accessors ; IN: classes.tests [ t ] [ 3 object instance? ] unit-test @@ -38,3 +37,45 @@ M: method-forget-class method-forget-test ; [ word? ] instances [ [ name>> "forget-me" = ] [ vocabulary>> "classes.tests" = ] bi and ] count ] unit-test + +! Long-standing problem +USE: multiline + +! So the user has some code... +[ ] [ + <" IN: classes.test.a + GENERIC: g ( a -- b ) + TUPLE: x ; + M: x g ; + TUPLE: z < x ;"> + "class-intersect-no-method-a" parse-stream drop +] unit-test + +! Note that q inlines M: x g ; +[ ] [ + <" IN: classes.test.b + USE: classes.test.a + USE: kernel + : q ( -- b ) z new g ;"> + "class-intersect-no-method-b" parse-stream drop +] unit-test + +! Now, the user removes the z class and adds a method, +[ ] [ + <" IN: classes.test.a + GENERIC: g ( a -- b ) + TUPLE: x ; + M: x g ; + TUPLE: j ; + M: j g ;"> + "class-intersect-no-method-a" parse-stream drop +] unit-test + +! And changes the definition of q +[ ] [ + <" IN: classes.test.b + USE: classes.test.a + USE: kernel + : q ( -- b ) j new g ;"> + "class-intersect-no-method-b" parse-stream drop +] unit-test diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index 973d9b5c00..1b6b934dae 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -109,10 +109,11 @@ SYMBOL: remake-generics-hook compiled-generic-crossref get at ; : (compiled-generic-usages) ( generic class -- assoc ) - dup class? [ - [ compiled-generic-usage ] dip - [ classes-intersect? nip ] curry assoc-filter - ] [ 2drop f ] if ; + [ compiled-generic-usage ] dip + [ + 2dup [ class? ] both? + [ classes-intersect? ] [ 2drop f ] if nip + ] curry assoc-filter ; : compiled-generic-usages ( assoc -- assocs ) [ (compiled-generic-usages) ] { } assoc>map ; From fb64c1cb4560b2081da832b6528029b1465be8cf Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 04:59:54 -0600 Subject: [PATCH 4/5] Fix class<=; a predicate class derived from a union was not reported as being contained in the union --- core/classes/algebra/algebra.factor | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index b32bac3a18..51dad033a9 100644 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -55,7 +55,7 @@ DEFER: (class-or) class-or-cache get [ (class-or) ] 2cache ; : superclass<= ( first second -- ? ) - >r superclass r> class<= ; + swap superclass dup [ swap class<= ] [ 2drop f ] if ; : left-anonymous-union<= ( first second -- ? ) >r members>> r> [ class<= ] curry all? ; @@ -103,19 +103,20 @@ PREDICATE: empty-intersection < anonymous-intersection participants>> empty? ; : (class<=) ( first second -- -1/0/1 ) 2dup eq? [ 2drop t ] [ - [ normalize-class ] bi@ { - { [ dup empty-intersection? ] [ 2drop t ] } - { [ over empty-union? ] [ 2drop t ] } - { [ 2dup [ anonymous-complement? ] both? ] [ anonymous-complement<= ] } - { [ over anonymous-union? ] [ left-anonymous-union<= ] } - { [ over anonymous-intersection? ] [ left-anonymous-intersection<= ] } - { [ over nontrivial-anonymous-complement? ] [ left-anonymous-complement<= ] } - { [ dup anonymous-union? ] [ right-anonymous-union<= ] } - { [ dup anonymous-intersection? ] [ right-anonymous-intersection<= ] } - { [ dup anonymous-complement? ] [ class>> classes-intersect? not ] } - { [ over superclass ] [ superclass<= ] } - [ 2drop f ] - } cond + 2dup superclass<= [ 2drop t ] [ + [ normalize-class ] bi@ { + { [ dup empty-intersection? ] [ 2drop t ] } + { [ over empty-union? ] [ 2drop t ] } + { [ 2dup [ anonymous-complement? ] both? ] [ anonymous-complement<= ] } + { [ over anonymous-union? ] [ left-anonymous-union<= ] } + { [ over anonymous-intersection? ] [ left-anonymous-intersection<= ] } + { [ over nontrivial-anonymous-complement? ] [ left-anonymous-complement<= ] } + { [ dup anonymous-union? ] [ right-anonymous-union<= ] } + { [ dup anonymous-intersection? ] [ right-anonymous-intersection<= ] } + { [ dup anonymous-complement? ] [ class>> classes-intersect? not ] } + [ 2drop f ] + } cond + ] if ] if ; M: anonymous-union (classes-intersect?) From d8345b5eda090cc5abef7b94e4d4e9388a928764 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 06:07:19 -0600 Subject: [PATCH 5/5] Update PPC non-optimizing compiler backend: there are three new sub-primitives to support --- basis/cpu/ppc/bootstrap.factor | 43 +++++++++++++++++++++++++++++++++- 1 file changed, 42 insertions(+), 1 deletion(-) diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index 99bcfae92a..47c31111a9 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -3,7 +3,7 @@ USING: bootstrap.image.private kernel kernel.private namespaces system cpu.ppc.assembler compiler.codegen.fixup compiler.units compiler.constants math math.private layouts words words.private -vocabs slots.private ; +vocabs slots.private locals.backend ; IN: bootstrap.ppc 4 \ cell set @@ -305,4 +305,45 @@ big-endian on 3 ds-reg 0 STW ] f f f \ fixnum-bitnot define-sub-primitive +[ + 3 ds-reg 0 LWZ + 3 3 tag-bits get SRAWI + ds-reg ds-reg 4 SUBI + 4 ds-reg 0 LWZ + 5 4 3 SLW + 6 3 NEG + 7 4 6 SRAW + 7 7 0 0 31 tag-bits get - RLWINM + 0 3 0 CMPI + 2 BGT + 5 7 MR + 5 ds-reg 0 STW +] f f f \ fixnum-shift-fast define-sub-primitive + +[ + 3 ds-reg 0 LWZ + ds-reg ds-reg 4 SUBI + 4 ds-reg 0 LWZ + 5 4 3 DIVW + 6 5 3 MULLW + 7 6 4 SUBF + 7 ds-reg 0 STW +] f f f \ fixnum-mod define-sub-primitive + +[ + 3 ds-reg 0 LWZ + 3 3 1 SRAWI + 4 4 LI + 4 3 4 SUBF + rs-reg 3 4 LWZX + 3 ds-reg 0 STW +] f f f \ get-local define-sub-primitive + +[ + 3 ds-reg 0 LWZ + ds-reg ds-reg 4 SUBI + 3 3 1 SRAWI + rs-reg 3 rs-reg SUBF +] f f f \ drop-locals define-sub-primitive + [ "bootstrap.ppc" forget-vocab ] with-compilation-unit