db4
Slava Pestov 2008-03-19 23:58:47 -05:00
parent 37906ed524
commit 616f96dbb7
3 changed files with 10 additions and 6 deletions

View File

@ -22,6 +22,8 @@ H{ } "s" set
[ number ] [ number object class-and ] unit-test [ number ] [ number object class-and ] unit-test
[ number ] [ object number class-and ] unit-test [ number ] [ object number class-and ] unit-test
[ null ] [ slice reversed 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: first-one ;
TUPLE: second-one ; TUPLE: second-one ;

View File

@ -127,12 +127,14 @@ DEFER: (class<)
: (class-or) ( class class -- class ) : (class-or) ( class class -- class )
[ flatten-class ] 2apply class-or-fixup lookup-tuple-union ; [ 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 ) : (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 ) : tuple-class-and ( class1 class2 -- class )
dupd eq? [ drop null ] unless ; dupd eq? [ drop null ] unless ;

View File

@ -354,7 +354,7 @@ M: object infer-call
\ setenv { object fixnum } { } <effect> set-primitive-effect \ setenv { object fixnum } { } <effect> set-primitive-effect
\ (stat) { string } { object object object object } <effect> set-primitive-effect \ exists? { string } { object } <effect> set-primitive-effect
\ (directory) { string } { array } <effect> set-primitive-effect \ (directory) { string } { array } <effect> set-primitive-effect