Parallel and Incremental CRCs

Back in the second part of my series on cellular automata, I implemented a Moore machine for computing a CRC-32. It was used to generate the CRC-32 for the end of a PNG block header.

At the time I was somewhat saddened by the fact that I was forced to turn to a left fold, because there didn't appear to be an algorithm for computing a CRC in parallel or incrementally, beyond simply working a few more bits at a time through a lookup table.

It finally occurred to me how we can implement a parallel/incremental CRC calculator today during the walk home from work, and I figured I should share it. This has a number of practical applications, as it permits us to regenerate CRCs in response to small edits in very large datasets in logarithmic time!

I've never seen this algorithm before applied to CRCs, so it is at least new to me.

This may also let me play some games with fast composable hashing for data structures in a later post.

CRC-32

Calculating a CRC is just an exercise in long division.

The particular number system we're working in is a bit peculiar.

But other than that, it really is just what you were taught in grade-school!

Probably the best explanation for how a CRC works comes from Ross William's rather unassuming and seemingly immortal 1996 "A Painless Guide to CRC Error Detection Algorithms", which goes through from soup to nuts how a CRC is defined from an operational perspective. It can be found on Filip G's site on repairfaq.org, which will provide you a fresh reminder of what the internet was like for us in the mid 90s.

The content, however, is excellent.

The View from the Left

Recall my definition of CRC-32 from last time along with enough of an implementation of left folding to run it:

