--
-- Binary interface file support.
-module BinIface ( writeBinIface, readBinIface, v_IgnoreHiWay ) where
+module BinIface ( writeBinIface, readBinIface, CheckHiWay(..) ) where
#include "HsVersions.h"
import Control.Exception
import Control.Monad
+data CheckHiWay = CheckHiWay | IgnoreHiWay
+ deriving Eq
+
-- ---------------------------------------------------------------------------
-- Reading and writing binary interface files
-readBinIface :: FilePath -> TcRnIf a b ModIface
-readBinIface hi_path = do
+readBinIface :: CheckHiWay -> FilePath -> TcRnIf a b ModIface
+readBinIface checkHiWay hi_path = do
nc <- getNameCache
- (new_nc, iface) <- liftIO $ readBinIface_ hi_path nc
+ (new_nc, iface) <- liftIO $ readBinIface_ checkHiWay hi_path nc
setNameCache new_nc
return iface
-readBinIface_ :: FilePath -> NameCache -> IO (NameCache, ModIface)
-readBinIface_ hi_path nc = do
+readBinIface_ :: CheckHiWay -> FilePath -> NameCache
+ -> IO (NameCache, ModIface)
+readBinIface_ checkHiWay hi_path nc = do
bh <- Binary.readBinMem hi_path
-- Read the magic number to check that this really is a GHC .hi file
++ our_ver ++ ", found " ++ check_ver))
check_way <- get bh
- ignore_way <- readIORef v_IgnoreHiWay
way_descr <- getWayDescr
- when (not ignore_way && check_way /= way_descr) $
+ 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 (
mi_fix_fn = mkIfaceFixCache fixities,
mi_ver_fn = mkIfaceVerCache decls })
-GLOBAL_VAR(v_IgnoreHiWay, False, Bool)
-
getWayDescr :: IO String
getWayDescr = do
tag <- readIORef v_Build_tag
readIface wanted_mod file_path is_hi_boot_file
= do { dflags <- getDOpts
- ; res <- tryMostM $ readBinIface file_path
+ ; res <- tryMostM $ readBinIface CheckHiWay file_path
; case res of
Right iface
| wanted_mod == actual_mod -> return (Succeeded iface)
-- | Read binary interface, and print it out
showIface :: HscEnv -> FilePath -> IO ()
showIface hsc_env filename = do
- -- skip the version check; we don't want to worry about profiled vs.
+ -- skip the hi way check; we don't want to worry about profiled vs.
-- non-profiled interfaces, for example.
- writeIORef v_IgnoreHiWay True
- iface <- initTcRnIf 's' hsc_env () () $ readBinIface filename
+ iface <- initTcRnIf 's' hsc_env () () $ readBinIface IgnoreHiWay filename
printDump (pprModIface iface)
\end{code}
= vcat [ ptext SLIT("interface")
<+> ppr (mi_module iface) <+> pp_boot
<+> ppr (mi_mod_vers iface) <+> pp_sub_vers
+ <+> ppr (mi_mod_vers iface)
<+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty)
<+> (if mi_finsts iface then ptext SLIT("[family instance module]") else empty)
<+> (if mi_hpc iface then ptext SLIT("[hpc]") else empty)