aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Waern <david.waern@gmail.com>2010-05-13 19:46:47 +0000
committerDavid Waern <david.waern@gmail.com>2010-05-13 19:46:47 +0000
commit0def434b91adb7ab05e37750d40ac09e96e8cb0c (patch)
tree04ba09fbe982e02e9ddb95787e24d12f5856c773
parent35151a79934a5ca14338ef76bfa9cc2cd0e72d9b (diff)
Fix a few stylistic issues in H.InterfaceFile
-rw-r--r--src/Haddock/InterfaceFile.hs11
1 files changed, 9 insertions, 2 deletions
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index 2fb1e223..183e5893 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -39,6 +39,7 @@ import FastMutInt
import FastString
import Unique
+
data InterfaceFile = InterfaceFile {
ifLinkEnv :: LinkEnv,
ifInstalledIfaces :: [InstalledInterface]
@@ -123,6 +124,7 @@ writeInterfaceFile filename iface = do
writeBinMem bh filename
return ()
+
type NameCacheAccessor m = (m NameCache, NameCache -> m ())
@@ -144,6 +146,7 @@ freshNameCache = ( create_fresh_nc , \_ -> return () )
u <- mkSplitUniqSupply 'a' -- ??
return (initNameCache u [])
+
-- | Read a Haddock (@.haddock@) interface file. Return either an
-- 'InterfaceFile' or an error message.
--
@@ -204,6 +207,7 @@ readInterfaceFile (get_name_cache, set_name_cache) filename = do
seekBin bh1 data_p'
return (nc', symtab)
+
-------------------------------------------------------------------------------
-- Symbol table
-------------------------------------------------------------------------------
@@ -260,6 +264,7 @@ 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
sz <- get bh
@@ -271,8 +276,10 @@ getSymbolTable bh namecache = do
--
return (namecache', arr)
+
type OnDiskName = (PackageId, ModuleName, OccName)
+
fromOnDiskName
:: Array Int Name
-> NameCache
@@ -296,6 +303,7 @@ fromOnDiskName _ nc (pid, mod_name, occ) =
( nc{ nsUniqs = us', nsNames = new_cache }, name )
}
+
serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
serialiseName bh name _ = do
let modu = nameModule name
@@ -306,8 +314,7 @@ serialiseName bh name _ = do
-- GhcBinary instances
-------------------------------------------------------------------------------
--- Hmm, why didn't we dare to make this instance already? It makes things
--- much easier.
+
instance (Ord k, Binary k, Binary v) => Binary (Map k v) where
put_ bh m = put_ bh (Map.toList m)
get bh = fmap (Map.fromList) (get bh)