{-# LANGUAGE ExistentialQuantification, OverloadedStrings #-}
import Data.Bits
import Data.ByteString.Lazy as Lazy
import Data.ByteString.Lazy.Char8 ()
import Data.Vector.Unboxed as Unboxed
import Data.Word

data L b a = forall x. L (x -> b -> x) x (x -> a)

runL :: L Word8 a -> Lazy.ByteString -> a
runL (L xbx x xa) bs = xa (Lazy.foldl' xbx x bs)

crc32 :: L Word8 Word32
crc32 = L step 0xffffffff complement where
  step r b = unsafeShiftR r 8
     `xor` crcs Unboxed.! fromIntegral (xor r (fromIntegral b) .&. 0xff)

crcs :: Unboxed.Vector Word32
crcs = Unboxed.generate 256 (go.go.go.go.go.go.go.go.fromIntegral) where
  go c = unsafeShiftR c 1 `xor` if c .&. 1 /= 0 then 0xedb88320 else 0

main = print $ runL crc32 "12345689"

This is already what is somewhat embarassingly considered the "parallel" algorithm for computing a CRC. It computes 8 bits of the CRC at a time by using a look-up table, but it doesn't let me put extra cores to work and it doesn't let me split up my workload.

The algorithm I used above as the left fold can be seen as an implementation of the reflected table-driven algorithm Williams defines in Chapter 12, but it is pretty standard, modulo the trappings I've put on it to treat it as a fold, and algorithms just like it can be found everywhere.

I was skimming Reversing CRC, Theory and Practice when it clicked for me what the properties are of a CRC that make this possible, so through the rest of the post, I'll try to follow their vocabulary when it comes to a CRC.

Tearing Apart a CRC

Let's define $\operatorname{crc}(a) = r$ to be the core calculation that performs the polynomial division in $\mathrm{GF}(2^{32})$ that drives a CRC. We'll abuse notation, and permit us to have partially applied this long division to have obtained some remainder $r$ so far, and take $\operatorname{crc}(r,a) = r'$ to be the calculation that picks up with remainder $r$ and accepts more input $a$ , obtaining the new remainder $r'$ .

Using juxtaposition in the input argument to denote concatenation, this gives us the first property we'll need:

\operatorname{crc}(r,ab) = \operatorname{crc}(\operatorname{crc}(r,a),b)

If we try to adapt it directly to get a Monoid we get stuck. This seems to be inherently sequential.

So, let's define the Galois field used for CRC-32.

When working with numbers in $\mathrm{GF}(2^{32})$ addition is given by xor, and multiplication is limited to like powers of $x$ . If we fix the CRC polynomial and work bit reversed, we get the following number type.

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Data.Bits
import Data.Word

newtype GF = GF { runGF :: Word32 } deriving (Eq,Show,Read,Bits)

poly :: GF
poly = GF 0xedb88320 -- -- x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1

-- | compute x * p(x)
xtimes :: GF -> GF
xtimes c = unsafeShiftR c 1 + if testBit c 0 then poly else 0

instance Num GF where
  (+) = xor
  (-) = xor
  _ * 0 = 0
  a * b = xtimes a * unsafeShiftL b 1 + if testBit b 31 then a else 0
  negate = id
  abs = id
  signum = fromIntegral . signum . runGF
  fromInteger i
    | odd i     = GF 0x80000000 -- x^0
    | otherwise = GF 0          -- 0

main = putStrLn "It compiles, so it is obviously correct."

Since we're working bit reversed, the coefficient of $x^{31}$ is the least significant bit, and on the other extreme the coefficient of $1 = x^0$ is our most significant bit.

The next most significant bit gives us $x$ itself.

x :: GF
x = GF 0x40000000

xtimes above was the more humorously named go calculation used in crcs in the original left fold. It computes $x \cdot p(x)$ for a polynomial $p$ . In the multiplication algorithm above, we're using it in a peasant multiplier. Since we have a working Num, we can now use the built-in (^) from the Prelude to compute $x^n$ .

If you care about efficiency you could write the peasant exponentiator by hand:

-- | peasant exponentiation
xpow :: Int -> GF
xpow 0 = 1
xpow 1 = x
xpow n = case divMod n 2 of
  (q,0) ->          square (xpow q)
  (q,1) -> xtimes $ square (xpow q)
  _     -> error "unimplemented: extended Euclidean algorithm"
  where square a = a * a

This has the benefit that it gets to use xtimes rather than (* x) internally, shaving a few cycles, but clutters exposition. That said, if you care about efficiency, perhaps you can find me a nicer multiplication routine. The peasant exponentiator we're using isn't the fastest form of multiplication in $\mathrm{GF}(2^n)$ . We might consider adapting something like Montgomery multiplication and exponentiation, for very large choices of $n$ , there are other multiplication routines as well.

My implementation of GF is structured along the lines of a quickly dashed off sketch by Adrian Keet during a discussion on #haskell-lens. Any errors introduced in the above code, however, are all mine.

Properties of all CRCs

Tanenbaum's Computer Networks describes a few of the conditions necessary to define a good polynomial, including resistance to single and two bit errors, odd numbers of bits, bursts of all ones or zeroes, etc. But even with a well chosen standard polynomial in hand, there are a couple of classes of errors that standard CRC algorithms are tweaked to handle better.

Rather than reason about this through properties of $\mathrm{GF}(2^{32})$ directly, let's talk about two properties that are commonly seen as weaknesses of CRC and use them to derive an algorithm.

Zero Blindness

An actual CRC looks like CRC(a) = crc(INIT,a) `xor` FINAL, rather than being a just pure long division. Usually INIT and FINAL will be something like all 1s to complement the initial state and the final state. The reason why INIT is chosen to be non-zero is to combat a phenomenon known as "zero blindness".

If you consider a CRC as a polynomial long division, then prefixing a number of zeroes onto the number we're dividing wouldn't change the CRC at all! So what is done in practice is that we start with a current "remainder" that is 0xffffffff rather than 0.

There is another kind of zero blindness that affects the message followed by the CRC itself, any additional trailing 0's wouldn't affect the checksum, so most real world CRCs complement all of the bits of the remainder before emitting it into the output as well.

Here we'll be using the same mask for both INIT and FINAL:

-- | @x^31 + x^30 + ... + x + 1@
ones :: GF
ones = GF 0xffffffff

We'll be reasoning about our CRC by conceptually abusing this property of a CRC alongside a second, much more powerful property. 'forcing' our CRC into a blind state by exploiting:

Additive Homomorphism

This second property is one that is much more often used from a cracking perspective than as a desirable property:

\operatorname{crc}(r_{1} \mathbin{\mathrm{xor}} r_{2}, a_{1} \mathbin{\mathrm{xor}} a_{2}) = \operatorname{crc}(r_{1},a_{1}) \mathbin{\mathrm{xor}} \operatorname{crc}(r_{2},a_{2})

Exploiting Weakness

If we have input fragments $a$ and $b$ with lengths $m$ and $n$ respectively:

\begin{aligned} & \operatorname{CRC}(ab) \\ {}= & \operatorname{crc}(\mathrm{INIT},ab) + \mathrm{FINAL} && \text{definition of CRC} \\ {}= & \operatorname{crc}(\mathrm{INIT},a0^{n} + 0^{m} b) + \mathrm{FINAL} && \text{linearity} \\ {}= & \operatorname{crc}(\mathrm{INIT},a0^{n}) + \operatorname{crc}(0,0^{n}b) + \mathrm{FINAL} && \text{additive homomorphism} \\ {}= & \operatorname{crc}(\mathrm{INIT},a0^{n}) + \operatorname{crc}(0,b) + \mathrm{FINAL} && \text{zero blindness} \\ {}= & \operatorname{crc}(\operatorname{crc}(\mathrm{INIT},a),0^{n}) + \operatorname{crc}(0,b) + \mathrm{FINAL} && \text{definition of crc} \\ {}= & \operatorname{crc}(\operatorname{crc}(\mathrm{INIT},0^{m})+\operatorname{crc}(0,a),0^{n}) + \operatorname{crc}(0,b) + \mathrm{FINAL} && \text{additive homomorphism} \end{aligned}

That final expression requires us to be able to calculate $\operatorname{crc}(r,0^m)$ and to know $\operatorname{crc}(0,a)$ for each half of the input, but nothing more.

As James Deikun pointed out to me, $\operatorname{crc}(r,0^m)$ is particularly well behaved. When we look at what it does to our division is it appends just a number of 0's. When we work out the effect on the remainder we just need to multiply through our remainder by $x^m$ !

Instead of storing the string $0^m$ or the length $m$ , I'll just store $x^m$ directly.

Monoidal composition proceeds through a simplification of the definition above, where $\mathrm{INIT} = \mathrm{FINAL} = 0$ :

\begin{aligned} & \operatorname{crc}(0,ab) \\ {}= & \operatorname{crc}(0,a 0^{n} + 0^{m}b) && \text{linearity} \\ {}= & \operatorname{crc}(0,a 0^{n}) + \operatorname{crc}(0,0^{m} b) && \text{additive homomorphism} \\ {}= & \operatorname{crc}(0,a 0^{n}) + \operatorname{crc}(0,b) && \text{zero blindness} \\ {}= & \operatorname{crc}(\operatorname{crc}(0,a),0^{n}) + \operatorname{crc}(0,b) && \text{definition of crc} \\ {}= & \operatorname{crc}(0,a)\cdot x^{n} + \operatorname{crc}(0,b) && \operatorname{crc}(r,0^{m}) = r\cdot x^{m} \end{aligned}

So if we just store the length (mangled as $x^n$ ) and the CRC remainder from a starting remainder of 0, we can compose these answers associatively!

data CRC32 = CRC32
  {-# UNPACK #-} !GF
  {-# UNPACK #-} !GF
  deriving (Eq,Read,Show)

instance Monoid CRC32 where
  CRC32 p m `mappend` CRC32 q n = CRC32 (p*n+q) (m*n)
  mempty = CRC32 0 1

Here CRC32 p m stores $p = \operatorname{crc}(0,a)$ for our input string alongside $m = x^{|a|}$ .

Our mempty comes from the fact that $\operatorname{crc}(0,\text{\texttt{""}}) = 0$ , and note that the 1 here is actually GF 0x80000000 and represents $x^0$ in our Galois field, so we're denoting an input of length 0.

If we build the standard byte-wise CRC table:

crcs :: UArray Word8 GF
crcs = listArray (0,255) $ map (xtimes.xtimes.xtimes.xtimes.xtimes.xtimes.xtimes.xtimes.GF) [0..255]

We can then define the injection into our monoid for a byte worth of data at a time.

byte :: Word8 -> CRC32
byte a = CRC32 (crcs ! a) (x^8) -- x^8 = GF 0x800000

The last thing we need to do is apply the INIT and FINAL masks.

Going back to our original equations, $\operatorname{crc}(\mathrm{INIT},0^m)$ can be computed by multiplying the mask by $x^m$ , and we can just add in the FINAL mask when we're done. Here it is also 0xffffffff.

Using those results we can finally find our fold:

runCRC :: CRC32 -> Word32
runCRC (CRC32 p m) = runGF (ones * m + p + ones)

Try a different split

Move the boundary. Each half carries enough information to compose the whole.

Your message

Split after 4 bytes9 UTF-8 bytes

Remainder p: —
Shift factor m: —

Remainder q: —
Shift factor n: —

(p, m) ⊗ (q, n) = (pn + q, mn)+ is XOR · multiplication is polynomial multiplication modulo the CRC polynomial

DIRECT CRC-32—One pass over the message

COMPOSED CRC-32—Two summaries, one composition

Waiting for Haskell

Loading Haskell… · Bytes are shown in hexadecimal. Splits may fall inside a UTF-8 character; the checksum still works on the exact bytes. Empty pieces are the identity.

The Story So Far

{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

import Control.Comonad
import Data.Bits
import Data.Foldable as Foldable
import Data.Monoid
import Data.Profunctor
import Data.Array.Unboxed
import Data.Word

newtype GF = GF { runGF :: Word32 } deriving (Eq,Show,Read,Bits,IArray UArray)

poly :: GF
poly = GF 0xedb88320 -- x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1

-- | compute x * p(x)
xtimes :: GF -> GF
xtimes c = unsafeShiftR c 1 + if testBit c 0 then poly else 0

instance Num GF where
  (+) = xor
  (-) = xor
  _ * 0 = 0
  a * b = xtimes a * unsafeShiftL b 1 + if testBit b 31 then a else 0
  negate = id
  abs = id
  signum = fromIntegral . signum . runGF
  fromInteger i
    | odd i     = GF 0x80000000 -- x^0
    | otherwise = GF 0          -- 0

x :: GF
x = GF 0x40000000 -- x^1

ones :: GF
ones = GF 0xffffffff -- | x^31+x^30+...+x+1

data CRC32 = CRC32 {-# UNPACK #-} !GF {-# UNPACK #-} !GF deriving (Eq,Read,Show)

instance Monoid CRC32 where
  CRC32 p m `mappend` CRC32 q n = CRC32 (p*n+q) (m*n)
  mempty = CRC32 0 1

crcs :: UArray Word8 GF
crcs = listArray (0,255) $ map (xtimes.xtimes.xtimes.xtimes.xtimes.xtimes.xtimes.xtimes.GF) [0..255]

runCRC :: CRC32 -> Word32
runCRC (CRC32 p m) = runGF (ones * m + p + ones)

byte :: Word8 -> CRC32
byte a = CRC32 (crcs ! a) (x^8)

main = print $ runCRC $ foldMap (byte.fromIntegral.fromEnum) "123456789"

Deeper Down the Rabbit Hole

This also means if you keep the blinded CRCs around you can calculate a modified aggregate CRC without starting over from the left of your document or ADT.

Combining this with a finger tree can enable you to calculate a CRC for an entire document in parallel and then to update it incrementally in mere logarithmic time in response to edits. It also means that you do not need to invalidate an entire CRC.

Combining this with an ADT makes for cheap rehashing as portions of a structure changes.

Nothing here was specific to the modulus used for CRC-32. It works equally well for any other standard "Rocksoft"-style CRC. This works particularly well for the variant of CRC-8 used in Rijndael/AES, because the lookup table can be used directly for multiplication.

A CRC isn't a cryptographically strong hash, however, due to their importance in network protocols, telecommunications, document and image formats, and general ubiquity, having a way to compute them both in parallel and incrementally opens up new opportunities.

Now what we've come all the way through to the conclusion there are obvious analogies to how one can execute a Rabin-Karp or a simple addition modulo prime hash in parallel.

Change the grouping

The same three fragments, in the same order. Each grouping is calculated separately in Haskell.

A B C

(A ⊗ B) ⊗ C

First, A ⊗ B

Remainder: —
Shift: —

Then, (A ⊗ B) ⊗ C

Remainder: —
Shift: —
CRC-32: —

A ⊗ (B ⊗ C)

First, B ⊗ C

Remainder: —
Shift: —

Then, A ⊗ (B ⊗ C)

Remainder: —
Shift: —
CRC-32: —

Waiting for Haskell

The combined result is also checked against a direct CRC of A ++ B ++ C.

The equality holds for every triple. Write A = (p, m), B = (q, n), C = (r, s):

\begin{aligned} (A \otimes B) \otimes C &= ((pn + q)s + r,\;(mn)s) \\ &= (pns + qs + r,\;mns) \\[6pt] A \otimes (B \otimes C) &= (p(ns) + (qs + r),\;m(ns)) \\ &= (pns + qs + r,\;mns) \end{aligned}

Distributivity and associativity of polynomial multiplication and XOR give the same pair on both sides. Here ⊗ is composition of summaries; + is XOR and multiplication is modulo the CRC polynomial.

Using associativity to update a cached tree

Try editing a chunk

Change any chunk. Only that leaf and its ancestors are recalculated.

A ⊗ B—

C ⊗ D—

(A ⊗ B) ⊗ (C ⊗ D)—

Four leaves. Two branches. One answer.

—

Each node displays the finished CRC of its fragment. Composition uses the cached (remainder, shift) pairs, not these displayed CRCs. Highlighting shows which tree nodes were recalculated. A separate full scan checks the answer after each edit. These examples run on one browser thread; associativity also permits parallel evaluation.

Monoidal Folding

(if you aren't interested in folding, you can probably skip the remainder, but it does polish up the API nicely)

I haven't mentioned a single Comonad all post. Time to fix that.

We can build up a new kind of folding, based capturing the arguments to a foldMap in amber, just like Max Rabkin originally did with the arguments to foldl'.

This yields the following type:

data M a b = forall r. M (r -> b) (a -> r) (r -> r -> r) r

We can map over the inputs and outputs:

instance Profunctor M where
  dimap f g (M k h m e) = M (g.k) (h.f) m e

There is also an Applicative structured just like the Applicative for L.

There is even a Monad that permits you to write (inefficient) multipass algorithms!

Pause for Reflection

The problem then becomes, how to run it. foldMap doesn't let us explicitly pass arguments for the mappend and mempty of the Monoid in question.

We could run M using foldr:

runM :: Foldable f => M a b -> f a -> b
runM (M k h m z) xs = k (Foldable.foldr (m.h) z xs)

But that isn't very satisfying, the whole point of introducing a 'Monoid' was to be able to associate however we pleased.

We could make a Monoid:

newtype Slow a = Slow { runSlow :: (a -> a -> a) -> a -> a }

instance Monoid (Slow a) where
  mempty = Slow (\_ e -> e)
  mappend (Slow f) (Slow g) = Slow $ \p e = runSlow f p e `p` runShow g p e

But if you have any sharing of monoidal values, then working with Slow will actually only share the functions it contains, not their results.

The better tool for evaluating M, unfortunately requires some heavy lifting. We can turn to my reflection package to allow us to manufacture a Monoid out of an arbitrary function and unit value.

Austin Seipp recently wrote a nice tutorial on how to do this, so I'll just skip to the solution:

newtype N a s = N { runN :: a }

instance Reifies s (a -> a -> a, a) => Monoid (N a s) where
  mempty = N $ snd $ reflect (Proxy :: Proxy s)
  mappend (N a) (N b) = N $ fst (reflect (Proxy :: Proxy s)) a b

runM :: Foldable f => M a b -> f a -> b
runM (M k h m (z :: m)) s = reify (m, z) $
    \ (_ :: Proxy s) -> k $ runN (foldMap (N #. h) s :: N m s)

Here we make up a Monoid that reflects how to do what it needs to do out of the environment, then make up an instance with the mappend and mempty we want.

Finally (#.) in runM is drawn from Data.Profunctor.Unsafe to work around the fact that SomeNewType . f doesn't erase down to f, but rather to the eta-expansion of f, so it has ever so slightly different semantics.

Now that we can run an monoidal folding, it'd be nice to be able to do the same things we could with left foldings.

Not The Comonads You Are Looking For

But if we go to copy the Comonad from L we get gobbledygook!

instance Comonad (L a) where
  extract (L k _ z) = k z
  duplicate (L k h z) = L (L k h) h z

When we were working with L, this comonad was able to sneak in before the final tweak is applied at the end and snatches up the seed we've computed so far and uses at as the seed for the nested L in

duplicate :: L a b -> L a (L a b)

But if we do that with M, we'd get something that replaced the mempty of our Monoid with the result of what we've tallied up so far!

Last time, we used the fact that (L a) was isomorphic to an EnvT'd Store Comonad, where we'd quantified away the state parameter.

This time, we'll have to turn to a different isomorphism.

There is a comonad for (->) m, whenever $m$ is a Monoid. This Comonad is what I called the Traced comonad in comonad-transformers. If you squint hard enough, you can see that M a is isomorphic to forall m. Monoid m => EnvT (a -> m) ((->) m) a.

When we borrow this structure we get

instance Comonad (M b) where
  extract (M k _ _ z) = k z
  duplicate (M k h m z) = M (\n -> M (k . m n) h m z) h m z

Isomorphism Does Not Imply Equal Efficiency

I had a performance issue with the monoid homomorphism described in the last post, that this Comonad helps address.

Last time I noted that with L:

extract = more []
more xs =<= more ys = more (xs ++ ys)

But if we expand the second law:

more (xs ++ ys) = more xs =<= more ys = more xs . extend (more ys)

there we're partially applying a suffix of our input to a left fold!

This means we're capturing it in the environment:

more xs . extend (more ys) = more xs . fmap (more ys) . duplicate

This leads to the observation that we don't have to do that, our comonad was set up precisely so we could partially evaluate out to a new seed.

By naturality or good old fashioned equational reasoning, we can get to an alternate statement of the second law:

more (xs ++ ys) = more ys . more xs . duplicate

This gives us an efficient algorithm for composing left foldings.

When we work with the monoidal folding above, we have the flexibility to get the more efficient non-leaky version for both the left side and the right side of the structure.

Putting It Back Together Again

{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, ScopedTypeVariables, FlexibleContexts, UndecidableInstances #-}

import Control.Comonad
import Data.Bits
import Data.Foldable as Foldable
import Data.Monoid
import Data.Profunctor.Unsafe
import Data.Proxy
import Data.Reflection
import Data.Array.Unboxed
import Data.Word

newtype GF = GF { runGF :: Word32 } deriving (Eq,Show,Read,Bits,IArray UArray)

-- | @x^32 + x^26 + x^23 + x^22 + x^16 + x^12 + x^11 + x^10 + x^8 + x^7 + x^5 + x^4 + x^2 + x + 1@
poly :: GF
poly = GF 0xedb88320 -- the polynomial we're working modulo in GF(2^32) for CRC32.

-- | compute x * p(x)
xtimes :: GF -> GF
xtimes c = unsafeShiftR c 1 + if testBit c 0 then poly else 0

instance Num GF where
  (+) = xor
  (-) = xor
  _ * 0 = 0
  a * b = xtimes a * unsafeShiftL b 1 + if testBit b 31 then a else 0
  negate = id
  abs = id
  signum = fromIntegral . signum . runGF
  fromInteger i
    | odd i     = GF 0x80000000 -- x^0
    | otherwise = GF 0          -- 0

-- | @x^1@
x :: GF
x = GF 0x40000000

-- | @x^31 + x^30 + ... + x + 1@
ones :: GF
ones = GF 0xffffffff

data CRC32 = CRC32 {-# UNPACK #-} !GF {-# UNPACK #-} !GF deriving (Eq,Read,Show)

instance Monoid CRC32 where
  CRC32 p m `mappend` CRC32 q n = CRC32 (p*n+q) (m*n)
  mempty = CRC32 0 1

crcs :: UArray Word8 GF
crcs = listArray (0,255) $ map (xtimes.xtimes.xtimes.xtimes.xtimes.xtimes.xtimes.xtimes.GF) [0..255]

runCRC :: CRC32 -> Word32
runCRC (CRC32 p m) = runGF (ones * m + p + ones)

byte :: Word8 -> CRC32
byte a = CRC32 (crcs ! a) (x^8)

data M a b where
  M :: (r -> b) -> (a -> r) -> (r -> r -> r) -> r -> M a b

instance Functor (M a) where
  fmap f (M k h m z) = M (f.k) h m z

instance Profunctor M where
  dimap f g (M k h m z) = M (g.k) (h.f) m z

instance Comonad (M a) where
  extract (M k _ _ z) = k z
  duplicate (M k h m z) = M (\n -> M (k . m n) h m z) h m z

newtype N a s = N { runN :: a }

instance Reifies s (a -> a -> a, a) => Monoid (N a s) where
  mempty = N $ snd $ reflect (Proxy :: Proxy s)
  mappend (N a) (N b) = N $ fst (reflect (Proxy :: Proxy s)) a b

runM :: Foldable f => M a b -> f a -> b
runM (M k h m (z :: m)) s = reify (m, z) $
    \ (_ :: Proxy s) -> k $ runN (foldMap (N #. h) s :: N m s)

runR :: Foldable f => M a b -> f a -> b
runR (M k h m z) xs = k (Foldable.foldr (m.h) z xs)

runL :: Foldable f => M a b -> f a -> b
runL (M k h m z) xs = k (Foldable.foldl' (\r -> m r . h) z xs)

crc32 :: M Word8 Word32
crc32 = M runCRC byte mappend mempty

main = print $ runM crc32 [0x12,0x34]

Now the only part of the CRC API that the user has to concern themselves with is the actual crc32 combinator. Everything else is generic and can be reused for other folds. If you want to keep folding you can keep the fold alive by using duplicate!

We could actually abstract over the choice of polynomial for our Galois field, by calculating our lut locally in a crc combinator that was parameterized on the values of INIT, FINAL and poly, or even by using reflection to move the modulus and/or lookup table into a type parameter. By switching to Bits and Integral constraints rather than fixing ourselves to Word32, we can implement CRC-8, CRC-16 and CRC-64 variants very easily as well.

Expanded implementation

{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, RankNTypes, ScopedTypeVariables, StandaloneDeriving, MultiParamTypeClasses, FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

import Control.Comonad
import Data.Bits
import Data.Foldable as Foldable
import Data.Monoid
import Data.Profunctor
import Data.Proxy
import Data.Reflection
import Data.Array.Unboxed
import Data.Word

newtype GF a s = GF { runGF :: a } deriving (Eq,Show,Read,Bits)

deriving instance IArray UArray a => IArray UArray (GF a s)

-- | compute x * p(x)
xtimes :: (Integral a, Bits a, Reifies s a) => GF a s -> GF a s
xtimes c = unsafeShiftR c 1 + if testBit c 0 then GF (reflect c) else 0
{-# INLINE xtimes #-}

instance (Integral a, Bits a, Reifies s a) => Num (GF a s) where
  (+) = xor
  (-) = xor
  _ * 0 = 0
  a * b = xtimes a * unsafeShiftL b 1 + if testBit b (bitSize b - 1) then a else 0
  negate = id
  abs = id
  signum = fromIntegral . signum . runGF
  fromInteger i
    | odd i     = GF (bit (bitSize (undefined :: a) - 1)) -- x^0
    | otherwise = GF 0                     -- 0

-- | @x^1@
x :: forall a s. Bits a => GF a s
x = GF (bit (bitSize (undefined :: a) - 2))
{-# INLINE x #-}

data CRC a = CRC !a !a deriving (Eq,Read,Show)

instance Num a => Monoid (CRC a) where
  CRC p m `mappend` CRC q n = CRC (p*n+q) (m*n)
  mempty = CRC 0 1

crc :: forall a. (Integral a, Bits a, IArray UArray a) => a -> a -> a -> M Word8 a
crc _INIT _FINAL poly = reify poly $ \(_ :: Proxy s) ->
  let crcs :: UArray Word8 (GF a s)
      crcs = listArray (0,255) $ map (xtimes.xtimes.xtimes.xtimes.xtimes.xtimes.xtimes.xtimes.GF) [0..255]
      k (CRC p m) = runGF (GF _INIT * m + p + GF _FINAL)
      h a = CRC (crcs ! a) (x^8)
  in M k h mappend mempty
{-# INLINE crc #-}

-- | @x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1@
crc32 :: M Word8 Word32
crc32 = crc 0xffffffff 0xffffffff 0xedb88320

crc64_ecma182 :: M Word8 Word64
crc64_ecma182 = crc (-1) (-1) 0xC96C5795D7870F42

crc8 :: M Word8 Word8
crc8 = crc 0xff 0xff 0xab

crc8_sae :: M Word8 Word8
crc8_sae = crc 0xff 0xff 0xb8

data M a b where
  M :: (r -> b) -> (a -> r) -> (r -> r -> r) -> r -> M a b

instance Functor (M a) where
  fmap f (M k h m z) = M (f.k) h m z

instance Profunctor M where
  dimap f g (M k h m z) = M (g.k) (h.f) m z

instance Comonad (M a) where
  extract (M k _ _ z) = k z
  duplicate (M k h m z) = M (\n -> M (k . m n) h m z) h m z

runM :: Foldable f => M a b -> f a -> b
runM (M k h m z) xs = k (Foldable.foldr (m.h) z xs)

main = print $ runM crc32 [0x12,0x34]

Now that the algorithm is fully assembled, I can recognize aspects of it.

I've seen a similar trick applied to turn a Rabin-Karp hash into a rolling hash.

There the Monoid was the same, except we worked with a different ring $\mathbb{Z}/n\mathbb{Z}$ , with $n$ odd, and instead of $x^k$ , we track $2^k \bmod n$ and exploit the fact that 2 is coprime with n.

Spotting that connection means that this also provides a way to make an efficient rolling-hash function out of any standard CRC!

-Edward Kmett

September 10th, 2013

P.S. I packaged M up over the weekend in the folds package on hackage, but I reserve the right to change the API and welcome feedback.

[Edit: It appears either Kadatch or Jenkins figured out the same basic trick, which isn't surprising given how basic it is once you peel apart the math. They also identified the opportunity for a CRC-based rolling hash.]