Fix class<=; a predicate class derived from a union was not reported as being contained in the union

db4
Slava Pestov 2008-11-04 04:59:54 -06:00
parent cc94894441
commit fb64c1cb45
1 changed files with 15 additions and 14 deletions

View File

@ -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,6 +103,7 @@ PREDICATE: empty-intersection < anonymous-intersection participants>> empty? ;
: (class<=) ( first second -- -1/0/1 )
2dup eq? [ 2drop t ] [
2dup superclass<= [ 2drop t ] [
[ normalize-class ] bi@ {
{ [ dup empty-intersection? ] [ 2drop t ] }
{ [ over empty-union? ] [ 2drop t ] }
@ -113,9 +114,9 @@ PREDICATE: empty-intersection < anonymous-intersection participants>> empty? ;
{ [ 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
] if
] if ;
M: anonymous-union (classes-intersect?)