checksum-bytes ( bytes checksum -- value )
Factor handbook » Input and output » Checksums

Prev:	checksum
Next:	checksum-stream ( stream checksum -- value )

Vocabulary
checksums

Inputs

bytes	a sequence of bytes
checksum	a checksum specifier

Outputs

value

a byte-array

Generic word contract
Computes the checksum of all data in a sequence.

Examples

USING: checksums checksums.crc32 prettyprint ; B{ 1 10 100 } crc32 checksum-bytes .
B{ 78 179 254 238 }

Definition

IN: checksums

GENERIC: checksum-bytes ( bytes checksum -- value )

Methods

USING: checksums checksums.adler-32 kernel math math.vectors
ranges sequences ;

M: adler-32 checksum-bytes
    drop
    [ sum 1 + ]
    [ [ dup length [1..b] <reversed> vdot ] [ length ] bi + ] bi
    [ adler-32-modulus mod ] bi@ 16 shift bitor ;


USING: checksums checksums.common kernel ;

M: block-checksum checksum-bytes
    [ swap add-checksum-bytes get-checksum ] with-checksum-state
    ;


USING: checksums checksums.bsd kernel math sequences ;

M: bsd checksum-bytes
    drop 0 [
        [ [ -1 shift ] [ 1 bitand 15 shift ] bi + ] dip +
        65535 bitand
    ] reduce ;


USING: checksums io.encodings.binary io.streams.byte-array
kernel ;

M: checksum checksum-bytes
    [ binary <byte-reader> ] dip checksum-stream ;


USING: checksums checksums.crc16 sequences ;

M: crc16 checksum-bytes
    init-crc16 [ (crc16) ] each finish-crc16 ; inline


USING: checksums checksums.crc32 sequences ;

M: crc32 checksum-bytes
    init-crc32 [ (crc32) ] each finish-crc32 ; inline


USING: checksums checksums.fletcher kernel ;

M: fletcher-16 checksum-bytes drop 16 fletcher ;


USING: checksums checksums.fletcher kernel ;

M: fletcher-32 checksum-bytes drop 32 fletcher ;


USING: checksums checksums.fletcher kernel ;

M: fletcher-64 checksum-bytes drop 64 fletcher ;


USING: checksums checksums.fnv1 kernel math sequences ;

M: fnv1-1024 checksum-bytes
    drop fnv1-1024-basis swap
    [ swap fnv1-1024-prime * bitxor fnv1-1024-mod bitand ] each
    ;


USING: checksums checksums.fnv1 kernel math sequences ;

M: fnv1-128 checksum-bytes
    drop fnv1-128-basis swap
    [ swap fnv1-128-prime * bitxor fnv1-128-mod bitand ] each ;


USING: checksums checksums.fnv1 kernel math sequences ;

M: fnv1-256 checksum-bytes
    drop fnv1-256-basis swap
    [ swap fnv1-256-prime * bitxor fnv1-256-mod bitand ] each ;


USING: checksums checksums.fnv1 kernel math sequences ;

M: fnv1-32 checksum-bytes
    drop fnv1-32-basis swap
    [ swap fnv1-32-prime * bitxor fnv1-32-mod bitand ] each ;


USING: checksums checksums.fnv1 kernel math sequences ;

M: fnv1-512 checksum-bytes
    drop fnv1-512-basis swap
    [ swap fnv1-512-prime * bitxor fnv1-512-mod bitand ] each ;


USING: checksums checksums.fnv1 kernel math sequences ;

M: fnv1-64 checksum-bytes
    drop fnv1-64-basis swap
    [ swap fnv1-64-prime * bitxor fnv1-64-mod bitand ] each ;


USING: checksums checksums.fnv1 kernel math sequences ;

M: fnv1a-1024 checksum-bytes
    drop fnv1-1024-basis swap
    [ bitxor fnv1-1024-prime * fnv1-1024-mod bitand ] each ;


USING: checksums checksums.fnv1 kernel math sequences ;

M: fnv1a-128 checksum-bytes
    drop fnv1-128-basis swap
    [ bitxor fnv1-128-prime * fnv1-128-mod bitand ] each ;


USING: checksums checksums.fnv1 kernel math sequences ;

M: fnv1a-256 checksum-bytes
    drop fnv1-256-basis swap
    [ bitxor fnv1-256-prime * fnv1-256-mod bitand ] each ;


USING: checksums checksums.fnv1 kernel math sequences ;

M: fnv1a-32 checksum-bytes
    drop fnv1-32-basis swap
    [ bitxor fnv1-32-prime * fnv1-32-mod bitand ] each ;


USING: checksums checksums.fnv1 kernel math sequences ;

M: fnv1a-512 checksum-bytes
    drop fnv1-512-basis swap
    [ bitxor fnv1-512-prime * fnv1-512-mod bitand ] each ;


USING: checksums checksums.fnv1 kernel math sequences ;

M: fnv1a-64 checksum-bytes
    drop fnv1-64-basis swap
    [ bitxor fnv1-64-prime * fnv1-64-mod bitand ] each ;


