basis/checksums/fletcher/fletcher.factor

   1 ! Copyright (C) 2013 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: checksums endian grouping kernel locals math sequences
   5 ;
   6
   7 IN: checksums.fletcher
   8
   9 SINGLETON: fletcher-16
  10 SINGLETON: fletcher-32
  11 SINGLETON: fletcher-64
  12
  13 INSTANCE: fletcher-16 checksum
  14 INSTANCE: fletcher-32 checksum
  15 INSTANCE: fletcher-64 checksum
  16
  17 :: fletcher ( seq k -- n )
  18     k 16 / :> chars
  19     k 2 / 2^ :> base
  20     base 1 - :> modulo
  21     0 0 seq chars <groups> [
  22         be> + modulo mod [ + modulo mod ] keep
  23     ] each [ base * ] [ + ] bi* ; inline
  24
  25 M: fletcher-16 checksum-bytes drop 16 fletcher ;
  26 M: fletcher-32 checksum-bytes drop 32 fletcher ;
  27 M: fletcher-64 checksum-bytes drop 64 fletcher ;