From 670439ce815707d98d27c4b5b8f4bcb76a3a12bb Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 22 Nov 2013 17:45:41 -0800
Subject: [PATCH] checksums.superfast: implementation of SuperFastHash.

---
 basis/checksums/superfast/authors.txt         |  1 +
 basis/checksums/superfast/summary.txt         |  1 +
 .../checksums/superfast/superfast-docs.factor | 12 ++++
 .../superfast/superfast-tests.factor          | 21 +++++++
 basis/checksums/superfast/superfast.factor    | 55 +++++++++++++++++++
 5 files changed, 90 insertions(+)
 create mode 100644 basis/checksums/superfast/authors.txt
 create mode 100644 basis/checksums/superfast/summary.txt
 create mode 100644 basis/checksums/superfast/superfast-docs.factor
 create mode 100644 basis/checksums/superfast/superfast-tests.factor
 create mode 100644 basis/checksums/superfast/superfast.factor

diff --git a/basis/checksums/superfast/authors.txt b/basis/checksums/superfast/authors.txt
new file mode 100644
index 0000000000..e091bb8164
--- /dev/null
+++ b/basis/checksums/superfast/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/basis/checksums/superfast/summary.txt b/basis/checksums/superfast/summary.txt
new file mode 100644
index 0000000000..fe5345add9
--- /dev/null
+++ b/basis/checksums/superfast/summary.txt
@@ -0,0 +1 @@
+SuperFastHash checksum algorithm
diff --git a/basis/checksums/superfast/superfast-docs.factor b/basis/checksums/superfast/superfast-docs.factor
new file mode 100644
index 0000000000..b20659cd66
--- /dev/null
+++ b/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"
diff --git a/basis/checksums/superfast/superfast-tests.factor b/basis/checksums/superfast/superfast-tests.factor
new file mode 100644
index 0000000000..1125a933b7
--- /dev/null
+++ b/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
diff --git a/basis/checksums/superfast/superfast.factor b/basis/checksums/superfast/superfast.factor
new file mode 100644
index 0000000000..836bc2beec
--- /dev/null
+++ b/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 ;