Sequence equality on slices and reversals

core/combinators/combinators.factor

@@ -59,6 +59,10 @@ ERROR: no-case ;
 M: sequence hashcode*
     [ sequence-hashcode ] recursive-hashcode ;
 
+M: reversed hashcode* [ sequence-hashcode ] recursive-hashcode ;
+
+M: slice hashcode* [ sequence-hashcode ] recursive-hashcode ;
+
 M: hashtable hashcode*
     [
         dup assoc-size 1 number=

core/sequences/sequences-tests.factor

@@ -1,6 +1,6 @@
 USING: arrays kernel math namespaces sequences kernel.private
 sequences.private strings sbufs tools.test vectors bit-arrays
-generic ;
+generic vocabs.loader ;
 IN: sequences.tests
 
 [ V{ 1 2 3 4 } ] [ 1 5 dup <slice> >vector ] unit-test
@@ -100,6 +100,16 @@ unit-test
 [ [ ] ] [ [ 1 2 3 ] 3 tail ] unit-test
 [ [ 3 ] ] [ [ 1 2 3 ] 2 tail ] unit-test
 
+[ "blah" ] [ "blahxx" 2 head* ] unit-test
+
+[ "xx" ] [ "blahxx" 2 tail* ] unit-test
+
+[ t ] [ "xxfoo" 2 head-slice "xxbar" 2 head-slice = ] unit-test
+[ t ] [ "xxfoo" 2 head-slice "xxbar" 2 head-slice [ hashcode ] bi@ = ] unit-test
+
+[ t ] [ "xxfoo" 2 head-slice SBUF" barxx" 2 tail-slice* = ] unit-test
+[ t ] [ "xxfoo" 2 head-slice SBUF" barxx" 2 tail-slice* [ hashcode ] bi@ = ] unit-test
+
 [ t ] [ [ 1 2 3 ] [ 1 2 3 ] sequence= ] unit-test
 [ t ] [ [ 1 2 3 ] { 1 2 3 } sequence= ] unit-test
 [ t ] [ { 1 2 3 } [ 1 2 3 ] sequence= ] unit-test
@@ -195,6 +205,12 @@ unit-test
 ! Pathological case
 [ "ihbye" ] [ "hi" <reversed> "bye" append ] unit-test
 
+[ t ] [ "hi" <reversed> SBUF" hi" <reversed> = ] unit-test
+
+[ t ] [ "hi" <reversed> SBUF" hi" <reversed> = ] unit-test
+
+[ t ] [ "hi" <reversed> SBUF" hi" <reversed> [ hashcode ] bi@ = ] unit-test
+
 [ -10 "hi" "bye" copy ] must-fail
 [ 10 "hi" "bye" copy ] must-fail
 
@@ -244,3 +260,5 @@ unit-test
 [ "asdf " ] [ " asdf " [ CHAR: \s = ] left-trim ] unit-test
 [ " asdf" ] [ " asdf " [ CHAR: \s = ] right-trim ] unit-test
 
+! Hardcore
+[ ] [ "sequences" reload ] unit-test

core/sequences/sequences.factor

@@ -172,7 +172,9 @@ TUPLE: reversed seq ;
 C: <reversed> reversed
 
 M: reversed virtual-seq reversed-seq ;
+
 M: reversed virtual@ reversed-seq [ length swap - 1- ] keep ;
+
 M: reversed length reversed-seq length ;
 
 INSTANCE: reversed virtual-sequence
@@ -198,7 +200,9 @@ ERROR: slice-error reason ;
     slice construct-boa ; inline
 
 M: slice virtual-seq slice-seq ;
+
 M: slice virtual@ [ slice-from + ] keep slice-seq ;
+
 M: slice length dup slice-to swap slice-from - ;
 
 : head-slice ( seq n -- slice ) (head) <slice> ;
@@ -466,6 +470,21 @@ M: sequence <=>
     2dup [ length ] bi@ number=
     [ mismatch not ] [ 2drop f ] if ; inline
 
+: sequence-hashcode-step ( oldhash newpart -- newhash )
+    swap [
+        dup -2 fixnum-shift-fast swap 5 fixnum-shift-fast
+        fixnum+fast fixnum+fast
+    ] keep fixnum-bitxor ; inline
+
+: sequence-hashcode ( n seq -- x )
+    0 -rot [
+        hashcode* >fixnum sequence-hashcode-step
+    ] with each ; inline
+
+M: reversed equal? over reversed? [ sequence= ] [ 2drop f ] if ;
+
+M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
+
 : move ( to from seq -- )
     2over number=
     [ 3drop ] [ [ nth swap ] keep set-nth ] if ; inline
@@ -692,14 +711,3 @@ PRIVATE>
         dup [ length ] map infimum
         [ <column> dup like ] with map
     ] unless ;
-
-: sequence-hashcode-step ( oldhash newpart -- newhash )
-    swap [
-        dup -2 fixnum-shift-fast swap 5 fixnum-shift-fast
-        fixnum+fast fixnum+fast
-    ] keep fixnum-bitxor ; inline
-
-: sequence-hashcode ( n seq -- x )
-    0 -rot [
-        hashcode* >fixnum sequence-hashcode-step
-    ] with each ; inline