USING: checksums checksums.internet endian grouping kernel math
sequences ;

M: internet checksum-bytes
    drop 2 <groups> [ le> ] map-sum
    [ -16 shift ] [ 65535 bitand ] bi + [ -16 shift ] keep +
    bitnot 2 >le ;


USING: accessors alien.c-types checksums checksums.khash
checksums.khash.private kernel math sequences ;

M:: khash64 checksum-bytes ( bytes checksum -- value )
    checksum seed>> :> seed bytes length :> len len 8 mod
    0 assert= seed 0 len bytes uint64_t native-mapper
    [ khash64-step ] each ;


USING: accessors alien.c-types checksums checksums.metrohash
checksums.metrohash.private combinators grouping kernel math
math.bitwise sequences ;

M:: metrohash-128 checksum-bytes ( bytes checksum -- value )
    3359281633 :> k0 2252921819 :> k1 2078195771 :> k2 794325157
    :> k3 checksum seed>> :> seed bytes length :> len len dup 32
    mod - :> len/32 len dup 16 mod - :> len/16 len dup 8 mod -
    :> len/8 len dup 4 mod - :> len/4 len dup 2 mod -
    :> len/2 seed k0 W- k3 W* :> v0! seed k1 W+ k2 W*
    :> v1! seed k0 W+ k2 W* :> v2! seed k1 W- k3 W*
    :> v3! len 32 >= [
        0 len/32 bytes uint64_t native-mapper 4 <groups> [
            first4 {
                [ k0 W* v0 W+ -29 bitroll-64 v2 W+ v0! ]
                [ k1 W* v1 W+ -29 bitroll-64 v3 W+ v1! ]
                [ k2 W* v2 W+ -29 bitroll-64 v0 W+ v2! ]
                [ k3 W* v3 W+ -29 bitroll-64 v1 W+ v3! ]
            } spread
        ] each v0 v3 W+ k0 W* v1 W+ -21 bitroll-64 k1 W*
        v2 bitxor v2! v1 v2 W+ k1 W* v0 W+ -21 bitroll-64 k0 W*
        v3 bitxor v3! v0 v2 W+ k0 W* v3 W+ -21 bitroll-64 k1 W*
        v0 bitxor v0! v1 v3 W+ k1 W* v2 W+ -21 bitroll-64 k0 W*
        v1 bitxor v1!
    ] when len/32 len/16 bytes uint64_t native-mapper [
        first2
        [ k2 W* v0 W+ -33 bitroll-64 k3 W* v0! ]
        [ k2 W* v1 W+ -33 bitroll-64 k3 W* v1! ] bi* v0 k2 W*
        v1 W+ -45 bitroll-64 k1 W* v0 bitxor v0! v1 k3 W* v0 W+
        -45 bitroll-64 k0 W* v1 bitxor v1!
    ] unless-empty len/16 len/8 bytes uint64_t native-mapper [
        first k2 W* v0 W+ -33 bitroll-64 k3 W* v0! v0 k2 W*
        v1 W+ -27 bitroll-64 k1 W* v0 bitxor v0!
    ] unless-empty len/8 len/4 bytes uint32_t native-mapper [
        first k2 W* v1 W+ -33 bitroll-64 k3 W* v1! v1 k3 W*
        v0 W+ -46 bitroll-64 k0 W* v1 bitxor v1!
    ] unless-empty len/4 len/2 bytes uint16_t native-mapper
    ~52 more~ ;


USING: accessors alien.c-types checksums checksums.metrohash
checksums.metrohash.private combinators grouping kernel math
math.bitwise sequences ;

M:: metrohash-64 checksum-bytes ( bytes checksum -- value )
    3603962101 :> k0 2729050939 :> k1 1654206401 :> k2 817650473
    :> k3 checksum seed>> :> seed bytes length :> len len dup 32
    mod - :> len/32 len dup 16 mod - :> len/16 len dup 8 mod -
    :> len/8 len dup 4 mod - :> len/4 len dup 2 mod -
    :> len/2 seed k2 W+ k0 W*
    :> h h h h h :> ( v0! v1! v2! v3! ) len 32 >= [
        0 len/32 bytes uint64_t native-mapper 4 <groups> [
            first4 {
                [ k0 W* v0 W+ -29 bitroll-64 v2 W+ v0! ]
                [ k1 W* v1 W+ -29 bitroll-64 v3 W+ v1! ]
                [ k2 W* v2 W+ -29 bitroll-64 v0 W+ v2! ]
                [ k3 W* v3 W+ -29 bitroll-64 v1 W+ v3! ]
            } spread
        ] each v0 v3 W+ k0 W* v1 W+ -37 bitroll-64 k1 W*
        v2 bitxor v2! v1 v2 W+ k1 W* v0 W+ -37 bitroll-64 k0 W*
        v3 bitxor v3! v0 v2 W+ k0 W* v3 W+ -37 bitroll-64 k1 W*
        v0 bitxor v0! v1 v3 W+ k1 W* v2 W+ -37 bitroll-64 k0 W*
        v1 bitxor v1! v0 v1 bitxor h W+ v0!
    ] when len/32 len/16 bytes uint64_t native-mapper [
        first2
        [ k2 W* v0 W+ -29 bitroll-64 k3 W* v1! ]
        [ k2 W* v0 W+ -29 bitroll-64 k3 W* v2! ] bi* v1 k0 W*
        -21 bitroll-64 v2 W+ v1 bitxor v1! v2 k3 W*
        -21 bitroll-64 v1 W+ v2 bitxor v2! v2 v0 W+ v0!
    ] unless-empty len/16 len/8 bytes uint64_t native-mapper [
        first k3 W* v0 W+ v0! v0 -55 bitroll-64 k1 W* v0 bitxor
        v0!
    ] unless-empty len/8 len/4 bytes uint32_t native-mapper [
        first k3 W* v0 W+ v0! v0 -26 bitroll-64 k1 W* v0 bitxor
        v0!
    ] unless-empty len/4 len/2 bytes uint16_t native-mapper [
        first k3 W* v0 W+ v0! v0 -48 bitroll-64 k1 W* v0 bitxor
        v0!
    ] unless-empty bytes len/2 tail-slice [
        first k3 W* v0 W+ v0! v0 -37 bitroll-64 k1 W* v0 bitxor
        v0!
    ] unless-empty v0 -28 bitroll-64 v0 bitxor v0! ~11 more~ ;


