More efficient singleton predicates

db4
Slava Pestov 2009-07-17 17:41:33 -05:00
parent b76165facf
commit 50a86a8d93
2 changed files with 12 additions and 4 deletions

View File

@ -7,7 +7,9 @@ IN: classes.predicate
PREDICATE: predicate-class < class
"metaclass" word-prop predicate-class eq? ;
: predicate-quot ( class -- quot )
GENERIC: predicate-quot ( class -- quot )
M: predicate-class predicate-quot
[
\ dup ,
[ superclass "predicate" word-prop % ]

View File

@ -1,17 +1,23 @@
! Copyright (C) 2008 Doug Coleman.
! Copyright (C) 2008, 2009 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: classes classes.algebra classes.predicate kernel
sequences words ;
IN: classes.singleton
: singleton-predicate-quot ( class -- quot ) [ eq? ] curry ;
PREDICATE: singleton-class < predicate-class
[ "predicate-definition" word-prop ]
[ [ eq? ] curry ] bi sequence= ;
[ singleton-predicate-quot ]
bi sequence= ;
: define-singleton-class ( word -- )
\ word over [ eq? ] curry define-predicate-class ;
\ word over singleton-predicate-quot define-predicate-class ;
M: singleton-class instance? eq? ;
M: singleton-class (classes-intersect?)
over singleton-class? [ eq? ] [ call-next-method ] if ;
M: singleton-class predicate-quot
singleton-predicate-quot ;