factor/core/classes/union/union.factor

38 lines
1.1 KiB
Factor
Raw Normal View History

! Copyright (C) 2004, 2008 Slava Pestov.
2007-09-20 18:09:08 -04:00
! See http://factorcode.org/license.txt for BSD license.
USING: words sequences kernel assocs combinators classes
classes.algebra namespaces arrays math quotations ;
2007-09-20 18:09:08 -04:00
IN: classes.union
2008-03-26 19:23:19 -04:00
PREDICATE: union-class < class
2007-09-20 18:09:08 -04:00
"metaclass" word-prop union-class eq? ;
2008-04-02 03:44:10 -04:00
: union-predicate-quot ( members -- quot )
dup empty? [
drop [ drop f ]
] [
2008-04-02 03:44:10 -04:00
unclip "predicate" word-prop swap [
"predicate" word-prop [ dup ] prepend
[ drop t ]
] { } map>assoc alist>quot
] if ;
2007-09-20 18:09:08 -04:00
: define-union-predicate ( class -- )
dup members union-predicate-quot define-predicate ;
2007-09-20 18:09:08 -04:00
M: union-class update-class define-union-predicate ;
2008-01-31 01:49:18 -05:00
: (define-union-class) ( class members -- )
f swap f union-class define-class ;
2007-09-20 18:09:08 -04:00
: define-union-class ( class members -- )
[ (define-union-class) ] [ drop update-classes ] 2bi ;
2007-09-20 18:09:08 -04:00
2008-05-02 03:51:38 -04:00
M: union-class rank-class drop 2 ;
M: union-class instance?
"members" word-prop [ instance? ] with contains? ;
2008-07-05 18:08:01 -04:00
M: union-class (flatten-class)
members <anonymous-union> (flatten-class) ;