1 ! Copyright (C) 2004, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: classes classes.algebra classes.algebra.private
4 classes.private kernel words ;
7 PREDICATE: predicate-class < class
8 "metaclass" word-prop predicate-class eq? ;
12 GENERIC: predicate-quot ( class -- quot )
14 M: predicate-class predicate-quot
15 [ superclass-of predicate-def ]
16 [ "predicate-definition" word-prop ] bi
17 '[ dup @ _ [ drop f ] if ] ;
21 : define-predicate-class ( class superclass definition -- )
22 [ drop f f predicate-class define-class ]
23 [ nip "predicate-definition" set-word-prop ]
26 [ dup predicate-quot define-predicate ]
31 M: predicate-class reset-class
32 [ call-next-method ] [ "predicate-definition" remove-word-prop ] bi ;
34 M: predicate-class rank-class drop 2 ;
36 M: predicate-class instance?
37 2dup superclass-of instance? [
38 "predicate-definition" word-prop call( object -- ? )
41 M: predicate-class (flatten-class)
42 superclass-of (flatten-class) ;
44 M: predicate-class (classes-intersect?)
45 superclass-of classes-intersect? ;