From 50a86a8d939f4b51e5daff9135e9a394f10b7b75 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 17 Jul 2009 17:41:33 -0500 Subject: [PATCH] More efficient singleton predicates --- core/classes/predicate/predicate.factor | 4 +++- core/classes/singleton/singleton.factor | 12 +++++++++--- 2 files changed, 12 insertions(+), 4 deletions(-) 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