core/classes/union/union.factor

   1 ! Copyright (C) 2004, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: words sequences kernel assocs combinators classes
   4 namespaces arrays math quotations ;
   5 IN: classes.union
   6
   7 PREDICATE: union-class < class
   8     "metaclass" word-prop union-class eq? ;
   9
  10 : union-predicate-quot ( members -- quot )
  11     dup empty? [
  12         drop [ drop f ]
  13     ] [
  14         unclip "predicate" word-prop swap [
  15             "predicate" word-prop [ dup ] prepend
  16             [ drop t ]
  17         ] { } map>assoc alist>quot
  18     ] if ;
  19
  20 : define-union-predicate ( class -- )
  21     dup members union-predicate-quot define-predicate ;
  22
  23 M: union-class update-class define-union-predicate ;
  24
  25 : define-union-class ( class members -- )
  26     [ f swap f union-class define-class ]
  27     [ drop update-classes ]
  28     2bi ;
  29
  30 M: union-class reset-class
  31     { "class" "metaclass" "members" } reset-props ;
  32
  33 M: union-class rank-class drop 2 ;