import IfaceSyn
import Module
import Name
-import OccName
import VarEnv
-import InstEnv
import Class
import DynFlags
import UniqFM
readBinIface :: CheckHiWay -> TraceBinIFaceReading -> FilePath
-> TcRnIf a b ModIface
readBinIface checkHiWay traceBinIFaceReading hi_path = do
- nc <- getNameCache
- (new_nc, iface) <- liftIO $
- readBinIface_ checkHiWay traceBinIFaceReading hi_path nc
- setNameCache new_nc
- return iface
+ update_nc <- mkNameCacheUpdater
+ liftIO $ readBinIface_ checkHiWay traceBinIFaceReading hi_path update_nc
-readBinIface_ :: CheckHiWay -> TraceBinIFaceReading -> FilePath -> NameCache
- -> IO (NameCache, ModIface)
-readBinIface_ checkHiWay traceBinIFaceReading hi_path nc = do
+readBinIface_ :: CheckHiWay -> TraceBinIFaceReading -> FilePath
+ -> NameCacheUpdater (Array Int Name)
+ -> IO ModIface
+readBinIface_ checkHiWay traceBinIFaceReading hi_path update_nc = do
let printer :: SDoc -> IO ()
printer = case traceBinIFaceReading of
TraceBinIFaceReading -> \sd -> printSDoc sd defaultDumpStyle
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
+ symtab <- getSymbolTable bh update_nc
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
- return (nc', iface)
+ return iface
writeBinIface :: DynFlags -> FilePath -> ModIface -> IO ()
-- The version and way descriptor go next
put_ bh (show opt_HiVersion)
way_descr <- getWayDescr
- put bh way_descr
+ put_ bh way_descr
-- Remember where the symbol table pointer will go
symtab_p_p <- tellBin bh
initBinMemSize = 1024 * 1024
-- The *host* architecture version:
-#include "MachDeps.h"
+#include "../includes/MachDeps.h"
binaryInterfaceMagic :: Word32
#if WORD_SIZE_IN_BITS == 32
let names = elems (array (0,next_off-1) (eltsUFM symtab))
mapM_ (\n -> serialiseName bh n symtab) names
-getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, Array Int Name)
-getSymbolTable bh namecache = do
+getSymbolTable :: BinHandle -> NameCacheUpdater (Array Int Name)
+ -> IO (Array Int Name)
+getSymbolTable bh update_namecache = do
sz <- get bh
od_names <- sequence (replicate sz (get bh))
- let
+ update_namecache $ \namecache ->
+ let
arr = listArray (0,sz-1) names
(namecache', names) =
mapAccumR (fromOnDiskName arr) namecache od_names
- --
- return (namecache', arr)
+ in (namecache', arr)
type OnDiskName = (PackageId, ModuleName, OccName)
instance Binary DmdType where
-- Ignore DmdEnv when spitting out the DmdType
- put bh (DmdType _ ds dr) = do p <- put bh ds; put bh dr; return (castBin p)
+ put bh (DmdType _ ds dr) = do p <- put bh ds; put_ bh dr; return (castBin p)
get bh = do ds <- get bh; dr <- get bh; return (DmdType emptyVarEnv ds dr)
instance Binary Demand where