aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Haddock/InterfaceFile.hs20
-rw-r--r--src/Main.hs8
2 files changed, 16 insertions, 12 deletions
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index 93d6fe4c..92dc371b 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -115,9 +115,9 @@ writeInterfaceFile filename iface = do
writeBinMem bh filename
return ()
-
-readInterfaceFile :: FilePath -> IO (Either String InterfaceFile)
-readInterfaceFile filename = do
+
+readInterfaceFile :: Session -> FilePath -> IO (Either String InterfaceFile)
+readInterfaceFile session filename = do
bh <- readBinMem filename
magic <- get bh
@@ -140,17 +140,21 @@ readInterfaceFile filename = do
-- initialise the user-data field of bh
ud <- newReadState dict
bh <- return (setUserData bh ud)
-
+
+ -- get the name cache from the ghc session
+ ncRef <- withSession session (return . hsc_NC)
+ nc <- readIORef ncRef
+
-- get the symbol table
symtab_p <- get bh
data_p <- tellBin bh
seekBin bh symtab_p
- -- (construct an empty name cache)
- u <- mkSplitUniqSupply 'a' -- ??
- let nc = initNameCache u []
- (_, symtab) <- getSymbolTable bh nc
+ (nc', symtab) <- getSymbolTable bh nc
seekBin bh data_p
+ -- write back the new name cache
+ writeIORef ncRef nc'
+
-- set the symbol table
let ud = getUserData bh
bh <- return $! setUserData bh ud{ud_symtab = symtab}
diff --git a/src/Main.hs b/src/Main.hs
index 18001c85..e89f41ed 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -107,7 +107,7 @@ main = handleTopExceptions $ do
(session, dynflags) <- startGhc libDir (ghcFlags flags)
-- get packages via --read-interface
- packages <- readInterfaceFiles (ifacePairs flags)
+ packages <- readInterfaceFiles session (ifacePairs flags)
-- typecheck argument modules using GHC
modules <- typecheckFiles session fileArgs
@@ -212,14 +212,14 @@ render flags interfaces = do
-------------------------------------------------------------------------------
-readInterfaceFiles :: [(FilePath, FilePath)] -> IO [(InterfaceFile, FilePath)]
-readInterfaceFiles pairs = do
+readInterfaceFiles :: Session -> [(FilePath, FilePath)] -> IO [(InterfaceFile, FilePath)]
+readInterfaceFiles session pairs = do
mbPackages <- mapM tryReadIface pairs
return (catMaybes mbPackages)
where
-- try to read an interface, warn if we can't
tryReadIface (html, iface) = do
- eIface <- readInterfaceFile iface
+ eIface <- readInterfaceFile session iface
case eIface of
Left err -> do
putStrLn ("Warning: Cannot read " ++ iface ++ ":")