steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

O(1) equal? and hashcode* for ranges

db4
Slava Pestov 2009-01-28 23:33:26 -06:00
parent a45c91659a
commit 87e0110ff1
3 changed files with 28 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/math/ranges/ranges-tests.factor
View File

@ -1,4 +1,4 @@
USING: math.ranges sequences tools.test arrays ; USING: math math.ranges sequences sets tools.test arrays ;
IN: math.ranges.tests IN: math.ranges.tests
[ { } ] [ 1 1 (a,b) >array ] unit-test [ { } ] [ 1 1 (a,b) >array ] unit-test
@ -11,7 +11,7 @@ IN: math.ranges.tests
[ { 1 } ] [ 1 2 [a,b) >array ] unit-test [ { 1 } ] [ 1 2 [a,b) >array ] unit-test
[ { 1 2 } ] [ 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 [ { 1 } ] [ 2 1 (a,b] >array ] unit-test
[ { 2 } ] [ 2 1 [a,b) >array ] unit-test [ { 2 } ] [ 2 1 [a,b) >array ] unit-test
[ { 2 1 } ] [ 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 [ 0 ] [ -1 5 [0,b] clamp-to-range ] unit-test
[ 5 ] [ 6 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 [ { 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

10
basis/math/ranges/ranges.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel layouts math math.order namespaces sequences USING: kernel layouts math math.order namespaces sequences
sequences.private accessors ; sequences.private accessors classes.tuple arrays ;
IN: math.ranges IN: math.ranges
TUPLE: range TUPLE: range
@ -18,6 +18,12 @@ M: range length ( seq -- n )
M: range nth-unsafe ( n range -- obj ) M: range nth-unsafe ( n range -- obj )
[ step>> * ] keep from>> + ; [ 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 INSTANCE: range immutable-sequence
: twiddle ( a b -- a b step ) 2dup > -1 1 ? ; inline : twiddle ( a b -- a b step ) 2dup > -1 1 ? ; inline

24
core/classes/tuple/tuple.factor
View File

@ -79,16 +79,16 @@ M: tuple-class slots>tuple
ERROR: bad-superclass class ; ERROR: bad-superclass class ;
<PRIVATE
: tuple= ( tuple1 tuple2 -- ? ) : tuple= ( tuple1 tuple2 -- ? )
2dup [ layout-of ] bi@ eq? [ 2dup [ tuple? ] both? [
[ drop tuple-size ] 2dup [ layout-of ] bi@ eq? [
[ [ [ drop array-nth ] [ nip array-nth ] 3bi = ] 2curry ] [ drop tuple-size ]
2bi all-integers? [ [ [ drop array-nth ] [ nip array-nth ] 3bi = ] 2curry ]
] [ 2bi all-integers?
2drop f ] [ 2drop f ] if
] if ; inline ] [ 2drop f ] if ; inline
<PRIVATE
: tuple-predicate-quot/1 ( class -- quot ) : tuple-predicate-quot/1 ( class -- quot )
#! Fast path for tuples with no superclass #! 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 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 [ class hashcode ] [ tuple-size ] [ ] tri
[ rot ] dip [ [ rot ] dip [
@ -336,6 +338,8 @@ M: tuple hashcode*
] 2curry each ] 2curry each
] recursive-hashcode ; ] recursive-hashcode ;
M: tuple hashcode* tuple-hashcode ;
M: tuple-class new M: tuple-class new
dup "prototype" word-prop dup "prototype" word-prop
[ (clone) ] [ tuple-layout <tuple> ] ?if ; [ (clone) ] [ tuple-layout <tuple> ] ?if ;