add nth-unsafe to sequences.private, making md5 faster

diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor
index 026df340125fb31bafc6cfa2422c362a34ac5e25..89ff5d46a264f3eb94b3e105a9d6f302655f9e1f 100644 (file)
--- a/basis/checksums/md5/md5.factor
+++ b/basis/checksums/md5/md5.factor
@@ -4,7 +4,8 @@ USING: kernel io io.binary io.files io.streams.byte-array math
 math.functions math.parser namespaces splitting grouping strings
 sequences byte-arrays locals sequences.private macros fry
 io.encodings.binary math.bitwise checksums accessors
-checksums.common checksums.stream combinators combinators.smart ;
+checksums.common checksums.stream combinators combinators.smart
+specialized-arrays.uint literals ;
 IN: checksums.md5
 
 SINGLETON: md5
@@ -16,7 +17,7 @@ TUPLE: md5-state < checksum-state state old-state ;
 : <md5-state> ( -- md5 )
     md5-state new-checksum-state
         64 >>block-size
-        { HEX: 67452301 HEX: efcdab89 HEX: 98badcfe HEX: 10325476 }
+        uint-array{ HEX: 67452301 HEX: efcdab89 HEX: 98badcfe HEX: 10325476 }
         [ clone >>state ] [ >>old-state ] bi ;
 
 M: md5 initialize-checksum-state drop <md5-state> ;
@@ -29,8 +30,10 @@ M: md5 initialize-checksum-state drop <md5-state> ;
     [ state>> ] [ old-state>> v-w+ dup clone ] [ ] tri
     [ (>>old-state) ] [ (>>state) ] bi ; inline
 
-: T ( N -- Y )
-    sin abs 32 2^ * >integer ; inline
+CONSTANT: T
+    $[
+        80 iota [ sin abs 32 2^ * >integer ] uint-array{ } map-as
+    ]
 
 :: F ( X Y Z -- FXYZ )
     #! F(X,Y,Z) = XY v not(X) Z
@@ -70,22 +73,22 @@ CONSTANT: b 1
 CONSTANT: c 2
 CONSTANT: d 3
 
-:: (ABCD) ( x V a b c d k s i quot -- )
+:: (ABCD) ( x state a b c d k s i quot -- )
     #! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
-    a V [
-        b V nth
-        c V nth
-        d V nth quot call w+
-        k x nth w+
-        i T w+
+    a state [
+        b state nth-unsafe
+        c state nth-unsafe
+        d state nth-unsafe quot call w+
+        k x nth-unsafe w+
+        i T nth-unsafe w+
         s bitroll-32
-        b V nth w+
-    ] change-nth ; inline
+        b state nth-unsafe w+ 32 bits
+    ] change-nth-unsafe ; inline
 
 MACRO: with-md5-round ( ops quot -- )
     '[ [ _ (ABCD) ] compose ] map '[ _ 2cleave ] ;
 
-: (process-md5-block-F) ( block v -- )
+: (process-md5-block-F) ( block state -- )
     {
         [ a b c d 0  S11 1  ]
         [ d a b c 1  S12 2  ]
@@ -105,7 +108,7 @@ MACRO: with-md5-round ( ops quot -- )
         [ b c d a 15 S14 16 ]
     } [ F ] with-md5-round ; inline
 
-: (process-md5-block-G) ( block v -- )
+: (process-md5-block-G) ( block state -- )
     {
         [ a b c d 1  S21 17 ]
         [ d a b c 6  S22 18 ]
@@ -125,7 +128,7 @@ MACRO: with-md5-round ( ops quot -- )
         [ b c d a 12 S24 32 ]
     } [ G ] with-md5-round ; inline
 
-: (process-md5-block-H) ( block v -- )
+: (process-md5-block-H) ( block state -- )
     {
         [ a b c d 5  S31 33 ]
         [ d a b c 8  S32 34 ]
@@ -145,7 +148,7 @@ MACRO: with-md5-round ( ops quot -- )
         [ b c d a 2  S34 48 ]
     } [ H ] with-md5-round ; inline
 
-: (process-md5-block-I) ( block v -- )
+: (process-md5-block-I) ( block state -- )
     {
         [ a b c d 0  S41 49 ]
         [ d a b c 7  S42 50 ]
@@ -167,7 +170,7 @@ MACRO: with-md5-round ( ops quot -- )
 
 M: md5-state checksum-block ( block state -- )
     [
-        [ 4 <groups> [ le> ] map ] [ state>> ] bi* {
+        [ byte-array>uint-array ] [ state>> ] bi* {
             [ (process-md5-block-F) ]
             [ (process-md5-block-G) ]
             [ (process-md5-block-H) ]
@@ -177,8 +180,7 @@ M: md5-state checksum-block ( block state -- )
         nip update-md5
     ] 2bi ;
 
-: md5>checksum ( md5 -- bytes )
-    state>> [ 4 >le ] map B{ } concat-as ;
+: md5>checksum ( md5 -- bytes ) state>> underlying>> ;
 
 M: md5-state clone ( md5 -- new-md5 )
     call-next-method

diff --git a/core/checksums/checksums.factor b/core/checksums/checksums.factor
index 9d40521fc8269d881a6b5d01b415b186b9ab1a84..0dd808c7227faf0d88c066b014ff58431b896f9b 100644 (file)
--- a/core/checksums/checksums.factor
+++ b/core/checksums/checksums.factor
@@ -1,17 +1,17 @@
 ! Copyright (c) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors io io.backend io.files kernel math math.parser
-sequences vectors quotations ;
+sequences byte-arrays byte-vectors quotations ;
 IN: checksums
 
 MIXIN: checksum
 
-TUPLE: checksum-state bytes-read block-size bytes ;
+TUPLE: checksum-state
+    { bytes-read integer } { block-size integer } { bytes byte-vector } ;
 
 : new-checksum-state ( class -- checksum-state )
     new
-        0 >>bytes-read
-        V{ } clone >>bytes ; inline
+        BV{ } clone >>bytes ; inline
 
 M: checksum-state clone
     call-next-method
@@ -27,11 +27,13 @@ GENERIC: get-checksum ( checksum -- value )
     over bytes>> [ push-all ] keep
     [ dup length pick block-size>> >= ]
     [
-        64 cut-slice [
+        64 cut-slice [ >byte-array ] dip [
             over [ checksum-block ]
             [ [ 64 + ] change-bytes-read drop ] bi
         ] dip
-    ] while >vector [ >>bytes ] [ length [ + ] curry change-bytes-read ] bi ;
+    ] while
+    >byte-vector
+    [ >>bytes ] [ length [ + ] curry change-bytes-read ] bi ;
 
 : add-checksum-stream ( checksum-state stream -- checksum-state )
     [

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 99dddb8aedf744a9943b7c0af6ed5c6749236e5f..9b0f4c1530a6b90eb10fa851cf3eab328a32a03d 100755 (executable)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -88,6 +88,9 @@ M: sequence set-nth bounds-check set-nth-unsafe ;
 M: sequence nth-unsafe nth ;
 M: sequence set-nth-unsafe set-nth ;
 
+: change-nth-unsafe ( i seq quot -- )
+    [ [ nth-unsafe ] dip call ] 3keep drop set-nth-unsafe ; inline
+
 ! The f object supports the sequence protocol trivially
 M: f length drop 0 ;
 M: f nth-unsafe nip ;