2009-07-17 18:41:33 -04:00
|
|
|
! Copyright (C) 2008, 2009 Doug Coleman, Slava Pestov.
|
2008-03-05 22:35:08 -05:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2009-11-10 18:41:47 -05:00
|
|
|
USING: classes classes.algebra classes.algebra.private
|
|
|
|
classes.predicate kernel sequences words ;
|
2008-04-01 17:51:48 -04:00
|
|
|
IN: classes.singleton
|
2008-03-05 22:35:08 -05:00
|
|
|
|
2009-07-17 18:41:33 -04:00
|
|
|
: singleton-predicate-quot ( class -- quot ) [ eq? ] curry ;
|
|
|
|
|
2008-04-02 16:41:29 -04:00
|
|
|
PREDICATE: singleton-class < predicate-class
|
2008-04-01 17:46:22 -04:00
|
|
|
[ "predicate-definition" word-prop ]
|
2009-07-17 18:41:33 -04:00
|
|
|
[ singleton-predicate-quot ]
|
|
|
|
bi sequence= ;
|
2008-04-01 17:46:22 -04:00
|
|
|
|
2008-04-02 16:41:29 -04:00
|
|
|
: define-singleton-class ( word -- )
|
2009-07-17 18:41:33 -04:00
|
|
|
\ word over singleton-predicate-quot define-predicate-class ;
|
2008-06-29 03:12:44 -04:00
|
|
|
|
|
|
|
M: singleton-class instance? eq? ;
|
2008-07-12 02:08:30 -04:00
|
|
|
|
|
|
|
M: singleton-class (classes-intersect?)
|
|
|
|
over singleton-class? [ eq? ] [ call-next-method ] if ;
|
2009-07-17 18:41:33 -04:00
|
|
|
|
|
|
|
M: singleton-class predicate-quot
|
|
|
|
singleton-predicate-quot ;
|