checksums.superfast: implementation of SuperFastHash.

basis/checksums/superfast/authors.txt

@@ -0,0 +1 @@
+John Benediktsson

basis/checksums/superfast/summary.txt

@@ -0,0 +1 @@
+SuperFastHash checksum algorithm

basis/checksums/superfast/superfast-docs.factor

@@ -0,0 +1,12 @@
+USING: help.markup help.syntax ;
+IN: checksums.superfast
+
+HELP: superfast
+{ $class-description "SuperFastHash checksum algorithm." } ;
+
+ARTICLE: "checksums.superfast" "SuperFastHash checksum"
+"SuperFastHash is a hash, created by Paul Hsieh. For more information see: "
+{ $url "http://www.azillionmonkeys.com/qed/hash.html" }
+{ $subsections superfast } ;
+
+ABOUT: "checksums.superfast"

basis/checksums/superfast/superfast-tests.factor

@@ -0,0 +1,21 @@
+USING: checksums fry kernel math sequences tools.test ;
+IN: checksums.superfast
+
+{
+    {
+        0
+        4064760690
+        2484602674
+        1021960881
+        3514307704
+        762925594
+        95280079
+        516333699
+        1761749771
+        3841726064
+        2549850032
+    }
+} [
+    "1234567890" [ length 1 + ] keep 0 <superfast>
+    '[ _ swap head _ checksum-bytes ] { } map-integers
+] unit-test

basis/checksums/superfast/superfast.factor

@@ -0,0 +1,55 @@
+! Copyright (C) 2013 John Benediktsson.
+! See http://factorcode.org/license.txt for BSD license.
+
+USING: accessors checksums combinators fry grouping io.binary
+kernel math math.bitwise sequences sequences.private ;
+
+IN: checksums.superfast
+
+TUPLE: superfast seed ;
+C: <superfast> superfast
+
+<PRIVATE
+
+: 32-bit ( n -- n' ) 32 on-bits mask ; inline
+
+: main-loop ( seq seed -- hash )
+    [ 4 <groups> ] dip [
+        2 cut-slice
+        [ le> + ] [ le> 11 shift dupd bitxor ] bi*
+        [ 16 shift ] [ bitxor ] bi* 32-bit
+        [ -11 shift ] [ + ] bi
+    ] reduce ; inline
+
+: end-case ( hash seq -- hash' )
+    dup length {
+        [ drop ]
+        [
+            first + [ 10 shift ] [ bitxor ] bi 32-bit
+            [ -1 shift ] [ + ] bi
+        ]
+        [
+            le> + [ 11 shift ] [ bitxor ] bi 32-bit
+            [ -17 shift ] [ + ] bi
+        ]
+        [
+            unclip-last-slice
+            [ le> + [ 16 shift ] [ bitxor ] bi ]
+            [ 18 shift bitxor ] bi* 32-bit
+            [ -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
+
+PRIVATE>
+
+M: superfast checksum-bytes
+    [ dup length 4 mod cut* ] [ seed>> 32-bit ] bi*
+    '[ _ main-loop ] [ end-case ] bi* avalanche ;