diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index 139c6d8fdf..96c4009ba9 100755 --- a/core/combinators/combinators.factor +++ b/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= diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 3a30824084..281b27d540 100755 --- a/core/sequences/sequences-tests.factor +++ b/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 >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" "bye" append ] unit-test +[ t ] [ "hi" SBUF" hi" = ] unit-test + +[ t ] [ "hi" SBUF" hi" = ] unit-test + +[ t ] [ "hi" SBUF" hi" [ 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 diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 01a1cb9b6a..996aba8e6e 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -172,7 +172,9 @@ TUPLE: reversed seq ; C: 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) ; @@ -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 [ 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