From 616f96dbb71bb2d524ecc61252b875e5ee50de37 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 19 Mar 2008 23:58:47 -0500 Subject: [PATCH] Fixes --- core/classes/classes-tests.factor | 2 ++ core/classes/classes.factor | 12 +++++++----- core/inference/known-words/known-words.factor | 2 +- 3 files changed, 10 insertions(+), 6 deletions(-) diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor index f97f088845..3322c3b043 100755 --- a/core/classes/classes-tests.factor +++ b/core/classes/classes-tests.factor @@ -22,6 +22,8 @@ H{ } "s" set [ number ] [ number object class-and ] unit-test [ number ] [ object number class-and ] unit-test [ null ] [ slice reversed class-and ] unit-test +[ null ] [ general-t \ f class-and ] unit-test +[ object ] [ general-t \ f class-or ] unit-test TUPLE: first-one ; TUPLE: second-one ; diff --git a/core/classes/classes.factor b/core/classes/classes.factor index ad2920e594..e47dbd20e5 100755 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -127,12 +127,14 @@ DEFER: (class<) : (class-or) ( class class -- class ) [ flatten-class ] 2apply class-or-fixup lookup-tuple-union ; -: class-and-fixup ( set set -- set ) - 2dup [ tuple swap key? ] either? - [ 2drop H{ { tuple tuple } } ] [ intersect ] if ; - : (class-and) ( class class -- class ) - [ flatten-class ] 2apply class-and-fixup lookup-tuple-union ; + 2dup [ tuple swap class< ] either? [ + [ flatten-builtin-class ] 2apply + intersect lookup-union + ] [ + [ flatten-class ] 2apply + intersect lookup-tuple-union + ] if ; : tuple-class-and ( class1 class2 -- class ) dupd eq? [ drop null ] unless ; diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor index 235c2924bb..08fb56ced7 100755 --- a/core/inference/known-words/known-words.factor +++ b/core/inference/known-words/known-words.factor @@ -354,7 +354,7 @@ M: object infer-call \ setenv { object fixnum } { } set-primitive-effect -\ (stat) { string } { object object object object } set-primitive-effect +\ exists? { string } { object } set-primitive-effect \ (directory) { string } { array } set-primitive-effect