X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FBinIface.hs;h=26613267c1397441459ece76403461100454cf92;hb=cadba81047f6188fad2fe07004c3cb36316c36d1;hp=15cefe8cdfceb724f2271db93739a2a735f18c39;hpb=a2a67cd520b9841114d69a87a423dabcb3b4368e;p=ghc-hetmet.git diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 15cefe8..2661326 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -57,15 +57,13 @@ 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 + 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 @@ -127,12 +125,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 () @@ -224,16 +222,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)