HEAD-only Core Lint error when building JuicyPixels code with -O2
Originally observed on a head.hackage build here.
The following code (adapted from the JuicyPixels-3.3.5 library on Hackage) produces a Core Lint error when built with -O2:
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
module Codec.Picture.Gif.Internal.LZWEncoding( lzwEncode ) where
import Control.Monad( when )
import Control.Monad.ST( RealWorld, runST )
import Data.Bits( (.&.), (.|.), unsafeShiftR, unsafeShiftL )
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as S
import qualified Data.ByteString.Lazy as L
import qualified Data.IntMap.Strict as I
import Data.Maybe( fromMaybe )
import Data.STRef
import Data.Word( Word8, Word32 )
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Array ( copyArray )
import Foreign.Ptr
import Foreign.Storable
import GHC.Exts ( Addr#, Int(..), Int#, Ptr(..), State#, Word#, realWorld#, unsafeCoerce# )
import GHC.ForeignPtr ( mallocPlainForeignPtrAlignedBytes )
import GHC.IO ( IO(..) )
import GHC.ST ( ST(..) )
import GHC.Types ( SPEC(..) )
import GHC.Word ( Word8(..) )
-----
-- Control.Monad.Primitive
-----
class Monad m => PrimMonad m where
type PrimState m
primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
class PrimMonad m => PrimBase m where
internal :: m a -> State# (PrimState m) -> (# State# (PrimState m), a #)
instance PrimMonad (ST s) where
type PrimState (ST s) = s
primitive = ST
{-# INLINE primitive #-}
instance PrimMonad IO where
type PrimState IO = RealWorld
primitive = IO
{-# INLINE primitive #-}
instance PrimBase IO where
internal (IO p) = p
{-# INLINE internal #-}
primitive_ :: PrimMonad m
=> (State# (PrimState m) -> State# (PrimState m)) -> m ()
{-# INLINE primitive_ #-}
primitive_ f = primitive (\s# ->
case f s# of
s'# -> (# s'#, () #))
unsafePrimToPrim :: (PrimBase m1, PrimMonad m2) => m1 a -> m2 a
{-# INLINE unsafePrimToPrim #-}
unsafePrimToPrim m = primitive (unsafeCoerce# (internal m))
unsafeInlineIO :: IO a -> a
{-# INLINE unsafeInlineIO #-}
unsafeInlineIO m = case internal m realWorld# of (# _, r #) -> r
-----
-- Data.Primitive.Types
-----
class Prim a where
setOffAddr# :: Addr# -> Int# -> Int# -> a -> State# s -> State# s
instance Prim Word8 where
setOffAddr# addr# i# n# (W8# x#) s#
= let i = fromIntegral (I# i#)
n = fromIntegral (I# n#)
in
case unsafeCoerce# (internal (setWord8OffAddr# addr# i n x#)) s# of
(# s1#, _ #) -> s1#
-- foreign import ccall unsafe "memops.h memset_Word8"
setWord8OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word# -> IO ()
setWord8OffAddr# _ _ _ _ = pure ()
-----
-- Data.Vector.Fusion.Stream.Monadic
-----
data Step s a where
Yield :: a -> s -> Step s a
Skip :: s -> Step s a
Done :: Step s a
data Stream m a = forall s. Stream (s -> m (Step s a)) s
sfoldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
{-# INLINE sfoldl' #-}
sfoldl' f = sfoldlM' (\a b -> return (f a b))
sfoldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
{-# INLINE [1] sfoldlM' #-}
sfoldlM' m w (Stream step t) = foldlM'_loop SPEC w t
where
foldlM'_loop !_ z s
= z `seq`
do
r <- step s
case r of
Yield x s' -> do { z' <- m z x; foldlM'_loop SPEC z' s' }
Skip s' -> foldlM'_loop SPEC z s'
Done -> return z
-----
-- Data.Vector.Fusion.Util
-----
newtype Id a = Id { unId :: a }
instance Functor Id where
fmap f (Id x) = Id (f x)
instance Applicative Id where
pure = Id
Id f <*> Id x = Id (f x)
instance Monad Id where
return = pure
Id x >>= f = f x
data Box a = Box a
instance Functor Box where
fmap f (Box x) = Box (f x)
instance Applicative Box where
pure = Box
Box f <*> Box x = Box (f x)
instance Monad Box where
return = pure
Box x >>= f = f x
-----
-- Data.Vector.Fusion.Bundle
-----
type Bundle = MBundle Id
blength :: Bundle v a -> Int
{-# INLINE blength #-}
blength = unId . mblength
bfromVector :: GVector v a => v a -> Bundle v a
{-# INLINE bfromVector #-}
bfromVector = mbfromVector
-----
-- Data.Vector.Fusion.Bundle.Monadic
-----
data Chunk v a = Chunk Int (forall m. (PrimMonad m, GVector v a) => Mutable v (PrimState m) a -> m ())
data MBundle m v a = Bundle { sElems :: Stream m a
, sChunks :: Stream m (Chunk v a)
, sVector :: Maybe (v a)
, sSize :: Size
}
mblength :: Monad m => MBundle m v a -> m Int
{-# INLINE [1] mblength #-}
mblength Bundle{sSize = Exact n} = return n
mblength Bundle{sChunks = s} = sfoldl' (\n (Chunk k _) -> n+k) 0 s
mbfromVector :: (Monad m, GVector v a) => v a -> MBundle m v a
{-# INLINE [1] mbfromVector #-}
mbfromVector v = v `seq` n `seq` Bundle (Stream step 0)
(Stream vstep True)
(Just v)
(Exact n)
where
n = gbasicLength v
{-# INLINE step #-}
step i | i >= n = return Done
| otherwise = case gbasicUnsafeIndexM v i of
Box x -> return $ Yield x (i+1)
{-# INLINE vstep #-}
vstep True = return (Yield (Chunk (gbasicLength v) (\mv -> gbasicUnsafeCopy mv v)) False)
vstep False = return Done
-----
-- Data.Vector.Fusion.Bundle.Size
-----
data Size = Exact Int
| Max Int
| Unknown
-----
-- Data.Vector.Generic.Base
-----
type family Mutable (v :: * -> *) :: * -> * -> *
class GMVector (Mutable v) a => GVector v a where
gbasicUnsafeFreeze :: PrimMonad m => Mutable v (PrimState m) a -> m (v a)
gbasicLength :: v a -> Int
gbasicUnsafeIndexM :: Monad m => v a -> Int -> m a
gbasicUnsafeCopy :: PrimMonad m => Mutable v (PrimState m) a -> v a -> m ()
-----
-- Data.Vector.Generic.Mutable.Base
-----
class GMVector v a where
gmbasicUnsafeNew :: PrimMonad m => Int -> m (v (PrimState m) a)
gmbasicInitialize :: PrimMonad m => v (PrimState m) a -> m ()
gmbasicUnsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m ()
-----
-- Data.Vector.Generic
-----
glength :: GVector v a => v a -> Int
{-# INLINE glength #-}
glength = blength . stream'
gunsafeFreeze
:: (PrimMonad m, GVector v a) => Mutable v (PrimState m) a -> m (v a)
{-# INLINE gunsafeFreeze #-}
gunsafeFreeze = gbasicUnsafeFreeze
gunsafeIndex :: GVector v a => v a -> Int -> a
{-# INLINE [1] gunsafeIndex #-}
gunsafeIndex v i = {- UNSAFE_CHECK(checkIndex) "unsafeIndex" i (length v)
$ -} unId (gbasicUnsafeIndexM v i)
stream' :: GVector v a => v a -> Bundle v a
{-# INLINE stream' #-}
stream' v = bfromVector v
-----
-- Data.Vector.Generic.Mutable
-----
gmnew :: (PrimMonad m, GMVector v a) => Int -> m (v (PrimState m) a)
{-# INLINE gmnew #-}
gmnew n = {- BOUNDS_CHECK(checkLength) "new" n
$ -} gmunsafeNew n >>= \v -> gmbasicInitialize v >> return v
gmunsafeNew :: (PrimMonad m, GMVector v a) => Int -> m (v (PrimState m) a)
{-# INLINE gmunsafeNew #-}
gmunsafeNew n = {- UNSAFE_CHECK(checkLength) "unsafeNew" n
$ -} gmbasicUnsafeNew n
gmunsafeWrite :: (PrimMonad m, GMVector v a)
=> v (PrimState m) a -> Int -> a -> m ()
{-# INLINE gmunsafeWrite #-}
gmunsafeWrite v i x = {- UNSAFE_CHECK(checkIndex) "unsafeWrite" i (length v)
$ -} gmbasicUnsafeWrite v i x
gmwrite :: (PrimMonad m, GMVector v a) => v (PrimState m) a -> Int -> a -> m ()
{-# INLINE gmwrite #-}
gmwrite v i x = {- BOUNDS_CHECK(checkIndex) "write" i (length v)
$ -} gmunsafeWrite v i x
-----
-- Data.Vector.Storable
-----
data Vector a = Vector {-# UNPACK #-} !Int
{-# UNPACK #-} !(ForeignPtr a)
type instance Mutable Vector = MVector
instance Storable a => GVector Vector a where
{-# INLINE gbasicUnsafeFreeze #-}
gbasicUnsafeFreeze (MVector n fp) = return $ Vector n fp
{-# INLINE gbasicLength #-}
gbasicLength (Vector n _) = n
{-# INLINE gbasicUnsafeIndexM #-}
gbasicUnsafeIndexM (Vector _ fp) i = return
. unsafeInlineIO
$ withForeignPtr fp $ \p ->
peekElemOff p i
{-# INLINE gbasicUnsafeCopy #-}
gbasicUnsafeCopy (MVector n fp) (Vector _ fq)
= unsafePrimToPrim
$ withForeignPtr fp $ \p ->
withForeignPtr fq $ \q ->
copyArray p q n
vlength :: Storable a => Vector a -> Int
{-# INLINE vlength #-}
vlength = glength
unsafeFreeze
:: (Storable a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a)
{-# INLINE unsafeFreeze #-}
unsafeFreeze = gunsafeFreeze
unsafeIndex :: Storable a => Vector a -> Int -> a
{-# INLINE unsafeIndex #-}
unsafeIndex = gunsafeIndex
unsafeToForeignPtr :: Storable a => Vector a -> (ForeignPtr a, Int, Int)
{-# INLINE unsafeToForeignPtr #-}
unsafeToForeignPtr (Vector n fp) = (fp, 0, n)
-----
-- Data.Vector.Storable.Mutable
-----
data MVector s a = MVector {-# UNPACK #-} !Int
{-# UNPACK #-} !(ForeignPtr a)
instance Storable a => GMVector MVector a where
{-# INLINE gmbasicUnsafeNew #-}
gmbasicUnsafeNew n
| n < 0 = error $ "Storable.basicUnsafeNew: negative length: " ++ show n
| n > mx = error $ "Storable.basicUnsafeNew: length too large: " ++ show n
| otherwise = unsafePrimToPrim $ do
fp <- mallocVector n
return $ MVector n fp
where
size = sizeOf (undefined :: a) `max` 1
mx = maxBound `quot` size :: Int
{-# INLINE gmbasicInitialize #-}
gmbasicInitialize = storableZero
{-# INLINE gmbasicUnsafeWrite #-}
gmbasicUnsafeWrite (MVector _ fp) i x
= unsafePrimToPrim
$ withForeignPtr fp $ \p -> pokeElemOff p i x
new :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a)
{-# INLINE new #-}
new = gmnew
write
:: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m ()
{-# INLINE write #-}
write = gmwrite
{-# INLINE mallocVector #-}
mallocVector :: Storable a => Int -> IO (ForeignPtr a)
mallocVector =
doMalloc undefined
where
doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b)
doMalloc dummy size =
mallocPlainForeignPtrAlignedBytes (size * sizeOf dummy) (alignment dummy)
memsetPrimPtr_vector :: forall a c m. (Prim c, PrimMonad m) => Ptr a -> Int -> c -> m ()
memsetPrimPtr_vector (Ptr addr#) (I# n#) x = primitive_ (setOffAddr# addr# 0# n# x)
{-# INLINE memsetPrimPtr_vector #-}
storableZero :: forall a m. (Storable a, PrimMonad m) => MVector (PrimState m) a -> m ()
{-# INLINE storableZero #-}
storableZero (MVector n fp) = unsafePrimToPrim . withForeignPtr fp $ \ptr-> do
memsetPrimPtr_vector (castPtr ptr) byteSize (0 :: Word8)
where
x :: a
x = undefined
byteSize :: Int
byteSize = n * sizeOf x
-----
-- Codec.Picture.BitWriter
-----
defaultBufferSize :: Int
defaultBufferSize = 256 * 1024
data BoolWriteStateRef s = BoolWriteStateRef
{ bwsCurrBuffer :: STRef s (MVector s Word8)
, bwsBufferList :: STRef s [B.ByteString]
, bwsWrittenWords :: STRef s Int
, bwsBitAcc :: STRef s Word8
, bwsBitReaded :: STRef s Int
}
newWriteStateRef :: ST s (BoolWriteStateRef s)
newWriteStateRef = do
origMv <- new defaultBufferSize
BoolWriteStateRef <$> newSTRef origMv
<*> newSTRef []
<*> newSTRef 0
<*> newSTRef 0
<*> newSTRef 0
writeBitsGif :: BoolWriteStateRef s
-> Word32
-> Int
-> ST s ()
{-# INLINE writeBitsGif #-}
writeBitsGif st d c = do
currWord <- readSTRef $ bwsBitAcc st
currCount <- readSTRef $ bwsBitReaded st
serialize d c currWord currCount
where dumpByte = pushByte' st
serialize bitData bitCount currentWord count
| bitCount + count == 8 = do
resetBitCount' st
dumpByte (fromIntegral $ currentWord .|.
(fromIntegral cleanData `unsafeShiftL` count))
| bitCount + count < 8 =
let newVal = fromIntegral cleanData `unsafeShiftL` count
in setBitCount' st (newVal .|. currentWord) $ count + bitCount
| otherwise =
let leftBitCount = 8 - count :: Int
newData = cleanData `unsafeShiftR` leftBitCount :: Word32
newCount = bitCount - leftBitCount :: Int
toWrite = fromIntegral $ fromIntegral currentWord
.|. (cleanData `unsafeShiftL` count) :: Word8
in dumpByte toWrite >> serialize newData newCount 0 0
where cleanMask = (1 `unsafeShiftL` bitCount) - 1 :: Word32
cleanData = bitData .&. cleanMask :: Word32
finalizeBoolWriterGif :: BoolWriteStateRef s -> ST s L.ByteString
finalizeBoolWriterGif st = do
flushLeftBitsGif st
forceBufferFlushing' st
L.fromChunks <$> readSTRef (bwsBufferList st)
flushLeftBitsGif :: BoolWriteStateRef s -> ST s ()
flushLeftBitsGif st = do
currCount <- readSTRef $ bwsBitReaded st
when (currCount > 0) $ do
currWord <- readSTRef $ bwsBitAcc st
pushByte' st currWord
forceBufferFlushing' :: BoolWriteStateRef s -> ST s ()
forceBufferFlushing' (BoolWriteStateRef { bwsCurrBuffer = vecRef
, bwsWrittenWords = countRef
, bwsBufferList = lstRef
}) = do
vec <- readSTRef vecRef
count <- readSTRef countRef
lst <- readSTRef lstRef
nmv <- new defaultBufferSize
str <- byteStringFromVector vec count
writeSTRef vecRef nmv
writeSTRef lstRef $ lst ++ [str]
writeSTRef countRef 0
flushCurrentBuffer' :: BoolWriteStateRef s -> ST s ()
flushCurrentBuffer' st = do
count <- readSTRef $ bwsWrittenWords st
when (count >= defaultBufferSize)
(forceBufferFlushing' st)
byteStringFromVector :: MVector s Word8 -> Int -> ST s B.ByteString
byteStringFromVector vec size = do
frozen <- unsafeFreeze vec
return $ blitVector frozen 0 size
setBitCount' :: BoolWriteStateRef s -> Word8 -> Int -> ST s ()
{-# INLINE setBitCount' #-}
setBitCount' st acc count = do
writeSTRef (bwsBitAcc st) acc
writeSTRef (bwsBitReaded st) count
resetBitCount' :: BoolWriteStateRef s -> ST s ()
{-# INLINE resetBitCount' #-}
resetBitCount' st = setBitCount' st 0 0
pushByte' :: BoolWriteStateRef s -> Word8 -> ST s ()
{-# INLINE pushByte' #-}
pushByte' st v = do
flushCurrentBuffer' st
idx <- readSTRef (bwsWrittenWords st)
vec <- readSTRef (bwsCurrBuffer st)
write vec idx v
writeSTRef (bwsWrittenWords st) $ idx + 1
-----
-- Codec.Picture.VectorByteConversion
-----
blitVector :: Vector Word8 -> Int -> Int -> B.ByteString
blitVector vec atIndex = S.PS ptr (offset + atIndex)
where (ptr, offset, _length) = unsafeToForeignPtr vec
-----
type Trie = I.IntMap TrieNode
data TrieNode = TrieNode
{ trieIndex :: {-# UNPACK #-} !Int
, trieSub :: !Trie
}
emptyNode :: TrieNode
emptyNode = TrieNode
{ trieIndex = -1
, trieSub = mempty
}
initialTrie :: Trie
initialTrie = I.fromList
[(i, emptyNode { trieIndex = i }) | i <- [0 .. 255]]
lookupUpdate :: Vector Word8 -> Int -> Int -> Trie -> (Int, Int, Trie)
lookupUpdate vector freeIndex firstIndex trie =
matchUpdate $ go trie 0 firstIndex
where
matchUpdate (lzwOutputIndex, nextReadIndex, sub) =
(lzwOutputIndex, nextReadIndex, fromMaybe trie sub)
maxi = vlength vector
go !currentTrie !prevIndex !index
| index >= maxi = (prevIndex, index, Nothing)
| otherwise = case I.lookup val currentTrie of
Just (TrieNode ix subTable) ->
let (lzwOutputIndex, nextReadIndex, newTable) =
go subTable ix $ index + 1
tableUpdater t =
I.insert val (TrieNode ix t) currentTrie
in
(lzwOutputIndex, nextReadIndex, tableUpdater <$> newTable)
Nothing | index == maxi -> (prevIndex, index, Nothing)
| otherwise -> (prevIndex, index, Just $ I.insert val newNode currentTrie)
where val = fromIntegral $ vector `unsafeIndex` index
newNode = emptyNode { trieIndex = freeIndex }
lzwEncode :: Int -> Vector Word8 -> L.ByteString
lzwEncode initialKeySize vec = runST $ do
bitWriter <- newWriteStateRef
let updateCodeSize 12 writeIdx _
| writeIdx == 2 ^ (12 :: Int) - 1 = do
writeBitsGif bitWriter (fromIntegral clearCode) 12
return (startCodeSize, firstFreeIndex, initialTrie)
updateCodeSize codeSize writeIdx trie
| writeIdx == 2 ^ codeSize =
return (codeSize + 1, writeIdx + 1, trie)
| otherwise = return (codeSize, writeIdx + 1, trie)
go readIndex (codeSize, _, _) | readIndex >= maxi =
writeBitsGif bitWriter (fromIntegral endOfInfo) codeSize
go !readIndex (!codeSize, !writeIndex, !trie) = do
let (indexToWrite, endIndex, trie') =
lookuper writeIndex readIndex trie
writeBitsGif bitWriter (fromIntegral indexToWrite) codeSize
updateCodeSize codeSize writeIndex trie'
>>= go endIndex
writeBitsGif bitWriter (fromIntegral clearCode) startCodeSize
go 0 (startCodeSize, firstFreeIndex, initialTrie)
finalizeBoolWriterGif bitWriter
where
maxi = vlength vec
startCodeSize = initialKeySize + 1
clearCode = 2 ^ initialKeySize :: Int
endOfInfo = clearCode + 1
firstFreeIndex = endOfInfo + 1
lookuper = lookupUpdate vec
$ ~/Software/ghc5/inplace/bin/ghc-stage2 -fforce-recomp -O2 -dcore-lint Bug.hs
[1 of 1] Compiling Codec.Picture.Gif.Internal.LZWEncoding ( Bug.hs, Bug.o )
*** Core Lint errors : in result of Simplifier ***
Bug.hs:585:5: warning:
Argument value doesn't match argument type:
Fun type: Word# -> Word#
Arg type: Int#
Arg: 0#
In the RHS of $wlzwEncode_s83B :: Int#
-> Vector Word8 -> ByteString
In the body of lambda with binder ww_s83z :: Int#
In the body of lambda with binder w_s83w :: Vector Word8
In the body of lambda with binder s_a4Yp :: State# RealWorld
In a case alternative: (UnsafeRefl v2_a51H :: (State#
(PrimState IO)
-> (# State# (PrimState IO),
MVector
(PrimState (ST RealWorld)) Word8 #))
~# (State# (PrimState (ST RealWorld))
-> (# State# (PrimState (ST RealWorld)),
MVector
(PrimState (ST RealWorld)) Word8 #)))
In a case alternative: ((#,#) ipv_a5hp :: State# RealWorld,
ipv1_a5hq :: MutableByteArray# RealWorld)
In a case alternative: (UnsafeRefl co_a5ht :: ByteArray#
~# MutableByteArray# RealWorld)
In a case alternative: (UnsafeRefl v2_Xa :: (State# (PrimState IO)
-> (# State# (PrimState IO), () #))
~# (State# (PrimState (ST RealWorld))
-> (# State# (PrimState (ST RealWorld)), () #)))
In a case alternative: (UnsafeRefl v2_Xc :: (State# RealWorld
-> (# State# RealWorld, () #))
~# (State# (PrimState IO)
-> (# State# (PrimState IO), Any #)))
In the body of letrec with binders dt_a3Q1 :: ForeignPtrContents
In a case alternative: ((#,#) ipv_a5pZ :: State# RealWorld,
ipv1_a5q0 :: MutVar# RealWorld (MVector RealWorld Word8))
In a case alternative: ((#,#) ipv_Xe :: State# RealWorld,
ipv1_Xf :: MutVar# RealWorld [ByteString])
In a case alternative: ((#,#) ipv_Xh :: State# RealWorld,
ipv1_Xi :: MutVar# RealWorld Int)
In a case alternative: ((#,#) ipv_Xk :: State# RealWorld,
ipv1_Xl :: MutVar# RealWorld Word8)
In a case alternative: ((#,#) ipv_Xo :: State# RealWorld,
ipv1_Xp :: MutVar# RealWorld Int)
In a case alternative: ((#,#) ipv_Xt :: State# RealWorld,
ipv1_Xu :: Word8)
In a case alternative: ((#,#) ipv_Xw :: State# RealWorld,
ipv1_Xx :: Int)
In a case alternative: (I# ww_s83s :: Int#)
In the body of letrec with binders clearCode_s64x :: Int
In the body of letrec with binders lvl_s8uR :: Word32
In the body of letrec with binders startCodeSize_s87p :: Int#
In the body of lambda with binder w_s83e :: State# RealWorld
In the body of letrec with binders endOfInfo_s64w :: Int
In the body of letrec with binders firstFreeIndex_s64v :: Int
In the body of letrec with binders exit_Xy :: Int#
-> State# RealWorld -> ByteString
In the RHS of $s$wgo_s96T :: State# RealWorld
-> IntMap TrieNode -> Int# -> Int# -> Int# -> ByteString
In the body of lambda with binder sc_s96D :: State# RealWorld
In the body of lambda with binder sc_s96C :: IntMap TrieNode
In the body of lambda with binder sc_s96B :: Int#
In the body of lambda with binder sc_s96A :: Int#
In the body of lambda with binder sc_s96z :: Int#
In a case alternative: (Vector ipv_s71L :: Int#,
ipv_s71M :: Addr#,
ipv_s71N :: ForeignPtrContents)
In a case alternative: ((#,#) ipv_XG :: State# RealWorld,
ipv1_XH :: Word8)
In a case alternative: ((#,#) ipv_XJ :: State# RealWorld,
ipv1_XK :: Int)
In a case alternative: (I# ww_s824 :: Int#)
In the body of letrec with binders ds_s64F :: (Int, Int, Trie)
In the body of lambda with binder ipv_XN :: State# RealWorld
In the body of lambda with binder ipv1_XO :: ()
In the body of letrec with binders fail_s64H :: (# #) -> ByteString
In a case alternative: (I# x_a5sF :: Int#)
In a case alternative: ((#,#) ipv_XR :: State# RealWorld,
ipv1_XS :: Word8)
In a case alternative: ((#,#) ipv_XU :: State# RealWorld,
ipv1_XV :: Int)
In a case alternative: (I# ww_s82F :: Int#)
In the body of letrec with binders $sexit_s97L :: State# RealWorld
-> Int#
-> Word#
-> Int#
-> Word#
-> ByteString
In a case alternative: ((#,#) ipv_X17 :: State# RealWorld,
ipv1_X18 :: Int)
In a case alternative: (I# x_X1a :: Int#)
In a case alternative: ((#,#) ipv_Xm :: State# RealWorld,
ipv1_X1c :: Int)
In a case alternative: ((#,#) ipv_X1e :: State# RealWorld,
ipv1_X1f :: MVector RealWorld Word8)
In a case alternative: (MVector dt_d58W :: Int#,
dt_d58X :: Addr#,
dt_d58Y :: ForeignPtrContents)
In a case alternative: (I# i_a5ra :: Int#)
In a case alternative: (W8# x#_a5AT :: Word#)
In a case alternative: (W32# x#_a5s2 :: Word#)
Substitution: [TCvSubst
In scope: InScope {v2_Xa v2_Xc v2_a51H co_a5ht}
Type env: []
Co env: [Xa :-> v2_Xa, Xc :-> v2_Xc, a51H :-> v2_a51H,
a5ht :-> co_a5ht]]
*** Offending Program ***
<elided due to length>
*** End of Offense ***This is a regression from GHC 8.10.2, which does not produce this error.