+{-# 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
--
-- 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) <- ioToIOEnv $ 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_fam_insts = fam_insts,
mi_rules = rules,
mi_rule_vers = rule_vers,
- mi_vect_info = vect_info }) = do
+ mi_vect_info = vect_info,
+ mi_hpc = hpc_info }) = do
put_ bh mod
put_ bh is_boot
put_ bh mod_vers
lazyPut bh rules
put_ bh rule_vers
put_ bh vect_info
+ put_ bh hpc_info
get bh = do
mod_name <- get bh
rules <- {-# SCC "bin_rules" #-} lazyGet bh
rule_vers <- get bh
vect_info <- get bh
+ hpc_info <- get bh
return (ModIface {
mi_module = mod_name,
mi_boot = is_boot,
mi_rules = rules,
mi_rule_vers = rule_vers,
mi_vect_info = vect_info,
+ mi_hpc = hpc_info,
-- And build the cached values
mi_dep_fn = mkIfaceDepCache deprecs,
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
usg_exports = exps, usg_entities = ents,
usg_rules = rules })
-instance Binary a => Binary (Deprecs a) where
+instance Binary Deprecations where
put_ bh NoDeprecs = putByte bh 0
put_ bh (DeprecAll t) = do
putByte bh 1