factor/core/classes/intersection/intersection.factor

! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: words sequences kernel assocs combinators classes
classes.algebra classes.builtin namespaces arrays math quotations ;
IN: classes.intersection

PREDICATE: intersection-class < class
    "metaclass" word-prop intersection-class eq? ;

: intersection-predicate-quot ( members -- quot )
    dup empty? [
        drop [ drop t ]
    ] [
        unclip "predicate" word-prop swap [
            "predicate" word-prop [ dup ] swap [ not ] 3append
            [ drop f ]
        ] { } map>assoc alist>quot
    ] if ;

: define-intersection-predicate ( class -- )
    dup participants intersection-predicate-quot define-predicate ;

M: intersection-class update-class define-intersection-predicate ;

: define-intersection-class ( class participants -- )
    [ f f rot intersection-class define-class ]
    [ drop update-classes ]
    2bi ;

M: intersection-class rank-class drop 2 ;

M: intersection-class instance?
    "participants" word-prop [ instance? ] with all? ;