1 ! Copyright (C) 2004, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: classes classes.algebra kernel namespaces make words
4 sequences quotations arrays kernel.private assocs combinators ;
7 PREDICATE: predicate-class < class
8 "metaclass" word-prop predicate-class eq? ;
10 DEFER: predicate-instance? ( object class -- ? )
12 : update-predicate-instance ( -- )
13 \ predicate-instance? bootstrap-word
14 classes [ predicate-class? ] filter [
17 [ superclass 1array [ declare ] curry ]
18 [ "predicate-definition" word-prop ]
22 ] { } map>assoc [ case ] curry
25 : predicate-quot ( class -- quot )
28 dup superclass "predicate" word-prop %
29 "predicate-definition" word-prop , [ drop f ] , \ if ,
32 : define-predicate-class ( class superclass definition -- )
33 [ drop f f predicate-class define-class ]
34 [ nip "predicate-definition" set-word-prop ]
37 [ dup predicate-quot define-predicate ]
42 update-predicate-instance ;
44 M: predicate-class reset-class
46 [ { "predicate-definition" } reset-props ]
49 M: predicate-class rank-class drop 1 ;
51 M: predicate-class instance?
52 2dup superclass instance?
53 [ predicate-instance? ] [ 2drop f ] if ;
55 M: predicate-class (flatten-class)
56 superclass (flatten-class) ;
58 M: predicate-class (classes-intersect?)
59 superclass classes-intersect? ;