{-# LANGUAGE MultiWayIf #-}
module Codec.Compression.Zlib.Deflate (
inflate,
computeCodeValues,
) where
import Codec.Compression.Zlib.HuffmanTree (
HuffmanTree,
createHuffmanTree,
)
import Codec.Compression.Zlib.Monad (
DecompressionError (..),
DeflateM,
advanceToByte,
emitBlock,
emitByte,
emitPastChunk,
finalAdler,
finalize,
moveWindow,
nextBits,
nextBlock,
nextCode,
nextWord16,
nextWord32,
raise,
)
import Control.Monad (replicateM, unless)
import Data.Array (Array, array, (!))
import Data.Bits (complement, shiftL)
import Data.Int (Int64)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as Map
import Data.List (sortBy)
import Data.Word (Word8)
import Numeric (showHex)
inflate :: DeflateM s ()
inflate :: DeflateM s ()
inflate = do
HuffmanTree Int
fixedLit <- DeflateM s (HuffmanTree Int)
forall s. DeflateM s (HuffmanTree Int)
buildFixedLitTree
HuffmanTree Int
fixedDist <- DeflateM s (HuffmanTree Int)
forall s. DeflateM s (HuffmanTree Int)
buildFixedDistanceTree
HuffmanTree Int -> HuffmanTree Int -> DeflateM s ()
forall s. HuffmanTree Int -> HuffmanTree Int -> DeflateM s ()
go HuffmanTree Int
fixedLit HuffmanTree Int
fixedDist
where
go :: HuffmanTree Int -> HuffmanTree Int -> DeflateM s ()
go HuffmanTree Int
fixedLit HuffmanTree Int
fixedDist = do
Bool
isFinal <- HuffmanTree Int -> HuffmanTree Int -> DeflateM s Bool
forall s. HuffmanTree Int -> HuffmanTree Int -> DeflateM s Bool
inflateBlock HuffmanTree Int
fixedLit HuffmanTree Int
fixedDist
DeflateM s ()
forall s. DeflateM s ()
moveWindow
if Bool
isFinal
then DeflateM s ()
forall s. DeflateM s ()
checkChecksum DeflateM s () -> DeflateM s () -> DeflateM s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DeflateM s ()
forall s. DeflateM s ()
finalize
else HuffmanTree Int -> HuffmanTree Int -> DeflateM s ()
go HuffmanTree Int
fixedLit HuffmanTree Int
fixedDist
checkChecksum :: DeflateM s ()
checkChecksum = do
DeflateM s ()
forall s. DeflateM s ()
advanceToByte
Word32
ourAdler <- DeflateM s Word32
forall s. DeflateM s Word32
finalAdler
Word32
theirAdler <- DeflateM s Word32
forall s. DeflateM s Word32
nextWord32
Bool -> DeflateM s () -> DeflateM s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
theirAdler Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
ourAdler) (DeflateM s () -> DeflateM s ()) -> DeflateM s () -> DeflateM s ()
forall a b. (a -> b) -> a -> b
$
DecompressionError -> DeflateM s ()
forall s a. DecompressionError -> DeflateM s a
raise
( String -> DecompressionError
ChecksumError
( String
"checksum mismatch: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word32 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Word32
theirAdler String
""
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" != "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word32 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Word32
ourAdler String
""
)
)
inflateBlock :: HuffmanTree Int -> HuffmanTree Int -> DeflateM s Bool
inflateBlock :: HuffmanTree Int -> HuffmanTree Int -> DeflateM s Bool
inflateBlock HuffmanTree Int
fixedLitTree HuffmanTree Int
fixedDistanceTree = do
Bool
bfinal <- (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== (Word8
1 :: Word8)) (Word8 -> Bool) -> DeflateM s Word8 -> DeflateM s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Word8
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
1
Word8
btype <- Int -> DeflateM s Word8
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
2
case Word8
btype :: Word8 of
Word8
0 -> do
DeflateM s ()
forall s. DeflateM s ()
advanceToByte
Word16
len <- DeflateM s Word16
forall s. DeflateM s Word16
nextWord16
Word16
nlen <- DeflateM s Word16
forall s. DeflateM s Word16
nextWord16
Bool -> DeflateM s () -> DeflateM s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word16
len Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16 -> Word16
forall a. Bits a => a -> a
complement Word16
nlen) (DeflateM s () -> DeflateM s ()) -> DeflateM s () -> DeflateM s ()
forall a b. (a -> b) -> a -> b
$
DecompressionError -> DeflateM s ()
forall s a. DecompressionError -> DeflateM s a
raise (String -> DecompressionError
FormatError String
"Len/nlen mismatch in uncompressed block.")
ByteString -> DeflateM s ()
forall s. ByteString -> DeflateM s ()
emitBlock (ByteString -> DeflateM s ())
-> DeflateM s ByteString -> DeflateM s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word16 -> DeflateM s ByteString
forall a s. Integral a => a -> DeflateM s ByteString
nextBlock Word16
len
Bool -> DeflateM s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
bfinal
Word8
1 -> do
HuffmanTree Int -> HuffmanTree Int -> DeflateM s ()
forall s. HuffmanTree Int -> HuffmanTree Int -> DeflateM s ()
runInflate HuffmanTree Int
fixedLitTree HuffmanTree Int
fixedDistanceTree
Bool -> DeflateM s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
bfinal
Word8
2 -> do
Int
hlit <- (Int
257 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
5
Int
hdist <- (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
5
Int
hclen <- (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
4
[Int]
codeLens <- Int -> DeflateM s Int -> DeflateM s [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
hclen (Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
3)
let codeLens' :: [(Int, Int)]
codeLens' = [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
codeLengthOrder [Int]
codeLens
HuffmanTree Int
codeTree <- [(Int, Int)] -> DeflateM s (HuffmanTree Int)
forall s. [(Int, Int)] -> DeflateM s (HuffmanTree Int)
computeHuffmanTree [(Int, Int)]
codeLens'
IntMap Int
lens <- HuffmanTree Int
-> Int -> Int -> Int -> IntMap Int -> DeflateM s (IntMap Int)
forall s.
HuffmanTree Int
-> Int -> Int -> Int -> IntMap Int -> DeflateM s (IntMap Int)
getCodeLengths HuffmanTree Int
codeTree Int
0 (Int
hlit Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hdist) Int
0 IntMap Int
forall a. IntMap a
Map.empty
let (IntMap Int
litlens, IntMap Int
offdistlens) =
(Int -> Int -> Bool) -> IntMap Int -> (IntMap Int, IntMap Int)
forall a. (Int -> a -> Bool) -> IntMap a -> (IntMap a, IntMap a)
Map.partitionWithKey (\Int
k Int
_ -> Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
hlit) IntMap Int
lens
distlens :: IntMap Int
distlens = (Int -> Int) -> IntMap Int -> IntMap Int
forall a. (Int -> Int) -> IntMap a -> IntMap a
Map.mapKeys (\Int
k -> Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hlit) IntMap Int
offdistlens
HuffmanTree Int
litTree <- [(Int, Int)] -> DeflateM s (HuffmanTree Int)
forall s. [(Int, Int)] -> DeflateM s (HuffmanTree Int)
computeHuffmanTree (IntMap Int -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
Map.toList IntMap Int
litlens)
HuffmanTree Int
distTree <- [(Int, Int)] -> DeflateM s (HuffmanTree Int)
forall s. [(Int, Int)] -> DeflateM s (HuffmanTree Int)
computeHuffmanTree (IntMap Int -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
Map.toList IntMap Int
distlens)
HuffmanTree Int -> HuffmanTree Int -> DeflateM s ()
forall s. HuffmanTree Int -> HuffmanTree Int -> DeflateM s ()
runInflate HuffmanTree Int
litTree HuffmanTree Int
distTree
Bool -> DeflateM s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
bfinal
Word8
_ ->
DecompressionError -> DeflateM s Bool
forall s a. DecompressionError -> DeflateM s a
raise (String -> DecompressionError
FormatError (String
"Unacceptable BTYPE: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
btype))
where
runInflate :: HuffmanTree Int -> HuffmanTree Int -> DeflateM s ()
runInflate :: HuffmanTree Int -> HuffmanTree Int -> DeflateM s ()
runInflate HuffmanTree Int
litTree HuffmanTree Int
distTree = do
Int
code <- HuffmanTree Int -> DeflateM s Int
forall a s. Show a => HuffmanTree a -> DeflateM s a
nextCode HuffmanTree Int
litTree
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
code Int
256 of
Ordering
LT -> do
Word8 -> DeflateM s ()
forall s. Word8 -> DeflateM s ()
emitByte (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
code)
HuffmanTree Int -> HuffmanTree Int -> DeflateM s ()
forall s. HuffmanTree Int -> HuffmanTree Int -> DeflateM s ()
runInflate HuffmanTree Int
litTree HuffmanTree Int
distTree
Ordering
EQ -> () -> DeflateM s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Ordering
GT -> do
Int64
len <- Int -> DeflateM s Int64
forall s. Int -> DeflateM s Int64
getLength Int
code
Int
distCode <- HuffmanTree Int -> DeflateM s Int
forall a s. Show a => HuffmanTree a -> DeflateM s a
nextCode HuffmanTree Int
distTree
Int
dist <- Int -> DeflateM s Int
forall s. Int -> DeflateM s Int
getDistance Int
distCode
Int -> Int -> DeflateM s ()
forall s. Int -> Int -> DeflateM s ()
emitPastChunk Int
dist (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
len)
DeflateM s ()
forall s. DeflateM s ()
moveWindow
HuffmanTree Int -> HuffmanTree Int -> DeflateM s ()
forall s. HuffmanTree Int -> HuffmanTree Int -> DeflateM s ()
runInflate HuffmanTree Int
litTree HuffmanTree Int
distTree
getCodeLengths ::
HuffmanTree Int ->
Int ->
Int ->
Int ->
IntMap Int ->
DeflateM s (IntMap Int)
getCodeLengths :: HuffmanTree Int
-> Int -> Int -> Int -> IntMap Int -> DeflateM s (IntMap Int)
getCodeLengths HuffmanTree Int
tree Int
n Int
maxl Int
prev IntMap Int
acc
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxl = IntMap Int -> DeflateM s (IntMap Int)
forall (m :: * -> *) a. Monad m => a -> m a
return IntMap Int
acc
| Bool
otherwise = do
Int
code <- HuffmanTree Int -> DeflateM s Int
forall a s. Show a => HuffmanTree a -> DeflateM s a
nextCode HuffmanTree Int
tree
if
| Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
15 ->
HuffmanTree Int
-> Int -> Int -> Int -> IntMap Int -> DeflateM s (IntMap Int)
forall s.
HuffmanTree Int
-> Int -> Int -> Int -> IntMap Int -> DeflateM s (IntMap Int)
getCodeLengths HuffmanTree Int
tree (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
maxl Int
code (Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
n Int
code IntMap Int
acc)
| Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 -> do
Int
num <- (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
2
HuffmanTree Int
-> Int -> Int -> Int -> IntMap Int -> DeflateM s (IntMap Int)
forall s.
HuffmanTree Int
-> Int -> Int -> Int -> IntMap Int -> DeflateM s (IntMap Int)
getCodeLengths HuffmanTree Int
tree (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
num) Int
maxl Int
prev (Int -> Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> Int -> a -> IntMap a -> IntMap a
addNTimes Int
n Int
num Int
prev IntMap Int
acc)
| Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
17 -> do
Int
num <- (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
3
HuffmanTree Int
-> Int -> Int -> Int -> IntMap Int -> DeflateM s (IntMap Int)
forall s.
HuffmanTree Int
-> Int -> Int -> Int -> IntMap Int -> DeflateM s (IntMap Int)
getCodeLengths HuffmanTree Int
tree (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
num) Int
maxl Int
0 (Int -> Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> Int -> a -> IntMap a -> IntMap a
addNTimes Int
n Int
num Int
0 IntMap Int
acc)
| Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
18 -> do
Int
num <- (Int
11 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
7
HuffmanTree Int
-> Int -> Int -> Int -> IntMap Int -> DeflateM s (IntMap Int)
forall s.
HuffmanTree Int
-> Int -> Int -> Int -> IntMap Int -> DeflateM s (IntMap Int)
getCodeLengths HuffmanTree Int
tree (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
num) Int
maxl Int
0 (Int -> Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> Int -> a -> IntMap a -> IntMap a
addNTimes Int
n Int
num Int
0 IntMap Int
acc)
| Bool
otherwise ->
DecompressionError -> DeflateM s (IntMap Int)
forall s a. DecompressionError -> DeflateM s a
raise (String -> DecompressionError
DecompressionError (String
"Unexpected code: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
code))
where
addNTimes :: Int -> Int -> a -> IntMap a -> IntMap a
addNTimes Int
idx Int
count a
val IntMap a
old =
let idxs :: [Int]
idxs = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
count [Int
idx ..]
vals :: [a]
vals = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
count a
val
in IntMap a -> IntMap a -> IntMap a
forall a. IntMap a -> IntMap a -> IntMap a
Map.union IntMap a
old ([(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
Map.fromList ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
idxs [a]
vals))
getLength :: Int -> DeflateM s Int64
getLength :: Int -> DeflateM s Int64
getLength Int
c = Array Int (DeflateM s Int64)
forall s. Array Int (DeflateM s Int64)
lengthArray Array Int (DeflateM s Int64) -> Int -> DeflateM s Int64
forall i e. Ix i => Array i e -> i -> e
! Int
c
{-# INLINE getLength #-}
lengthArray :: Array Int (DeflateM s Int64)
lengthArray :: Array Int (DeflateM s Int64)
lengthArray =
(Int, Int)
-> [(Int, DeflateM s Int64)] -> Array Int (DeflateM s Int64)
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array
(Int
257, Int
285)
[ (Int
257, Int64 -> DeflateM s Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
3)
, (Int
258, Int64 -> DeflateM s Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
4)
, (Int
259, Int64 -> DeflateM s Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
5)
, (Int
260, Int64 -> DeflateM s Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
6)
, (Int
261, Int64 -> DeflateM s Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
7)
, (Int
262, Int64 -> DeflateM s Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
8)
, (Int
263, Int64 -> DeflateM s Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
9)
, (Int
264, Int64 -> DeflateM s Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
10)
, (Int
265, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
11) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
1)
, (Int
266, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
13) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
1)
, (Int
267, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
15) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
1)
, (Int
268, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
17) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
1)
, (Int
269, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
19) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
2)
, (Int
270, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
23) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
2)
, (Int
271, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
27) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
2)
, (Int
272, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
31) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
2)
, (Int
273, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
35) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
3)
, (Int
274, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
43) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
3)
, (Int
275, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
51) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
3)
, (Int
276, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
59) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
3)
, (Int
277, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
67) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
4)
, (Int
278, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
83) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
4)
, (Int
279, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
99) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
4)
, (Int
280, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
115) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
4)
, (Int
281, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
131) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
5)
, (Int
282, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
163) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
5)
, (Int
283, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
195) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
5)
, (Int
284, (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
227) (Int64 -> Int64) -> DeflateM s Int64 -> DeflateM s Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int64
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
5)
, (Int
285, Int64 -> DeflateM s Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
258)
]
getDistance :: Int -> DeflateM s Int
getDistance :: Int -> DeflateM s Int
getDistance Int
c = Array Int (DeflateM s Int)
forall s. Array Int (DeflateM s Int)
distanceArray Array Int (DeflateM s Int) -> Int -> DeflateM s Int
forall i e. Ix i => Array i e -> i -> e
! Int
c
{-# INLINE getDistance #-}
distanceArray :: Array Int (DeflateM s Int)
distanceArray :: Array Int (DeflateM s Int)
distanceArray =
(Int, Int) -> [(Int, DeflateM s Int)] -> Array Int (DeflateM s Int)
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array
(Int
0, Int
29)
[ (Int
0, Int -> DeflateM s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1)
, (Int
1, Int -> DeflateM s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2)
, (Int
2, Int -> DeflateM s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
3)
, (Int
3, Int -> DeflateM s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
4)
, (Int
4, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
1)
, (Int
5, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
1)
, (Int
6, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
9) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
2)
, (Int
7, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
13) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
2)
, (Int
8, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
17) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
3)
, (Int
9, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
25) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
3)
, (Int
10, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
33) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
4)
, (Int
11, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
49) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
4)
, (Int
12, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
65) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
5)
, (Int
13, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
97) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
5)
, (Int
14, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
129) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
6)
, (Int
15, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
193) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
6)
, (Int
16, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
257) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
7)
, (Int
17, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
385) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
7)
, (Int
18, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
513) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
8)
, (Int
19, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
769) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
8)
, (Int
20, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1025) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
9)
, (Int
21, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1537) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
9)
, (Int
22, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2049) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
10)
, (Int
23, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3073) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
10)
, (Int
24, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4097) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
11)
, (Int
25, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6145) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
11)
, (Int
26, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8193) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
12)
, (Int
27, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12289) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
12)
, (Int
28, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16385) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
13)
, (Int
29, (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
24577) (Int -> Int) -> DeflateM s Int -> DeflateM s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> DeflateM s Int
forall a s. (Num a, Bits a) => Int -> DeflateM s a
nextBits Int
13)
]
buildFixedLitTree :: DeflateM s (HuffmanTree Int)
buildFixedLitTree :: DeflateM s (HuffmanTree Int)
buildFixedLitTree =
[(Int, Int)] -> DeflateM s (HuffmanTree Int)
forall s. [(Int, Int)] -> DeflateM s (HuffmanTree Int)
computeHuffmanTree
( [(Int
x, Int
8) | Int
x <- [Int
0 .. Int
143]]
[(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int
x, Int
9) | Int
x <- [Int
144 .. Int
255]]
[(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int
x, Int
7) | Int
x <- [Int
256 .. Int
279]]
[(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int
x, Int
8) | Int
x <- [Int
280 .. Int
287]]
)
buildFixedDistanceTree :: DeflateM s (HuffmanTree Int)
buildFixedDistanceTree :: DeflateM s (HuffmanTree Int)
buildFixedDistanceTree = [(Int, Int)] -> DeflateM s (HuffmanTree Int)
forall s. [(Int, Int)] -> DeflateM s (HuffmanTree Int)
computeHuffmanTree [(Int
x, Int
5) | Int
x <- [Int
0 .. Int
31]]
computeHuffmanTree :: [(Int, Int)] -> DeflateM s (HuffmanTree Int)
computeHuffmanTree :: [(Int, Int)] -> DeflateM s (HuffmanTree Int)
computeHuffmanTree [(Int, Int)]
initialData =
case [(Int, Int, Int)] -> Either String (HuffmanTree Int)
forall a.
Show a =>
[(a, Int, Int)] -> Either String (HuffmanTree a)
createHuffmanTree ([(Int, Int)] -> [(Int, Int, Int)]
computeCodeValues [(Int, Int)]
initialData) of
Left String
err -> DecompressionError -> DeflateM s (HuffmanTree Int)
forall s a. DecompressionError -> DeflateM s a
raise (String -> DecompressionError
HuffmanTreeError String
err)
Right HuffmanTree Int
x -> HuffmanTree Int -> DeflateM s (HuffmanTree Int)
forall (m :: * -> *) a. Monad m => a -> m a
return HuffmanTree Int
x
computeCodeValues :: [(Int, Int)] -> [(Int, Int, Int)]
computeCodeValues :: [(Int, Int)] -> [(Int, Int, Int)]
computeCodeValues [(Int, Int)]
vals = (Int -> (Int, Int) -> [(Int, Int, Int)] -> [(Int, Int, Int)])
-> [(Int, Int, Int)] -> IntMap (Int, Int) -> [(Int, Int, Int)]
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
Map.foldrWithKey (\Int
v (Int
l, Int
c) [(Int, Int, Int)]
a -> (Int
v, Int
l, Int
c) (Int, Int, Int) -> [(Int, Int, Int)] -> [(Int, Int, Int)]
forall a. a -> [a] -> [a]
: [(Int, Int, Int)]
a) [] IntMap (Int, Int)
codes
where
valsNo0s :: [(Int, Int)]
valsNo0s = ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
_, Int
b) -> (Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)) [(Int, Int)]
vals
valsSort :: [(Int, Int)]
valsSort = ((Int, Int) -> (Int, Int) -> Ordering)
-> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Int
a, Int
_) (Int
b, Int
_) -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
a Int
b) [(Int, Int)]
valsNo0s
blCount :: IntMap Int
blCount = ((Int, Int) -> IntMap Int -> IntMap Int)
-> IntMap Int -> [(Int, Int)] -> IntMap Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
_, Int
k) IntMap Int
m -> (Int -> Int -> Int) -> Int -> Int -> IntMap Int -> IntMap Int
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
Map.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
k Int
1 IntMap Int
m) IntMap Int
forall a. IntMap a
Map.empty [(Int, Int)]
valsNo0s
nextcode :: IntMap Int
nextcode = Int -> Int -> IntMap Int -> IntMap Int
step2 Int
0 Int
1 (Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
0 Int
0 IntMap Int
forall a. IntMap a
Map.empty)
lenTree :: IntMap Int
lenTree = [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
Map.fromList [(Int, Int)]
valsSort
codeTree :: IntMap Int
codeTree = [Int] -> IntMap Int -> IntMap Int -> IntMap Int
forall a. Num a => [Int] -> IntMap a -> IntMap a -> IntMap a
step3 (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
valsSort) IntMap Int
nextcode IntMap Int
forall a. IntMap a
Map.empty
maxBits :: Int
maxBits = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
valsSort)
codes :: IntMap (Int, Int)
codes = (Int -> Int -> (Int, Int))
-> IntMap Int -> IntMap Int -> IntMap (Int, Int)
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
Map.intersectionWith (,) IntMap Int
lenTree IntMap Int
codeTree
step2 :: Int -> Int -> IntMap Int -> IntMap Int
step2 Int
code Int
bits IntMap Int
nc
| Int
bits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxBits = IntMap Int
nc
| Bool
otherwise =
let prevCount :: Int
prevCount = Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
Map.findWithDefault Int
0 (Int
bits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) IntMap Int
blCount
code' :: Int
code' = (Int
code Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
prevCount) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
1
in Int -> Int -> IntMap Int -> IntMap Int
step2 Int
code' (Int
bits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
bits Int
code' IntMap Int
nc)
step3 :: [Int] -> IntMap a -> IntMap a -> IntMap a
step3 [] IntMap a
_ IntMap a
ct = IntMap a
ct
step3 (Int
n : [Int]
rest) IntMap a
nc IntMap a
ct =
let len :: Int
len = Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
Map.findWithDefault Int
0 Int
n IntMap Int
lenTree
Just a
ncLen = Int -> IntMap a -> Maybe a
forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
len IntMap a
nc
ct' :: IntMap a
ct' = Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
n a
ncLen IntMap a
ct
nc' :: IntMap a
nc' = Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
len (a
ncLen a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) IntMap a
nc
in if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then [Int] -> IntMap a -> IntMap a -> IntMap a
step3 [Int]
rest IntMap a
nc IntMap a
ct
else [Int] -> IntMap a -> IntMap a -> IntMap a
step3 [Int]
rest IntMap a
nc' IntMap a
ct'
codeLengthOrder :: [Int]
codeLengthOrder :: [Int]
codeLengthOrder =
[Int
16, Int
17, Int
18, Int
0, Int
8, Int
7, Int
9, Int
6, Int
10, Int
5, Int
11, Int
4, Int
12, Int
3, Int
13, Int
2, Int
14, Int
1, Int
15]