trim Data.Sequence import, in preparation for expanding its API

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

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 72a62a6..f09ce4f 100644 (file)
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -22,9 +22,7 @@ import Annotations
 import IfaceSyn
 import Module
 import Name
-import OccName
 import VarEnv
-import InstEnv
 import Class
 import DynFlags
 import UniqFM
@@ -59,15 +57,14 @@ data TraceBinIFaceReading = TraceBinIFaceReading | QuietBinIFaceReading
 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
-
-readBinIface_ :: CheckHiWay -> TraceBinIFaceReading -> FilePath -> NameCache
-              -> IO (NameCache, ModIface)
-readBinIface_ checkHiWay traceBinIFaceReading hi_path nc = do
+  update_nc <- mkNameCacheUpdater
+  dflags <- getDOpts
+  liftIO $ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path update_nc
+
+readBinIface_ :: DynFlags -> CheckHiWay -> TraceBinIFaceReading -> FilePath
+              -> NameCacheUpdater (Array Int Name)
+              -> IO ModIface
+readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path update_nc = do
   let printer :: SDoc -> IO ()
       printer = case traceBinIFaceReading of
                 TraceBinIFaceReading -> \sd -> printSDoc sd defaultDumpStyle
@@ -109,7 +106,7 @@ readBinIface_ checkHiWay traceBinIFaceReading hi_path nc = do
   errorOnMismatch "mismatched interface file versions" our_ver check_ver
 
   check_way <- get bh
-  way_descr <- getWayDescr
+  let way_descr = getWayDescr dflags
   wantedGot "Way" way_descr check_way
   when (checkHiWay == CheckHiWay) $
        errorOnMismatch "mismatched interface file ways" way_descr check_way
@@ -129,12 +126,12 @@ readBinIface_ checkHiWay traceBinIFaceReading hi_path nc = do
   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 ()
@@ -148,7 +145,7 @@ writeBinIface dflags hi_path mod_iface = do
 
         -- The version and way descriptor go next
   put_ bh (show opt_HiVersion)
-  way_descr <- getWayDescr
+  let way_descr = getWayDescr dflags
   put_  bh way_descr
 
         -- Remember where the symbol table pointer will go
@@ -208,7 +205,7 @@ initBinMemSize :: Int
 initBinMemSize = 1024 * 1024
 
 -- The *host* architecture version:
-#include "MachDeps.h"
+#include "../includes/MachDeps.h"
 
 binaryInterfaceMagic :: Word32
 #if   WORD_SIZE_IN_BITS == 32
@@ -226,16 +223,17 @@ putSymbolTable bh next_off symtab = do
   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)
 
@@ -451,10 +449,11 @@ instance Binary ModIface where
                 mi_fix_fn    = mkIfaceFixCache fixities,
                 mi_hash_fn   = mkIfaceHashCache decls })
 
-getWayDescr :: IO String
-getWayDescr = do
-  tag <- readIORef v_Build_tag
-  if cGhcUnregisterised == "YES" then return ('u':tag) else return tag
+getWayDescr :: DynFlags -> String
+getWayDescr dflags
+  | cGhcUnregisterised == "YES" = 'u':tag
+  | otherwise                   = tag
+  where tag = buildTag dflags
        -- if this is an unregisterised build, make sure our interfaces
        -- can't be used by a registerised build.