Make BinIface warning-free

[ghc-hetmet.git] / compiler / iface / BinIface.hs

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 34c5377..321eac1 100644 (file)
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -1,9 +1,3 @@
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
 
 -- 
 --  (c) The University of Glasgow 2002-2006
@@ -32,11 +26,9 @@ import UniqFM
 import UniqSupply
 import CostCentre
 import StaticFlags
-import PackageConfig
 import Panic
 import Binary
 import SrcLoc
-import Util
 import ErrUtils
 import Config
 import FastMutInt
@@ -79,6 +71,13 @@ readBinIface_ checkHiWay traceBinIFaceReading hi_path nc = do
           = printer (text what <> text ": " <>
                      vcat [text "Wanted " <> ppr wanted <> text ",",
                            text "got    " <> ppr got])
+      errorOnMismatch :: (Eq a, Show a) => String -> a -> a -> IO ()
+      errorOnMismatch what wanted got
+            -- This will be caught by readIface which will emit an error
+            -- msg containing the iface module name.
+          = when (wanted /= got) $ throwDyn $ ProgramError
+                        (what ++ " (wanted " ++ show wanted
+                              ++ ", got "    ++ show got ++ ")")
   bh <- Binary.readBinMem hi_path
 
         -- Read the magic number to check that this really is a GHC .hi file
@@ -86,9 +85,8 @@ readBinIface_ checkHiWay traceBinIFaceReading hi_path nc = do
         --  GHC interface file format)
   magic <- get bh
   wantedGot "Magic" binaryInterfaceMagic magic
-  when (magic /= binaryInterfaceMagic) $
-        throwDyn (ProgramError (
-           "magic number mismatch: old/corrupt interface file?"))
+  errorOnMismatch "magic number mismatch: old/corrupt interface file?"
+      binaryInterfaceMagic magic
 
         -- Get the dictionary pointer.  We won't attempt to actually
         -- read the dictionary until we've done the version checks below,
@@ -101,22 +99,13 @@ readBinIface_ checkHiWay traceBinIFaceReading hi_path nc = do
   check_ver  <- get bh
   let our_ver = show opt_HiVersion
   wantedGot "Version" our_ver check_ver
-  when (check_ver /= our_ver) $
-        -- This will be caught by readIface which will emit an error
-        -- msg containing the iface module name.
-    throwDyn (ProgramError (
-        "mismatched interface file versions: expected "
-        ++ our_ver ++ ", found " ++ check_ver))
+  errorOnMismatch "mismatched interface file versions" our_ver check_ver
 
   check_way <- get bh
   way_descr <- getWayDescr
   wantedGot "Way" way_descr check_way
-  when (checkHiWay == CheckHiWay && check_way /= way_descr) $
-        -- This will be caught by readIface
-        -- which will emit an error msg containing the iface module name.
-     throwDyn (ProgramError (
-        "mismatched interface file ways: expected "
-        ++ way_descr ++ ", found " ++ check_way))
+  when (checkHiWay == CheckHiWay) $
+       errorOnMismatch "mismatched interface file ways" way_descr check_way
 
         -- Read the dictionary
         -- The next word in the file is a pointer to where the dictionary is
@@ -196,15 +185,17 @@ writeBinIface dflags hi_path mod_iface = do
        -- And send the result to the file
   writeBinMem bh hi_path
 
-initBinMemSize       = (1024*1024) :: Int
+initBinMemSize :: Int
+initBinMemSize = 1024 * 1024
 
 -- The *host* architecture version:
 #include "MachDeps.h"
 
+binaryInterfaceMagic :: Word32
 #if   WORD_SIZE_IN_BITS == 32
-binaryInterfaceMagic = 0x1face :: Word32
+binaryInterfaceMagic = 0x1face
 #elif WORD_SIZE_IN_BITS == 64
-binaryInterfaceMagic = 0x1face64 :: Word32
+binaryInterfaceMagic = 0x1face64
 #endif
   
 -- -----------------------------------------------------------------------------
@@ -234,7 +225,7 @@ fromOnDiskName
    -> NameCache
    -> OnDiskName
    -> (NameCache, Name)
-fromOnDiskName arr nc (pid, mod_name, occ) =
+fromOnDiskName _ nc (pid, mod_name, occ) =
   let 
         mod   = mkModule pid mod_name
         cache = nsNames nc
@@ -253,7 +244,7 @@ fromOnDiskName arr nc (pid, mod_name, occ) =
         }
 
 serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
-serialiseName bh name symtab = do
+serialiseName bh name _ = do
   let mod = nameModule name
   put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
 
@@ -865,6 +856,7 @@ instance Binary IfacePredType where
              2 -> do ac <- get bh
                      ad <- get bh
                      return (IfaceEqPred ac ad)
+             _ -> panic ("get IfacePredType " ++ show h)
 
 -------------------------------------------------------------------------
 --             IfaceExpr and friends
@@ -965,6 +957,7 @@ instance Binary IfaceExpr where
               12 -> do m <- get bh
                        ix <- get bh
                        return (IfaceTick m ix)
+              _ -> panic ("get IfaceExpr " ++ show h)
 
 instance Binary IfaceConAlt where
     put_ bh IfaceDefault = do
@@ -1071,6 +1064,7 @@ instance Binary IfaceNote where
              3 -> do return IfaceInlineMe
               4 -> do ac <- get bh
                       return (IfaceCoreNote ac)
+              _ -> panic ("get IfaceNote " ++ show h)
 
 -------------------------------------------------------------------------
 --             IfaceDecl and friends
@@ -1088,7 +1082,7 @@ instance Binary IfaceDecl where
            put_ bh (occNameFS name)
            put_ bh ty
            put_ bh idinfo
-    put_ bh (IfaceForeign ae af) = 
+    put_ _ (IfaceForeign _ _) = 
        error "Binary.put_(IfaceDecl): IfaceForeign"
     put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8) = do
            putByte bh 2
@@ -1188,6 +1182,7 @@ instance Binary OverlapFlag where
                  0 -> return NoOverlap
                  1 -> return OverlapOk
                  2 -> return Incoherent
+                 _ -> panic ("get OverlapFlag " ++ show h)
 
 instance Binary IfaceConDecls where
     put_ bh IfAbstractTyCon = putByte bh 0