Refactor some code a bit, and improve an error

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

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index d2c4083..1a4e788 100644 (file)
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -79,62 +79,59 @@ 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
-       -- (This magic number does not change when we change 
-       --  GHC interface file format)
+        -- Read the magic number to check that this really is a GHC .hi file
+        -- (This magic number does not change when we change
+        --  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,
         -- just in case this isn't a valid interface.  In retrospect the
         -- version should have come before the dictionary pointer, but this
         -- is the way it was done originally, and we can't change it now.
-  dict_p <- Binary.get bh      -- Get the dictionary ptr
+  dict_p <- Binary.get bh       -- Get the dictionary ptr
 
         -- Check the interface file version and ways.
   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))
-
-       -- Read the dictionary
-       -- The next word in the file is a pointer to where the dictionary is
-       -- (probably at the end of the file)
-  data_p <- tellBin bh         -- Remember where we are now
+  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
+        -- (probably at the end of the file)
+  data_p <- tellBin bh          -- Remember where we are now
   seekBin bh dict_p
   dict <- getDictionary bh
-  seekBin bh data_p            -- Back to where we were before
+  seekBin bh data_p             -- Back to where we were before
 
-       -- Initialise the user-data field of bh
+        -- Initialise the user-data field of bh
   ud <- newReadState dict
   bh <- return (setUserData bh ud)
-       
-  symtab_p <- Binary.get bh    -- Get the symtab ptr
-  data_p <- tellBin bh         -- Remember where we are now
+        
+  symtab_p <- Binary.get bh     -- Get the symtab ptr
+  data_p <- tellBin bh          -- Remember where we are now
   seekBin bh symtab_p
   (nc', symtab) <- getSymbolTable bh nc
-  seekBin bh data_p            -- Back to where we were before
+  seekBin bh data_p             -- Back to where we were before
   let ud = getUserData bh
   bh <- return $! setUserData bh ud{ud_symtab = symtab}
   iface <- get bh