Cleanup

Author: angerman

src/Data/BitCode/Abbreviation.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 module Data.BitCode.Abbreviation
   ( addAbbrev, lookupAbbrev
   , addGlobalAbbrev, lookupGlobalAbbrev
@@ -8,7 +9,7 @@ where
 
 import Data.BitCode
 import Data.Maybe (fromMaybe)
-import Data.Semigroup
+import Data.Semigroup (Semigroup, (<>))
 
 newtype AbbrevMap = AbbrevMap [(Code, BitCode)] deriving Show
 newtype GlobalAbbrevMap = GlobalAbbrevMap [(BlockId, AbbrevMap)] deriving Show
@@ -34,14 +35,14 @@ addGlobalAbbrev :: GlobalAbbrevMap -> BlockId -> BitCode -> GlobalAbbrevMap
 addGlobalAbbrev (GlobalAbbrevMap g) blockId block = GlobalAbbrevMap g'
   where g' = go g blockId block
         go :: [(BlockId, AbbrevMap)] -> BlockId -> BitCode -> [(BlockId, AbbrevMap)]
-        go [] id b = [(blockId, addAbbrev mempty block)]
+        go [] _id _b = [(blockId, addAbbrev mempty block)]
         go (gb@(id', bs):g') id block | id == id' = (id, addAbbrev bs block):go g' id block
                                       | otherwise = gb:go g' id block
 
 lookupAbbrev :: AbbrevMap -> Code -> Maybe BitCode
 lookupAbbrev (AbbrevMap m) = flip lookup m
 
 addAbbrev :: AbbrevMap -> BitCode -> AbbrevMap
-addAbbrev (AbbrevMap m) r@(DefAbbrevRecord ops) = AbbrevMap $ (nextId,r):m
+addAbbrev (AbbrevMap m) r@DefAbbrevRecord{} = AbbrevMap $ (nextId,r):m
   where nextId = 1 + foldr max 3 (map fst m)
-
+addAbbrev _ r = error $ "invalid Bitcode, expected DefAbbrevRecord: " ++ show r

src/Data/BitCode/Reader/FromBits.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE TupleSections     #-}
 {-# LANGUAGE LambdaCase        #-}
+{-# OPTIONS_GHC #-}
 module Data.BitCode.Reader.FromBits where
 
 import Prelude hiding (fromEnum, toEnum)
@@ -80,7 +81,7 @@ parseBlock n abbrevs = parseLocated (parseSubBlock n <|> parseUnabbrevRecord n <
                           go id (Located _ r:bs) = go id (r:bs) -- ignore Located blocks, and just recurse to the contained block.
                           go _ ((UnabbrevRecord 1 [id]):bs) = go (fromIntegral id) bs
                           go id (r@(DefAbbrevRecord _):bs) = tellGlobalAbbrev id r >> go id bs
-                          go id (b:bs) = fail $ "*** Can not handle block: " ++ show b
+                          go _ (b:_) = fail $ "*** Can not handle block: " ++ show b
         parseUnabbrevRecord :: Int -> BitCodeReader BitCode
         parseUnabbrevRecord width = do
           readFixed width (fromEnum UNABBREV_RECORD)

src/Data/BitCode/Reader/Monad.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns, CPP #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-top-binds -fno-warn-unused-matches #-}
 module Data.BitCode.Reader.Monad
   ( BitCodeReader
   , evalBitCodeReader
@@ -11,19 +12,14 @@ module Data.BitCode.Reader.Monad
   where
 
 import Prelude hiding (read, readFile)
-import Data.Semigroup
+import Data.Semigroup (Semigroup, (<>))
 -- Utility
 import Data.Bits (FiniteBits, setBit, zeroBits)
 -- reading from file
 import qualified Data.ByteString as B (readFile,unpack)
 import Data.Word (Word8)
 import Data.Bits (testBit)
--- abbrev map
-import Data.Maybe (fromMaybe)
 -- for Pretty printing
-import qualified Text.PrettyPrint as PP
-import Data.ByteString (pack)
-import Data.ByteString.Char8 (unpack)
 
 import Control.Monad (MonadPlus(..))
 import Control.Applicative (Alternative(..))
@@ -89,7 +85,7 @@ instance Monad BitCodeReader where
 -- * MonadPlus
 instance MonadPlus BitCodeReader where
   mzero = BitCode $ \b -> PairS (Left "") b
-  m `mplus` n = BitCode $ \b -> let PairS a b' = runBitCodeReader m b
+  m `mplus` n = BitCode $ \b -> let PairS _ b' = runBitCodeReader m b
                                 in runBitCodeReader n b'
 
 -- * Alternative

src/Data/BitCode/Writer/Monad.hs

@@ -1,4 +1,5 @@
 {-# OPTIONS_GHC -fprof-auto #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-top-binds -fno-warn-unused-matches #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, KindSignatures, BinaryLiterals, RecursiveDo, LambdaCase, RankNTypes, FlexibleContexts, BangPatterns #-}
 module Data.BitCode.Writer.Monad
   ( nullBuff, addBuff, mkBuff
@@ -45,15 +46,14 @@ import Control.Monad.Fix
 
 import GHC.Stack (HasCallStack)
 
-import Debug.Trace
-
 -- | The position in the stream.
 type Position = Int
 
 bSize :: Int
 -- ensure the order is correct
 bToOrder :: BType -> BType
 bPut :: BType -> Put
+bToWord8 :: BType -> [Word8]
 
 -- Word64
 type BType = Word64
@@ -206,8 +206,6 @@ toListStream (S w b p) = S (toList w) b p
 runStreams :: Streams Seq a -> Stream Seq a
 runStreams (Streams ss _) = foldl' mappend mempty ss
 
-{-# SPECIALIZE runStreams :: Streams Seq a -> Stream Seq a #-}
-
 -- So we have Streams, which are Sequences of Stream.
 -- S0 # # # # # # # # # # # # # # # # # # # +
 -- S1 # # # # #
@@ -223,6 +221,7 @@ fs b (x:xs) = let !(S w b'@(Buff n _) _) = b <> x in
 
 data BitstreamState = BitstreamState !SeqStreams !Position deriving Show
 
+bssPosition :: BitstreamState -> Position
 bssPosition (BitstreamState _ p) = p
 
 newtype Bitstream a = Bitstream { unBitstream :: State BitstreamState a }
@@ -367,8 +366,6 @@ emitVBR_slow !n !w =do
        then emitBit False
        else emitBit True >> emitVBR n tail
 
-  where logBase2 x = finiteBitSize x - 1 - countLeadingZeros x
-
 emitChar6 :: HasCallStack => Char -> Bitstream ()
 emitChar6 '_' = emitBits 6 63
 emitChar6 '.' = emitBits 6 62
@@ -390,7 +387,7 @@ alignWord32 = flip mod 32 <$> loc >>= \case
   x | 32 - x < 8  -> emitBits (32 - x) 0
   x | 32 - x < 16 -> emitWord8 0 >> emitBits (24 - x) 0
   x | 32 - x < 24 -> emitWord8 0 >> emitWord8 0 >> emitBits (16 - x) 0
-  x | 32 - x < 32 -> emitWord8 0 >> emitWord8 0 >> emitWord8 0 >> emitBits (8 - x) 0
+    | otherwise   -> emitWord8 0 >> emitWord8 0 >> emitWord8 0 >> emitBits (8 - x) 0
 
 writeFile
   :: HasCallStack

src/Data/BitCode/Writer/ToBits.hs

@@ -1,4 +1,5 @@
 {-# OPTIONS_GHC -fprof-auto #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-top-binds -fno-warn-unused-matches #-}
 {-# LANGUAGE TupleSections, RecursiveDo, FlexibleInstances #-}
 module Data.BitCode.Writer.ToBits
   (module Data.BitCode.Writer.Monad