USING: accessors checksums checksums.murmur
checksums.murmur.private math.bitwise ;

M: murmur3-32 checksum-bytes
    seed>> 32 bits main-loop end-case avalanche ;


USING: checksums checksums.null kernel ;

M: null checksum-bytes drop ;


USING: accessors checksums checksums.superfast
checksums.superfast.private math.bitwise ;

M: superfast checksum-bytes
    seed>> 32 bits main-loop end-case avalanche ;


USING: accessors alien.c-types checksums checksums.wyhash
checksums.wyhash.private endian grouping kernel math sequences
sequences.generalizations sequences.private ;

M:: wyhash checksum-bytes ( bytes checksum -- value )
    checksum seed>> P0 bitxor
    :> seed! bytes length :> len len 16 <= [
        len 8 <= [
            len 4 >= [
                bytes [ 4 head-slice ] [ 4 tail-slice* ] bi
                [ le> ] bi@
            ] [
                len 0 > [
                    0 bytes nth 16 shift len 2/ bytes nth
                    8 shift bitor len 1 - bytes nth bitor 0
                ] [ 0 0 ] if
            ] if
        ] [
            bytes [ 8 head-slice ] [ 8 tail-slice* ] bi
            [ le> ] bi@
        ] if
    ] [
        len 1 - dup 48 mod - :> len/48 len 1 - dup 16 mod -
        :> len/16 0 len/48 bytes uint64_t native-mapper [
            seed :> see1! seed :> see2! 6 <groups> [
                6 firstn-unsafe :> ( n0 n1 n2 n3 n4 n5 ) n0 P1
                bitxor n1 seed bitxor wymix seed! n2 P2 bitxor
                n3 see1 bitxor wymix see1! n4 P3 bitxor
                n5 see2 bitxor wymix see2!
            ] each see1 see2 bitxor seed bitxor seed!
        ] unless-empty
        len/48 len/16 bytes uint64_t native-mapper [
            2 <groups> [
                first2-unsafe :> ( n0 n1 ) n0 P1 bitxor
                n1 seed bitxor wymix seed!
            ] each
        ] unless-empty len 16 - len bytes uint64_t native-mapper
        first2
    ] if :> ( a b ) len P1 bitxor a P1 bitxor b seed bitxor
    wymix wymix ;


USING: accessors alien.c-types checksums checksums.xxhash
checksums.xxhash.private combinators generalizations grouping
kernel math math.bitwise sequences ;

M:: xxhash checksum-bytes ( bytes checksum -- value )
    checksum seed>> :> seed bytes length :> len len dup 16 mod -
    :> len/16 len dup 4 mod - :> len/4 len 16 >= [
        seed prime1 w+ prime2 w+ seed prime2 w+
        seed seed prime1 w- 0 len/16 bytes uint native-mapper
        4 <groups> [
            first4
            [ prime2 w* w+ 13 bitroll-32 prime1 w* ] 4 napply
        ] each {
            [ 1 bitroll-32 ]
            [ 7 bitroll-32 ]
            [ 12 bitroll-32 ]
            [ 18 bitroll-32 ]
        } spread w+ w+ w+
    ] [ seed prime5 w+ ] if len w+
    len/16 len/4 bytes uint native-mapper
    [ prime3 w* w+ 17 bitroll-32 prime4 w* ] each
    bytes len/4 tail-slice
    [ prime5 w* w+ 11 bitroll-32 prime1 w* ] each
    [ -15 shift ] [ bitxor ] bi prime2 w*
    [ -13 shift ] [ bitxor ] bi prime3 w*
    [ -16 shift ] [ bitxor ] bi ;