+ go0 ∷ WordsData → bs → Int → New v Int32
+ → (# WordsData, bs, Int, New v Int32 #)
+ go0 w bs n v
+ | n ≥ nSamples
+ = (# w, bs, n, v #)
+ | edMedian0 (fst $ wdEntropyData w) < 2 ∧
+ wdHoldingZero w ≡ False ∧
+ wdHoldingOne w ≡ 0 ∧
+ edMedian1 (fst $ wdEntropyData w) < 2
+ = if wdZeroesAcc w > 0 then
+ let w' = w { wdZeroesAcc = wdZeroesAcc w - 1 }
+ in
+ if wdZeroesAcc w' > 0 then
+ let (# n', v' #) = appendWord 0 n v
+ in
+ go0 w' bs n' v'
+ else
+ go1 w' bs n v
+ else
+ let cBits = min 33 $ B.length (B.takeWhile id bs)
+ bs' = B.drop cBits bs
+ in
+ if cBits ≡ 33 then
+ (# w, bs', n, v #)
+ else
+ let (# w', bs'' #) = go0' cBits w bs'
+ in
+ if wdZeroesAcc w' > 0 then
+ let w'' = w' {
+ wdEntropyData =
+ ( clearMedian $ fst $ wdEntropyData w'
+ , clearMedian $ snd $ wdEntropyData w' )
+ }
+ (# n', v' #)
+ = appendWord 0 n v
+ in
+ go0 w'' bs'' n' v'
+ else
+ go1 w' bs'' n v
+ | otherwise
+ = go1 w bs n v
+
+ go0' ∷ Word32 → WordsData → bs → (# WordsData, bs #)
+ go0' cBits w bs
+ | cBits < 2
+ = let w' = w { wdZeroesAcc = cBits }
+ in
+ (# w', bs #)
+ | otherwise
+ = let w' = w { wdZeroesAcc = 0 }
+ in
+ go0'' 1 cBits w' bs
+
+ go0'' ∷ Word32 → Word32 → WordsData → bs → (# WordsData, bs #)
+ go0'' mask cBits w bs
+ | cBits ≡ 1
+ = let w' = w { wdZeroesAcc = wdZeroesAcc w .|. mask }
+ in
+ (# w', bs #)
+ | otherwise
+ = let cBits' = cBits - 1
+ w' = if B.head bs then
+ w { wdZeroesAcc = wdZeroesAcc w .|. mask }
+ else
+ w
+ mask' = mask `shiftL` 1
+ bs' = B.tail bs
+ in
+ go0'' mask' cBits' w' bs'
+
+ go1 ∷ WordsData → bs → Int → New v Int32
+ → (# WordsData, bs, Int, New v Int32 #)
+ go1 w bs n v
+ | wdHoldingZero w
+ = let w' = w { wdHoldingZero = False }
+ in
+ go2 0 w' bs n v
+ | otherwise
+ = error "FIXME"
+
+ go2 ∷ Word32 → WordsData → bs → Int → New v Int32
+ → (# WordsData, bs, Int, New v Int32 #)
+ go2 0 w bs n v
+ = let ent = getEntropy n w
+ low = 0
+ high = getMedian0 ent
+ ent' = decMedian0 ent
+ w' = setEntropy ent' n w
+ in
+ go3 low high w' bs n v
+ go2 1 w bs n v
+ = let ent = getEntropy n w
+ low = getMedian0 ent
+ high = low + getMedian1 ent - 1
+ ent' = (incMedian0 ∘ decMedian1) ent
+ w' = setEntropy ent' n w
+ in
+ go3 low high w' bs n v
+ go2 2 w bs n v
+ = let ent = getEntropy n w
+ low = getMedian0 ent + getMedian1 ent
+ high = low + getMedian2 ent - 1
+ ent' = (incMedian0 ∘ incMedian1 ∘ decMedian2) ent
+ w' = setEntropy ent' n w
+ in
+ go3 low high w' bs n v
+ go2 onesCount w bs n v
+ = let ent = getEntropy n w
+ low = getMedian0 ent + getMedian1 ent + (onesCount-2) ⋅ getMedian2 ent
+ high = low + getMedian2 ent - 1
+ ent' = (incMedian0 ∘ incMedian1 ∘ incMedian2) ent
+ w' = setEntropy ent' n w
+ in
+ go3 low high w' bs n v
+
+ go3 ∷ Word32 → Word32 → WordsData → bs → Int → New v Int32
+ → (# WordsData, bs, Int, New v Int32 #)
+ go3 low high w bs n v
+ = let (# code, bs' #)
+ = readCode bs (high - low)
+ low' = low + code
+ word = if B.head bs' then
+ fromIntegral $ complement low'
+ else
+ fromIntegral low'
+ bs'' = B.tail bs'
+ (# n', v' #)
+ = appendWord word n v
+ in
+ go0 w bs'' n' v'
+
+ appendWord ∷ Int32 → Int → New v Int32 → (# Int, New v Int32 #)
+ appendWord word n v
+ = let v' = New.modify (\mv → MV.unsafeWrite mv n word) v
+ n' = n + 1
+ in
+ (# n', v' #)
+
+ getEntropy ∷ Int → WordsData → EntropyData
+ getEntropy n w
+ | isMono = fst $ wdEntropyData w
+ | n `testBit` 0 = fst $ wdEntropyData w
+ | otherwise = snd $ wdEntropyData w
+
+ setEntropy ∷ EntropyData → Int → WordsData → WordsData
+ setEntropy e n w
+ | isMono = w { wdEntropyData = (e, snd $ wdEntropyData w) }
+ | n `testBit` 0 = w { wdEntropyData = (e, snd $ wdEntropyData w) }
+ | otherwise = w { wdEntropyData = (fst $ wdEntropyData w, e) }
+