= 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