use radix literals

[factor.git] / basis / checksums / md5 / md5.factor

diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor
index 026df340125fb31bafc6cfa2422c362a34ac5e25..6a0d553ec1a358747b27751cbc883c9dba0ae618 100644 (file)
--- a/basis/checksums/md5/md5.factor
+++ b/basis/checksums/md5/md5.factor
@@ -1,10 +1,13 @@
 ! Copyright (C) 2006, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-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 ;
+USING: alien.c-types alien.data 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 specialized-arrays literals hints ;
+FROM: sequences.private => change-nth-unsafe ;
+SPECIALIZED-ARRAY: uint
 IN: checksums.md5
 
 SINGLETON: md5
@@ -16,7 +19,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{ 0x67452301 0xefcdab89 0x98badcfe 0x10325476 }
         [ clone >>state ] [ >>old-state ] bi ;
 
 M: md5 initialize-checksum-state drop <md5-state> ;
@@ -27,10 +30,12 @@ M: md5 initialize-checksum-state drop <md5-state> ;
 
 : update-md5 ( md5 -- )
     [ state>> ] [ old-state>> v-w+ dup clone ] [ ] tri
-    [ (>>old-state) ] [ (>>state) ] bi ; inline
+    [ old-state<< ] [ state<< ] bi ;
 
-: 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 +75,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  ]
@@ -103,9 +108,9 @@ MACRO: with-md5-round ( ops quot -- )
         [ d a b c 13 S12 14 ]
         [ c d a b 14 S13 15 ]
         [ b c d a 15 S14 16 ]
-    } [ F ] with-md5-round ; inline
+    } [ F ] with-md5-round ;
 
-: (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 ]
@@ -123,9 +128,9 @@ MACRO: with-md5-round ( ops quot -- )
         [ d a b c 2  S22 30 ]
         [ c d a b 7  S23 31 ]
         [ b c d a 12 S24 32 ]
-    } [ G ] with-md5-round ; inline
+    } [ G ] with-md5-round ;
 
-: (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 ]
@@ -143,9 +148,9 @@ MACRO: with-md5-round ( ops quot -- )
         [ d a b c 12 S32 46 ]
         [ c d a b 15 S33 47 ]
         [ b c d a 2  S34 48 ]
-    } [ H ] with-md5-round ; inline
+    } [ H ] with-md5-round ;
 
-: (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 ]
@@ -163,11 +168,34 @@ MACRO: with-md5-round ( ops quot -- )
         [ d a b c 11 S42 62 ]
         [ c d a b 2  S43 63 ]
         [ b c d a 9  S44 64 ]
-    } [ I ] with-md5-round ; inline
+    } [ I ] with-md5-round ;
+
+HINTS: (process-md5-block-F) { uint-array md5-state } ;
+HINTS: (process-md5-block-G) { uint-array md5-state } ;
+HINTS: (process-md5-block-H) { uint-array md5-state } ;
+HINTS: (process-md5-block-I) { uint-array md5-state } ;
+
+: byte-array>le ( byte-array -- byte-array )
+    little-endian? [
+        dup 4 <sliced-groups> [
+            [ [ 1 2 ] dip exchange-unsafe ]
+            [ [ 0 3 ] dip exchange-unsafe ] bi
+        ] each
+    ] unless ;
+
+: uint-array-cast-le ( byte-array -- uint-array )
+    byte-array>le uint cast-array ;
+
+HINTS: uint-array-cast-le byte-array ;
+
+: uint-array>byte-array-le ( uint-array -- byte-array )
+    underlying>> byte-array>le ;
+
+HINTS: uint-array>byte-array-le uint-array ;
 
 M: md5-state checksum-block ( block state -- )
     [
-        [ 4 <groups> [ le> ] map ] [ state>> ] bi* {
+        [ uint-array-cast-le ] [ state>> ] bi* {
             [ (process-md5-block-F) ]
             [ (process-md5-block-G) ]
             [ (process-md5-block-H) ]
@@ -177,8 +205,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>> uint-array>byte-array-le ;
 
 M: md5-state clone ( md5 -- new-md5 )
     call-next-method