core/classes/union/union.factor

   1 ! Copyright (C) 2004, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: words sequences kernel assocs combinators classes
   4 generic.standard namespaces arrays ;
   5 IN: classes.union
   6
   7 PREDICATE: class union-class
   8     "metaclass" word-prop union-class eq? ;
   9
  10 ! Union classes for dispatch on multiple classes.
  11 : union-predicate-quot ( members -- quot )
  12     0 (dispatch#) [
  13         [ [ drop t ] ] { } map>assoc
  14         object bootstrap-word [ drop f ] 2array add*
  15         single-combination
  16     ] with-variable ;
  17
  18 : define-union-predicate ( class -- )
  19     dup predicate-word
  20     over members union-predicate-quot
  21     define-predicate ;
  22
  23 : define-union-class ( class members -- )
  24     dupd f union-class define-class define-union-predicate ;
  25
  26 M: union-class reset-class
  27     { "metaclass" "members" } reset-props ;