More efficient singleton predicates
parent
b76165facf
commit
50a86a8d93
|
@ -7,7 +7,9 @@ IN: classes.predicate
|
||||||
PREDICATE: predicate-class < class
|
PREDICATE: predicate-class < class
|
||||||
"metaclass" word-prop predicate-class eq? ;
|
"metaclass" word-prop predicate-class eq? ;
|
||||||
|
|
||||||
: predicate-quot ( class -- quot )
|
GENERIC: predicate-quot ( class -- quot )
|
||||||
|
|
||||||
|
M: predicate-class predicate-quot
|
||||||
[
|
[
|
||||||
\ dup ,
|
\ dup ,
|
||||||
[ superclass "predicate" word-prop % ]
|
[ 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.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: classes classes.algebra classes.predicate kernel
|
USING: classes classes.algebra classes.predicate kernel
|
||||||
sequences words ;
|
sequences words ;
|
||||||
IN: classes.singleton
|
IN: classes.singleton
|
||||||
|
|
||||||
|
: singleton-predicate-quot ( class -- quot ) [ eq? ] curry ;
|
||||||
|
|
||||||
PREDICATE: singleton-class < predicate-class
|
PREDICATE: singleton-class < predicate-class
|
||||||
[ "predicate-definition" word-prop ]
|
[ "predicate-definition" word-prop ]
|
||||||
[ [ eq? ] curry ] bi sequence= ;
|
[ singleton-predicate-quot ]
|
||||||
|
bi sequence= ;
|
||||||
|
|
||||||
: define-singleton-class ( word -- )
|
: 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 instance? eq? ;
|
||||||
|
|
||||||
M: singleton-class (classes-intersect?)
|
M: singleton-class (classes-intersect?)
|
||||||
over singleton-class? [ eq? ] [ call-next-method ] if ;
|
over singleton-class? [ eq? ] [ call-next-method ] if ;
|
||||||
|
|
||||||
|
M: singleton-class predicate-quot
|
||||||
|
singleton-predicate-quot ;
|
Loading…
Reference in New Issue