]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/checksums/superfast/superfast.factor
factor: trim using lists
[factor.git] / basis / checksums / superfast / superfast.factor
index 97b3b8e433459d128e8a5642cd2f9d2a28046e96..d7f1c20153f99aaa15001914a5283e466e6a51a2 100644 (file)
@@ -1,10 +1,9 @@
 ! Copyright (C) 2013 John Benediktsson.
 ! See http://factorcode.org/license.txt for BSD license.
 
-USING: accessors alien alien.data byte-arrays checksums
-combinators fry grouping io.binary kernel math math.bitwise
-math.ranges sequences sequences.private ;
-QUALIFIED-WITH: alien.c-types c
+USING: accessors alien alien.c-types alien.data byte-arrays
+checksums endian grouping kernel math math.bitwise ranges
+sequences sequences.private ;
 
 IN: checksums.superfast
 
@@ -13,56 +12,46 @@ C: <superfast> superfast
 
 <PRIVATE
 
-: 32-bit ( n -- n' ) 32 on-bits mask ; inline
+: (main-loop) ( hash n -- hash' )
+    [ 16 bits ] [ -16 shift ] bi
+    [ + ] [ 11 shift dupd bitxor ] bi*
+    [ 16 shift ] [ bitxor ] bi* 32 bits
+    [ -11 shift ] [ + ] bi ; inline
 
 : main-loop ( seq hash -- seq hash' )
-    over byte-array? little-endian? and [
+    over byte-array? alien.data:little-endian? and [
         [ 0 over length 4 - 4 <range> ] dip
-        [
-            pick
-            [ <displaced-alien> c:short deref ]
-            [ [ 2 + ] dip <displaced-alien> c:short deref ] 2bi
-            [ + ] [ 11 shift dupd bitxor ] bi*
-            [ 16 shift ] [ bitxor ] bi* 32-bit
-            [ -11 shift ] [ + ] bi
-        ] reduce
+        [ pick <displaced-alien> int deref (main-loop) ] reduce
     ] [
-        [ dup length 4 mod dupd head-slice* 4 <groups> ] dip [
-            2 cut-slice
-            [ le> + ] [ le> 11 shift dupd bitxor ] bi*
-            [ 16 shift ] [ bitxor ] bi* 32-bit
-            [ -11 shift ] [ + ] bi
-        ] reduce
+        [ dup length 4 mod dupd head-slice* 4 <groups> ] dip
+        [ le> (main-loop) ] reduce
     ] if ; inline
 
 : end-case ( seq hash -- hash' )
     swap dup length 4 mod [ tail-slice* ] keep {
         [ drop ]
         [
-            first + [ 10 shift ] [ bitxor ] bi 32-bit
+            first + [ 10 shift ] [ bitxor ] bi 32 bits
             [ -1 shift ] [ + ] bi
         ]
         [
-            le> + [ 11 shift ] [ bitxor ] bi 32-bit
+            le> + [ 11 shift ] [ bitxor ] bi 32 bits
             [ -17 shift ] [ + ] bi
         ]
         [
             unclip-last-slice
             [ le> + [ 16 shift ] [ bitxor ] bi ]
-            [ 18 shift bitxor ] bi* 32-bit
+            [ 18 shift bitxor ] bi* 32 bits
             [ -11 shift ] [ + ] bi
         ]
     } dispatch ; inline
 
 : avalanche ( hash -- hash' )
-    [ 3 shift ] [ bitxor ] bi 32-bit
-    [ -5 shift ] [ + ] bi
-    [ 4 shift ] [ bitxor ] bi 32-bit
-    [ -17 shift ] [ + ] bi
-    [ 25 shift ] [ bitxor ] bi 32-bit
-    [ -6 shift ] [ + ] bi ; inline
+    [ 3 shift ] [ bitxor ] bi 32 bits [ -5 shift ] [ + ] bi
+    [ 4 shift ] [ bitxor ] bi 32 bits [ -17 shift ] [ + ] bi
+    [ 25 shift ] [ bitxor ] bi 32 bits [ -6 shift ] [ + ] bi ; inline
 
 PRIVATE>
 
 M: superfast checksum-bytes
-    seed>> 32-bit main-loop end-case avalanche ;
+    seed>> 32 bits main-loop end-case avalanche ;