More efficient singleton predicates

diff --git a/core/classes/predicate/predicate.factor b/core/classes/predicate/predicate.factor
index 188a2ed794b6e88b3f9455420d4fcec978b96c53..e544c7f8aba361cc10715b5bcf2808e335e01556 100644 (file)
--- a/core/classes/predicate/predicate.factor
+++ b/core/classes/predicate/predicate.factor
@@ -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 % ]

diff --git a/core/classes/singleton/singleton.factor b/core/classes/singleton/singleton.factor
index 1d370c1859d4f50983f6a50347939bb6ae8d3c7b..0db49cefa05c8eed35fccc35f6b2954ed7d7137b 100644 (file)
--- a/core/classes/singleton/singleton.factor
+++ b/core/classes/singleton/singleton.factor
@@ -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 ;
\ No newline at end of file