(class<=) ( first second -- ? )

Vocabulary

classes.algebra.private

Inputs

first	an object
second	an object

Outputs

?

an object

Definition

USING: accessors classes classes.algebra combinators kernel ;

IN: classes.algebra.private

: (class<=) ( first second -- ? )
    2dup eq?
    [ 2drop t ] [
        [ normalize-class ] bi@ 2dup superclass<=
        [ 2drop t ] [
            {
                { [ 2dup eq? ] [ 2drop t ] }
                { [ dup empty-intersection? ] [ 2drop t ] }
                { [ over empty-union? ] [ 2drop t ] }
                {
                    [ 2dup ~quotation~ both? ]
                    [ anonymous-complement<= ]
                }
                {
                    [ over anonymous-union? ]
                    [ left-anonymous-union<= ]
                }
                {
                    [ over anonymous-predicate? ]
                    [ ~quotation~ dip class<= ]
                }
                {
                    [ over nontrivial-anonymous-intersection? ]
                    [ left-anonymous-intersection<= ]
                }
                {
                    [ over nontrivial-anonymous-complement? ]
                    [ left-anonymous-complement<= ]
                }
                { [ dup class-members ] [ right-union<= ] }
                {
                    [ dup anonymous-union? ]
                    [ right-anonymous-union<= ]
                }
                {
                    [ dup anonymous-intersection? ]
                    [ right-anonymous-intersection<= ]
                }
                {
                    [ dup anonymous-complement? ]
                    [ class>> classes-intersect? not ]
                }
                [ 2drop f ]
            } cond
        ] if
    ] if ;