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 math sequences ;
   5
   6 IN: checksums.fletcher
   7
   8 SINGLETON: fletcher-16
   9 SINGLETON: fletcher-32
  10 SINGLETON: fletcher-64
  11
  12 INSTANCE: fletcher-16 checksum
  13 INSTANCE: fletcher-32 checksum
  14 INSTANCE: fletcher-64 checksum
  15
  16 :: fletcher ( seq k -- n )
  17     k 16 / :> chars
  18     k 2 / 2^ :> base
  19     base 1 - :> modulo
  20     0 0 seq chars <groups> [
  21         be> + modulo mod [ + modulo mod ] keep
  22     ] each [ base * ] [ + ] bi* ; inline
  23
  24 M: fletcher-16 checksum-bytes drop 16 fletcher ;
  25 M: fletcher-32 checksum-bytes drop 32 fletcher ;
  26 M: fletcher-64 checksum-bytes drop 64 fletcher ;