basis/checksums/xxhash/xxhash.factor

   1 ! Copyright (C) 2014 John Benediktsson.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: accessors alien.c-types alien.data byte-arrays
   5 checksums combinators endian generalizations grouping kernel
   6 math math.bitwise sequences ;
   7
   8 IN: checksums.xxhash
   9
  10 CONSTANT: prime1 2654435761
  11 CONSTANT: prime2 2246822519
  12 CONSTANT: prime3 3266489917
  13 CONSTANT: prime4 668265263
  14 CONSTANT: prime5 374761393
  15
  16 TUPLE: xxhash seed ;
  17
  18 C: <xxhash> xxhash
  19
  20 <PRIVATE
  21
  22 :: native-mapper ( from to bytes c-type -- seq )
  23     from to bytes <slice>
  24     bytes byte-array? alien.data:little-endian? and
  25     [ c-type cast-array ]
  26     [ c-type heap-size <groups> [ le> ] map ] if ; inline
  27
  28 PRIVATE>
  29
  30 M:: xxhash checksum-bytes ( bytes checksum -- value )
  31     checksum seed>> :> seed
  32     bytes length :> len
  33
  34     len dup 16 mod - :> len/16
  35     len dup 4 mod - :> len/4
  36
  37     len 16 >= [
  38
  39         seed prime1 w+ prime2 w+
  40         seed prime2 w+
  41         seed
  42         seed prime1 w-
  43
  44         0 len/16 bytes uint native-mapper
  45
  46         4 <groups> [
  47             first4
  48             [ prime2 w* w+ 13 bitroll-32 prime1 w* ]
  49             4 napply
  50         ] each
  51
  52         {
  53             [ 1 bitroll-32 ]
  54             [ 7 bitroll-32 ]
  55             [ 12 bitroll-32 ]
  56             [ 18 bitroll-32 ]
  57         } spread w+ w+ w+
  58     ] [
  59         seed prime5 w+
  60     ] if
  61
  62     len w+
  63
  64     len/16 len/4 bytes uint native-mapper
  65     [ prime3 w* w+ 17 bitroll-32 prime4 w* ] each
  66
  67     bytes len/4 tail-slice
  68     [ prime5 w* w+ 11 bitroll-32 prime1 w* ] each
  69
  70     [ -15 shift ] [ bitxor ] bi prime2 w*
  71     [ -13 shift ] [ bitxor ] bi prime3 w*
  72     [ -16 shift ] [ bitxor ] bi ;
  73
  74 INSTANCE: xxhash checksum