From 87e0110ff15b92169a2d985b5fd805342de7b339 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 28 Jan 2009 23:33:26 -0600
Subject: [PATCH] O(1) equal? and hashcode* for ranges
---
basis/math/ranges/ranges-tests.factor | 8 ++++++--
basis/math/ranges/ranges.factor | 10 ++++++++--
core/classes/tuple/tuple.factor | 24 ++++++++++++++----------
3 files changed, 28 insertions(+), 14 deletions(-)
diff --git a/basis/math/ranges/ranges-tests.factor b/basis/math/ranges/ranges-tests.factor
index 825c68d1b9..aedd2f7933 100644
--- a/basis/math/ranges/ranges-tests.factor
+++ b/basis/math/ranges/ranges-tests.factor
@@ -1,4 +1,4 @@
-USING: math.ranges sequences tools.test arrays ;
+USING: math math.ranges sequences sets tools.test arrays ;
IN: math.ranges.tests
[ { } ] [ 1 1 (a,b) >array ] unit-test
@@ -11,7 +11,7 @@ IN: math.ranges.tests
[ { 1 } ] [ 1 2 [a,b) >array ] unit-test
[ { 1 2 } ] [ 1 2 [a,b] >array ] unit-test
-[ { } ] [ 2 1 (a,b) >array ] unit-test
+[ { } ] [ 2 1 (a,b) >array ] unit-test
[ { 1 } ] [ 2 1 (a,b] >array ] unit-test
[ { 2 } ] [ 2 1 [a,b) >array ] unit-test
[ { 2 1 } ] [ 2 1 [a,b] >array ] unit-test
@@ -32,3 +32,7 @@ IN: math.ranges.tests
[ 0 ] [ -1 5 [0,b] clamp-to-range ] unit-test
[ 5 ] [ 6 5 [0,b] clamp-to-range ] unit-test
[ { 0 1 2 3 4 } ] [ 5 sequence-index-range >array ] unit-test
+
+[ 100 ] [
+ 1 100 [a,b] [ 2^ [1,b] ] map prune length
+] unit-test
\ No newline at end of file
diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor
index 1a28904705..068f599b6f 100644
--- a/basis/math/ranges/ranges.factor
+++ b/basis/math/ranges/ranges.factor
@@ -1,7 +1,7 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel layouts math math.order namespaces sequences
-sequences.private accessors ;
+sequences.private accessors classes.tuple arrays ;
IN: math.ranges
TUPLE: range
@@ -18,6 +18,12 @@ M: range length ( seq -- n )
M: range nth-unsafe ( n range -- obj )
[ step>> * ] keep from>> + ;
+! For ranges with many elements, the default element-wise methods
+! sequences define are unsuitable because they're O(n)
+M: range equal? over range? [ tuple= ] [ 2drop f ] if ;
+
+M: range hashcode* tuple-hashcode ;
+
INSTANCE: range immutable-sequence
: twiddle ( a b -- a b step ) 2dup > -1 1 ? ; inline
diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 3ee9b8e40b..4f40d838b7 100644
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -79,16 +79,16 @@ M: tuple-class slots>tuple
ERROR: bad-superclass class ;
-<PRIVATE
-
: tuple= ( tuple1 tuple2 -- ? )
- 2dup [ layout-of ] bi@ eq? [
- [ drop tuple-size ]
- [ [ [ drop array-nth ] [ nip array-nth ] 3bi = ] 2curry ]
- 2bi all-integers?
- ] [
- 2drop f
- ] if ; inline
+ 2dup [ tuple? ] both? [
+ 2dup [ layout-of ] bi@ eq? [
+ [ drop tuple-size ]
+ [ [ [ drop array-nth ] [ nip array-nth ] 3bi = ] 2curry ]
+ 2bi all-integers?
+ ] [ 2drop f ] if
+ ] [ 2drop f ] if ; inline
+
+<PRIVATE
: tuple-predicate-quot/1 ( class -- quot )
#! Fast path for tuples with no superclass
@@ -328,7 +328,9 @@ M: tuple clone (clone) ;
M: tuple equal? over tuple? [ tuple= ] [ 2drop f ] if ;
-M: tuple hashcode*
+GENERIC: tuple-hashcode ( n tuple -- x )
+
+M: tuple tuple-hashcode
[
[ class hashcode ] [ tuple-size ] [ ] tri
[ rot ] dip [
@@ -336,6 +338,8 @@ M: tuple hashcode*
] 2curry each
] recursive-hashcode ;
+M: tuple hashcode* tuple-hashcode ;
+
M: tuple-class new
dup "prototype" word-prop
[ (clone) ] [ tuple-layout <tuple> ] ?if ;