diff --git a/core/classes/predicate/predicate.factor b/core/classes/predicate/predicate.factor index 188a2ed794..e544c7f8ab 100644 --- 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 1d370c1859..0db49cefa0 100644 --- 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