core/classes/singleton/singleton.factor

   1 ! Copyright (C) 2008, 2010 Doug Coleman, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: classes classes.algebra.private classes.predicate
   4 classes.predicate.private kernel sequences words ;
   5 IN: classes.singleton
   6
   7 <PRIVATE
   8
   9 : singleton-predicate-quot ( class -- quot ) [ eq? ] curry ;
  10
  11 PRIVATE>
  12
  13 PREDICATE: singleton-class < predicate-class
  14     [ "predicate-definition" word-prop ]
  15     [ singleton-predicate-quot ]
  16     bi sequence= ;
  17
  18 : define-singleton-class ( word -- )
  19     \ word over singleton-predicate-quot define-predicate-class ;
  20
  21 M: singleton-class instance? eq? ;
  22
  23 M: singleton-class (classes-intersect?)
  24     over singleton-class? [ eq? ] [ call-next-method ] if ;
  25
  26 M: singleton-class predicate-quot
  27     singleton-predicate-quot ;