More efficient singleton predicates
parent
b76165facf
commit
50a86a8d93
|
@ -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 % ]
|
||||
|
|
|
@ -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 ;
|
Loading…
Reference in New Issue