[haddock @ 2005-02-02 16:23:00 by simonmar]

Revamp the linking strategy in Haddock.

Now name resolution is done in two phases:

 - first resolve everything to original names, like a Haskell compiler
   would.

 - then, figure out the "home" location for every entity, and point
   all the links to there.  The home location is the lowest non-hidden
   module in the import hierarchy that documents the entity.  If there
   are multiple candidates, one is chosen at random.

Also:

 - Haddock should not generate any HTML with dangling links any more.
   Unlinked references are just rendered as plain text.

 - Error reporting is better: if we can't find a link destination for
   an entity reference, we now emit a warning.

10 files changed, 376 insertions, 260 deletions

diff --git a/TODO b/TODO
index 58a470e4..a68d064c 100644
--- a/TODO
+++ b/TODO
@@ -1,16 +1,6 @@
 -----------------------------------------------------------------------------
 -- bugs
 
-* I've been thinking of a solution along these lines: Haddock
-  processes the modules in two phases.  The first phase resolves all the
-  names and determines the "definitive" documentation for each entity.
-  The second phase makes all the links point to the definitive
-  documentation, with certain exceptions: if the entity is also
-  documented in the local module, then point there instead.  Perhaps
-  there are other exceptions.  We might need a way to indicate
-  "definitive", or maybe just the module(s) furthest up the dependency
-  tree would do.
-
 * The lexer should handle "...." in doc strings, only recognising it if the
   contents looks like a module name.
 
@@ -39,9 +29,6 @@
 * derived instance support isn't quite right (doing it properly is 
   hard, though).
 
-* Referring to something that has a defn but no type signature doesn't
-  elicit a useful message.
-
 * The synopsis generated for a module with no docs should not attempt to
   link to the doc for each entity.  We need a different kind of summary
   here: what we really want is just the documentation section but without
diff --git a/src/HaddockDevHelp.hs b/src/HaddockDevHelp.hs
index 51e96ea0..390fb6f3 100644
--- a/src/HaddockDevHelp.hs
+++ b/src/HaddockDevHelp.hs
@@ -10,11 +10,13 @@ import Data.Maybe ( fromMaybe )
 import Text.PrettyPrint
 
 
-ppDevHelpFile :: FilePath -> String -> Maybe String -> [(Module,Interface)] -> IO ()
+ppDevHelpFile :: FilePath -> String -> Maybe String -> [Interface] -> IO ()
 ppDevHelpFile odir doctitle maybe_package ifaces = do
   let devHelpFile = package++".devhelp"
-      tree = mkModuleTree [ (mod, iface_package iface, toDescription iface)
-			  | (mod, iface) <- ifaces ]
+      tree = mkModuleTree [ (iface_module iface, 
+			     iface_package iface, 
+			     toDescription iface)
+			  | iface <- ifaces ]
       doc =
         text "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"no\"?>" $$
         (text "<book xmlns=\"http://www.devhelp.net/book\" title=\""<>text doctitle<>
@@ -56,9 +58,10 @@ ppDevHelpFile odir doctitle maybe_package ifaces = do
     index :: [(HsName, [Module])]
     index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces)
 
-    getIfaceIndex (mdl,iface) fm =
+    getIfaceIndex iface fm =
 		Map.unionWith (++) (Map.fromListWith (flip (++)) [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm
-	
+		where mdl = iface_module iface
+
     ppList [] = empty
     ppList ((name,refs):mdls)  =
       ppReference name refs $$
diff --git a/src/HaddockHH.hs b/src/HaddockHH.hs
index d5bf7109..59953575 100644
--- a/src/HaddockHH.hs
+++ b/src/HaddockHH.hs
@@ -71,7 +71,7 @@ ppHHContents odir doctitle maybe_package tree = do
 			-- reconstruct the module name
 		
 -------------------------------
-ppHHIndex :: FilePath -> Maybe String -> [(Module,Interface)] -> IO ()
+ppHHIndex :: FilePath -> Maybe String -> [Interface] -> IO ()
 ppHHIndex odir maybe_package ifaces = do
   let indexHHFile = package++".hhk"
   
@@ -93,8 +93,9 @@ ppHHIndex odir maybe_package ifaces = do
 	index :: [(HsName, [Module])]
 	index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces)
 
-	getIfaceIndex (mdl,iface) fm =
+	getIfaceIndex iface fm =
 		foldl (\m (k,e) -> Map.insertWith (++) k e m) fm [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']
+		where mdl = iface_module iface
 	
 	ppList [] = empty
 	ppList ((name,refs):mdls)  =
@@ -112,7 +113,7 @@ ppHHIndex odir maybe_package ifaces = do
 		ppReference name refs
 
 
-ppHHProject :: FilePath -> String -> Maybe String -> [(Module,Interface)] -> [FilePath] -> IO ()
+ppHHProject :: FilePath -> String -> Maybe String -> [Interface] -> [FilePath] -> IO ()
 ppHHProject odir doctitle maybe_package ifaces pkg_paths = do
   let projectHHFile = package++".hhp"
       doc =
@@ -136,7 +137,8 @@ ppHHProject odir doctitle maybe_package ifaces pkg_paths = do
     package = fromMaybe "pkg" maybe_package
 	
     ppMods [] = empty
-    ppMods ((Module mdl,_):ifaces) =
+    ppMods (iface:ifaces) =
+	let Module mdl = iface_module iface in
         text (moduleHtmlFile mdl) $$
         ppMods ifaces
 		
@@ -161,5 +163,6 @@ ppHHProject odir doctitle maybe_package ifaces pkg_paths = do
     chars :: [Char]
     chars = map fst (Map.toAscList (foldr getIfaceIndex Map.empty ifaces))
 
-    getIfaceIndex (mdl,iface) fm =
+    getIfaceIndex iface fm =
         Map.union (Map.fromList [(toUpper (head (show name)),()) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm
+	where mdl = iface_module iface
diff --git a/src/HaddockHH2.hs b/src/HaddockHH2.hs
index 9e023dda..6d4ce5c0 100644
--- a/src/HaddockHH2.hs
+++ b/src/HaddockHH2.hs
@@ -56,7 +56,7 @@ ppHH2Contents odir doctitle maybe_package tree = do
 
 -----------------------------------------------------------------------------------
 
-ppHH2Index :: FilePath -> Maybe String -> [(Module,Interface)] -> IO ()
+ppHH2Index :: FilePath -> Maybe String -> [Interface] -> IO ()
 ppHH2Index odir maybe_package ifaces = do
   let 
 	indexKHH2File     = package++"K.HxK"
@@ -83,8 +83,9 @@ ppHH2Index odir maybe_package ifaces = do
 	index :: [(HsName, [Module])]
 	index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces)
 
-	getIfaceIndex (mdl,iface) fm =
+	getIfaceIndex iface fm =
 	    Map.unionWith (++) (Map.fromListWith (flip (++)) [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm
+	    where mdl = iface_module iface
 	
 	ppList [] = empty
 	ppList ((name,mdls):vs)  =
@@ -98,7 +99,7 @@ ppHH2Index odir maybe_package ifaces = do
 
 -----------------------------------------------------------------------------------
 
-ppHH2Files :: FilePath -> Maybe String -> [(Module,Interface)] -> [FilePath] -> IO ()
+ppHH2Files :: FilePath -> Maybe String -> [Interface] -> [FilePath] -> IO ()
 ppHH2Files odir maybe_package ifaces pkg_paths = do
   let filesHH2File = package++".HxF"
       doc =
@@ -116,9 +117,10 @@ ppHH2Files odir maybe_package ifaces pkg_paths = do
     package = fromMaybe "pkg" maybe_package
 	
     ppMods [] = empty
-    ppMods ((Module mdl,_):ifaces) =
+    ppMods (iface:ifaces) =
 		text "<File Url=\"" <> text (moduleHtmlFile mdl) <> text "\"/>" $$
 		ppMods ifaces
+		where Module mdl = iface_module iface
 		
     ppIndexFiles []     = empty
     ppIndexFiles (c:cs) =
@@ -141,8 +143,9 @@ ppHH2Files odir maybe_package ifaces pkg_paths = do
     chars :: [Char]
     chars = map fst (Map.toAscList (foldr getIfaceIndex Map.empty ifaces))
 
-    getIfaceIndex (mdl,iface) fm =
+    getIfaceIndex iface fm =
         Map.union (Map.fromList [(toUpper (head (show name)),()) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm
+	where mdl = iface_module iface
 
 -----------------------------------------------------------------------------------
 
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index ced6e351..b02caf5b 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -40,7 +40,7 @@ import System.IO ( IOMode(..), hClose, hGetBuf, hPutBuf )
 ppHtml	:: String
 	-> Maybe String				-- package
 	-> Maybe String
-	-> [(Module, Interface)]
+	-> [Interface]
 	-> FilePath			-- destination directory
 	-> Maybe Doc			-- prologue text, maybe
 	-> Maybe String		-- the Html Help format (--html-help)
@@ -52,11 +52,11 @@ ppHtml doctitle maybe_package source_url ifaces odir prologue maybe_html_help_fo
 	maybe_contents_url maybe_index_url =  do
   let
 	visible_ifaces = filter visible ifaces
-	visible (_, i) = OptHide `notElem` iface_options i
+	visible i = OptHide `notElem` iface_options i
 
   when (not (isJust maybe_contents_url)) $ 
     ppHtmlContents odir doctitle maybe_package maybe_html_help_format maybe_index_url 
-	[ (m,iface{iface_package=Nothing}) | (m,iface) <- visible_ifaces ]
+	[ iface{iface_package=Nothing} | iface <- visible_ifaces ]
 	-- we don't want to display the packages in a single-package contents
 	prologue
 
@@ -72,7 +72,7 @@ ppHtml doctitle maybe_package source_url ifaces odir prologue maybe_html_help_fo
 ppHtmlHelpFiles	
     :: String                   -- doctitle
     -> Maybe String				-- package
-	-> [(Module, Interface)]
+	-> [Interface]
 	-> FilePath                 -- destination directory
 	-> Maybe String             -- the Html Help format (--html-help)
 	-> [FilePath]               -- external packages paths
@@ -80,7 +80,7 @@ ppHtmlHelpFiles
 ppHtmlHelpFiles doctitle maybe_package ifaces odir maybe_html_help_format pkg_paths =  do
   let
 	visible_ifaces = filter visible ifaces
-	visible (_, i) = OptHide `notElem` iface_options i
+	visible i = OptHide `notElem` iface_options i
 
   -- Generate index and contents page for Html Help if requested
   case maybe_html_help_format of
@@ -217,12 +217,14 @@ ppHtmlContents
    -> Maybe String
    -> Maybe String
    -> Maybe String
-   -> [(Module,Interface)] -> Maybe Doc
+   -> [Interface] -> Maybe Doc
    -> IO ()
 ppHtmlContents odir doctitle maybe_package maybe_html_help_format maybe_index_url
   mdls prologue = do
   let tree = mkModuleTree 
-         [(mod,iface_package iface,toDescription iface) | (mod,iface) <- mdls]
+         [(iface_module iface,
+	   iface_package iface,
+	   toDescription iface) | iface <- mdls]
       html = 
 	header 
 		(documentCharacterEncoding +++
@@ -313,7 +315,7 @@ ppHtmlIndex :: FilePath
             -> Maybe String
             -> Maybe String
             -> Maybe String
-            -> [(Module,Interface)] 
+            -> [Interface] 
             -> IO ()
 ppHtmlIndex odir doctitle maybe_package maybe_html_help_format maybe_contents_url ifaces = do
   let html = 
@@ -386,10 +388,11 @@ ppHtmlIndex odir doctitle maybe_package maybe_html_help_format maybe_contents_ur
   full_index = Map.fromListWith (flip (Map.unionWith (++)))
 		(concat (map getIfaceIndex ifaces))
 
-  getIfaceIndex (mdl,iface) = 
+  getIfaceIndex iface = 
     [ (hsNameStr nm, 
-	Map.fromList [(orig, [(mdl, not (nm `Map.member` iface_reexported iface))])])
+	Map.fromList [(orig, [(mdl, not (nm `elem` iface_reexported iface))])])
     | (nm, orig) <- Map.toAscList (iface_env iface) ]
+    where mdl = iface_module iface
 
   indexElt :: (String, Map HsQName [(Module,Bool)]) -> HtmlTable
   indexElt (str, entities) = 
@@ -433,10 +436,12 @@ ppHtmlIndex odir doctitle maybe_package maybe_html_help_format maybe_contents_ur
 
 ppHtmlModule
 	:: FilePath -> String -> Maybe String -> Maybe String -> Maybe String
-	-> (Module,Interface) -> IO ()
+	-> Interface -> IO ()
 ppHtmlModule odir doctitle source_url 
-  maybe_contents_url maybe_index_url (Module mdl,iface) = do
-  let html = 
+  maybe_contents_url maybe_index_url iface = do
+  let 
+      Module mdl = iface_module iface
+      html = 
 	header (documentCharacterEncoding +++
 		thetitle (toHtml mdl) +++
 		styleSheet +++
diff --git a/src/HaddockRename.hs b/src/HaddockRename.hs
index 6f8aafc5..5199c013 100644
--- a/src/HaddockRename.hs
+++ b/src/HaddockRename.hs
@@ -5,7 +5,7 @@
 --
 
 module HaddockRename (
-	RnM, runRn, runRnFM,	-- the monad (instance of Monad)
+	RnM, runRn, runRnFM, runRnUnqualFM, -- the monad (instance of Monad)
 
 	renameExportList, 
 	renameDecl,
@@ -14,6 +14,7 @@ module HaddockRename (
   ) where
 
 import HaddockTypes
+import HaddockUtil	( unQual )
 import HsSyn
 import Map ( Map )
 import qualified Map hiding ( Map )
@@ -27,7 +28,10 @@ import Monad
 -- renaming, and it returns a list of names which couldn't be found in 
 -- the environment.
 
-newtype GenRnM n a = RnM {unRn :: (n -> Maybe HsQName) -> (a,[n])}
+newtype GenRnM n a = 
+  RnM { unRn :: (n -> (Bool,HsQName))	-- name lookup function
+             -> (a,[n])
+      }
 
 type RnM a = GenRnM HsQName a
 
@@ -42,7 +46,7 @@ m `thenRn` k = RnM (\lkp -> case unRn m lkp of
 				(a,out1) -> case unRn (k a) lkp of
 						(b,out2) -> (b,out1++out2))
 
-getLookupRn :: RnM (HsQName -> Maybe HsQName)
+getLookupRn :: RnM (HsQName -> (Bool,HsQName))
 getLookupRn = RnM (\lkp -> (lkp,[]))
 outRn :: HsQName -> RnM ()
 outRn name = RnM (\_ -> ((),[name]))
@@ -51,13 +55,24 @@ lookupRn :: (HsQName -> a) -> HsQName -> RnM a
 lookupRn and_then name = do
   lkp <- getLookupRn
   case lkp name of
-	Nothing -> do outRn name; return (and_then name)
-	Just maps_to -> return (and_then maps_to)
+	(False,maps_to) -> do outRn name; return (and_then maps_to)
+	(True, maps_to) -> return (and_then maps_to)
 
 runRnFM :: Map HsQName HsQName -> RnM a -> (a,[HsQName])
-runRnFM env rn = unRn rn (flip Map.lookup env)
-
-runRn :: (n -> Maybe HsQName) -> GenRnM n a -> (a,[n])
+runRnFM env rn = unRn rn lkp 
+  where lkp n = case Map.lookup n env of
+		  Nothing -> (False, n) -- leave the qualified name
+		  Just q  -> (True,  q)
+
+-- like runRnFM, but if it can't find a mapping for a name,
+-- it leaves an unqualified name in place instead.
+runRnUnqualFM :: Map HsQName HsQName -> RnM a -> (a,[HsQName])
+runRnUnqualFM env rn = unRn rn lkp 
+  where lkp n = case Map.lookup n env of
+		  Nothing -> (False, unQual n) -- remove the qualifier
+		  Just q  -> (True, q)
+
+runRn :: (n -> (Bool,HsQName)) -> GenRnM n a -> (a,[n])
 runRn lkp rn = unRn rn lkp
 
 -- -----------------------------------------------------------------------------
@@ -230,7 +245,7 @@ renameMaybeDoc (Just doc) = Just `liftM` renameDoc doc
 lookupForDoc :: [HsQName] -> RnM Doc
 lookupForDoc qns = do
   lkp <- getLookupRn
-  case [ n | Just n <- map lkp qns ] of
+  case [ n | (True,n) <- map lkp qns ] of
 	ns@(_:_) -> return (DocIdentifier ns)
 	[] -> -- if we were given a qualified name, but there's nothing
 	      -- matching that name in scope, then just assume its existence
@@ -239,7 +254,8 @@ lookupForDoc qns = do
 	      let quals = filter isQualified qns in
 	      if (not (null quals)) then
 		return (DocIdentifier quals)
-	      else
+	      else do
+		outRn (head qns)
 		-- no qualified names: just replace this name with its
 		-- string representation.
 		return (DocString (show (head qns)))
diff --git a/src/HaddockTypes.hs b/src/HaddockTypes.hs
index 82ce5a08..fafafe40 100644
--- a/src/HaddockTypes.hs
+++ b/src/HaddockTypes.hs
@@ -25,14 +25,14 @@ data Interface
 	iface_filename :: FilePath,
 		-- ^ the filename that contains the source code for this module
 
+	iface_module :: Module,
+
 	iface_package :: Maybe String,
 
 	iface_env :: NameEnv,
-		-- ^ environment mapping names to *original* names
-
-	iface_import_env :: Map HsQName HsQName,
+		-- ^ environment mapping exported names to *original* names
 
-	iface_reexported :: NameEnv,
+	iface_reexported :: [HsName],
 		-- ^ For names exported by this module, but not
 		-- actually documented in this module's documentation
 		-- (perhaps because they are reexported via 'module M'
@@ -69,7 +69,12 @@ data Interface
 		-- ^ module-wide doc options
   }
 
-data DocOption = OptHide | OptPrune | OptIgnoreExports 
+data DocOption
+  = OptHide		-- this module should not appear in the docs
+  | OptPrune
+  | OptIgnoreExports	-- pretend everything is exported
+  | OptNotDefinitive	-- not the best place to get docs for things
+		 	-- exported by this module.
   deriving (Eq)
 
 data ExportItem 
diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs
index 434d935e..eacde1bb 100644
--- a/src/HaddockUtil.hs
+++ b/src/HaddockUtil.hs
@@ -10,7 +10,7 @@ module HaddockUtil (
   -- * Misc utilities
   nameOfQName, collectNames, declBinders, declMainBinder, declSubBinders, 
   splitTyConApp, restrictTo, declDoc, parseModuleHeader, freeTyCons, unbang,
-  addFieldDoc, addFieldDocs, addConDoc, addConDocs,toDescription,
+  addFieldDoc, addFieldDocs, addConDoc, addConDocs,toDescription, unQual,
 
   -- * Filename utilities
   basename, dirname, splitFilename3, 
@@ -51,6 +51,10 @@ nameOfQName :: HsQName -> HsName
 nameOfQName (Qual _ n) = n
 nameOfQName (UnQual n) = n
 
+unQual :: HsQName -> HsQName
+unQual (Qual _ n) = UnQual n
+unQual n = n
+
 collectNames :: [HsDecl] -> [HsName]
 collectNames ds = concat (map declBinders ds)
 
diff --git a/src/Main.hs b/src/Main.hs
index ad316cf2..bce33a5f 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -28,7 +28,7 @@ import Control.Monad ( when )
 import Control.Monad.Writer ( Writer, runWriter, tell )
 import Data.Char ( isSpace )
 import Data.IORef ( writeIORef )
-import Data.List ( nub )
+import Data.List ( nub, (\\), foldl' )
 import Data.Maybe ( isJust, maybeToList )
 --import Debug.Trace
 import System.Console.GetOpt ( getOpt, usageInfo, ArgOrder(..), OptDescr(..), ArgDescr(..) )
@@ -188,15 +188,20 @@ run flags files = do
 		
   prologue <- getPrologue flags
 
-  read_ifaces_s <- mapM readIface (map snd ifaces_to_read)
+  read_iface_stuff <- mapM readIface (map snd ifaces_to_read)
 
-  let read_ifaces = concat read_ifaces_s
-      visible_read_ifaces = filter ((OptHide `notElem`) . iface_options . snd) 
+  let 
+      (read_ifacess, doc_envs) = unzip read_iface_stuff
+      read_ifaces = concat read_ifacess
+
+      ext_doc_env = Map.unions doc_envs
+      
+      visible_read_ifaces = filter ((OptHide `notElem`) . iface_options) 
 				read_ifaces
-      external_mods = map fst read_ifaces
+      external_mods = map iface_module read_ifaces
       pkg_paths = map fst ifaces_to_read
 
-  updateHTMLXRefs pkg_paths read_ifaces_s
+  updateHTMLXRefs pkg_paths read_ifacess
 
   when ((Flag_GenIndex `elem` flags || Flag_GenContents `elem` flags)
 	&& Flag_Html `elem` flags) $
@@ -221,34 +226,54 @@ run flags files = do
   -- process the modules in sorted order, building up a mapping from
   -- modules to interfaces.
   let 
-	loop ifaces [] = return ifaces
-	loop ifaces ((hsmod,file):mdls)  = do 
-	   let ((mdl,iface),msgs) = runWriter $
-		   mkInterface no_implicit_prelude verbose ifaces 
+	loop mod_env ifaces [] = return (reverse ifaces)
+	loop mod_env ifaces ((hsmod,file):mdls)  = do 
+	   let (iface,msgs) = runWriter $
+		   mkInterfacePhase1 no_implicit_prelude verbose mod_env
 			file package hsmod
-	       new_ifaces = Map.insert mdl iface ifaces
-	   mapM (hPutStrLn stderr) msgs
-	   loop new_ifaces mdls
+	       new_mod_env = Map.insert (iface_module iface) iface mod_env
+	   mapM_ (hPutStrLn stderr) msgs
+	   loop new_mod_env (iface:ifaces) mdls
+
+  let 
+	mod_map = Map.fromList [ (iface_module iface,iface) 
+			       | iface <- read_ifaces ]
+  
+  ifaces <- loop mod_map read_ifaces sorted_mod_files
+  let 
+      these_ifaces0 = [ iface | iface <- ifaces,
+		    	        iface_module iface `notElem` external_mods ]
 
-  module_map <- loop (Map.fromList read_ifaces) sorted_mod_files
-  let mod_ifaces = Map.toAscList module_map
+  let these_ifaces1  = attachInstances these_ifaces0
+      this_doc_env   = buildGlobalDocEnv these_ifaces1
+      global_doc_env = this_doc_env `Map.union`
+		       ext_doc_env `Map.union`
+		       builtinDocEnv
 
-      these_mod_ifaces0 = [ (mdl, iface) 
-			  | (mdl, iface) <- mod_ifaces,
-			    mdl `notElem` external_mods ]
+
+--  Now do phase 2
+  let
+	loop2 ifaces [] = return (reverse ifaces)
+	loop2 ifaces (iface:rest) = do
+	   let (iface',msgs) = runWriter $
+		    mkInterfacePhase2 verbose iface global_doc_env
+	   mapM_ (hPutStrLn stderr) msgs
+	   loop2 (iface':ifaces) rest
+
+  these_ifaces <- loop2 [] these_ifaces1  
 
 --  when (Flag_DocBook `elem` flags) $
 --    putStr (ppDocBook odir mod_ifaces)
 
-  let these_mod_ifaces = attachInstances these_mod_ifaces0
 
   when (Flag_Debug `elem` flags) $ do
-    mapM_ putStrLn (map show [ (mdl, Map.toAscList (iface_env i), 
+    mapM_ putStrLn (map show [ (iface_module i, 
+				     Map.toAscList (iface_env i), 
 				     Map.toAscList (iface_sub i))
-			     | (mdl, i) <-  these_mod_ifaces ])
+			     | i <-  these_ifaces ])
 
   when (Flag_Html `elem` flags) $ do
-    ppHtml title package source_url these_mod_ifaces odir
+    ppHtml title package source_url these_ifaces odir
 		prologue maybe_html_help_format
 		maybe_contents_url maybe_index_url
     copyHtmlBits odir libdir css_file
@@ -256,7 +281,7 @@ run flags files = do
   -- dump an interface if requested
   case dump_iface of
      Nothing -> return ()
-     Just fn -> dumpInterfaces these_mod_ifaces fn
+     Just fn -> dumpInterfaces these_ifaces this_doc_env fn
 
 parseIfaceOption :: String -> (FilePath,FilePath)
 parseIfaceOption s = 
@@ -265,13 +290,13 @@ parseIfaceOption s =
 	(file, _)        -> ("", file)
 		
 
-updateHTMLXRefs :: [FilePath] -> [[(Module,Interface)]] -> IO ()
+updateHTMLXRefs :: [FilePath] -> [[Interface]] -> IO ()
 updateHTMLXRefs paths ifaces_s =
   writeIORef html_xrefs_ref (Map.fromList mapping)
  where
-  mapping = [ (mdl, fpath)
+  mapping = [ (iface_module iface, fpath)
 	    | (fpath, ifaces) <- zip paths ifaces_s,
-	      (mdl, _iface) <- ifaces
+	      iface <- ifaces
 	    ]
 
 parse_file :: FilePath -> IO HsModule
@@ -299,16 +324,21 @@ getPrologue flags
 -----------------------------------------------------------------------------
 -- Figuring out the definitions that are exported from a module
 
-mkInterface
+-- We're going to make interfaces in two passes:
+--
+--   1. Rename the code.  This basically involves resolving all
+--      the names to "original names".
+--
+--   2. Convert all the entity references to "doc names".  These are
+--      the names we want to link to in the documentation.
+
+mkInterfacePhase1
    :: Bool				-- no implicit prelude
    -> Bool				-- verbose
    -> ModuleMap -> FilePath -> Maybe String -> HsModule
-   -> ErrMsgM (
-	       Module, 		-- the module name
-	       Interface	-- its "interface"
-	      )
+   -> ErrMsgM Interface			-- the "interface" of the module
 
-mkInterface no_implicit_prelude verbose mod_map filename package
+mkInterfacePhase1 no_implicit_prelude verbose mod_map filename package
 	(HsModule mdl exps imps decls maybe_opts maybe_info maybe_doc) = do  
 
   -- Process the options, if available
@@ -358,96 +388,141 @@ mkInterface no_implicit_prelude verbose mod_map filename package
      (orig_decls, missing_names2)
 	= runRnFM orig_env (mapM renameDecl annotated_decls)
 
+     (orig_module_doc, missing_names3)
+        = runRnFM orig_env (renameMaybeDoc maybe_doc)
+
+     decl_map :: Map HsName HsDecl
+     decl_map = Map.fromList [ (n,d) | d <- orig_decls, n <- declBinders d ]
+
+     instances = [ d | d@HsInstDecl{} <- orig_decls ] ++
+		 [ d | decl <- orig_decls, d <- derivedInstances mdl decl]
+
+  -- trace (show (Map.toAscList orig_env)) $ do
+
      -- gather up a list of entities that are exported (original names)
   (exported_names, exported_visible_names)
 	 <- exportedNames mdl mod_map
 			locally_defined_names orig_env sub_map
 			orig_exports opts
-  let
-
-     -- build the import env, which maps original names to import names
-     local_import_env = Map.fromList (zip qual_local_names qual_local_names)
 
-     -- find the names exported by this module that other modules should *not*
-     -- link to (and point them to where they should).
-     reexports = getReExports mdl exported_names exported_visible_names
-			import_env
-
-     import_env = buildImportEnv mod_map mdl exported_visible_names implicit_imps
-                  `Map.union` local_import_env
-
---   trace (show (Map.toAscList orig_env)) $ do
---  trace (show (Map.toAscList import_env)) $ do
   let
-     final_decls = orig_decls
+     -- maps exported HsNames to orig HsQNames
+     name_env = Map.fromList [ (nameOfQName n, n) | n <- exported_names ]
 
-     decl_map :: Map HsName HsDecl
-     decl_map = Map.fromList [ (n,d) | d <- final_decls, n <- declBinders d ]
+     -- find the names exported by this module that other modules should *not*
+     -- link to.
+     reexports = [ nm | n@(Qual _ nm) <- exported_names, 
+			n `notElem` exported_visible_names ]
 
-     instances = [ d | d@HsInstDecl{} <- final_decls ] ++
-		 [ d | decl <- orig_decls, d <- derivedInstances mdl decl]
+  -- in
 
   -- make the "export items", which will be converted into docs later
-  orig_export_list <- mkExportItems mod_map mdl exported_names decl_map sub_map
-			 		final_decls opts orig_exports
-
+  orig_export_items <- mkExportItems mod_map mdl exported_names decl_map sub_map
+			 		orig_decls opts orig_exports
   let
      -- prune the export list to just those declarations that have
      -- documentation, if the 'prune' option is on.
      pruned_export_list
-	| OptPrune `elem` opts = pruneExportItems orig_export_list
-	| otherwise = orig_export_list
-
-     -- rename names in the exported declarations to point to things that
-     -- are closer, or maybe even exported by, the current module.
-     (renamed_export_list, _missing_names3)
-        = runRnFM import_env (renameExportItems pruned_export_list)
-
-     name_env = Map.fromList [ (nameOfQName n, n) | n <- exported_names ]
-
-  let
-     (orig_module_doc, missing_names4)
-        = runRnFM orig_env (renameMaybeDoc maybe_doc)
-
-     (final_module_doc, _missing_names5)
-        = runRnFM import_env (renameMaybeDoc orig_module_doc)
+	| OptPrune `elem` opts = pruneExportItems orig_export_items
+	| otherwise = orig_export_items
+  -- in
 
   -- report any names we couldn't find/resolve
-
-  let missing_names = missing_names1 ++ missing_names2 ++ missing_names4
+  let
+      missing_names = missing_names1 ++ missing_names2 ++ missing_names3
 			 --ignore missing_names3 & missing_names5 for now
-      filtered_missing_names = filter (`notElem` ignore) missing_names
-
-      -- ignore certain builtin names ((),[], etc.), because these
-      -- cannot be exported anyway.
-      ignore = [unit_tycon_qname, fun_tycon_qname, list_tycon_qname,
-		unit_con_name, nil_con_name]	
+      filtered_missing_names = filter (`notElem` builtinNames) missing_names
 
       name_strings = nub (map show filtered_missing_names)
+  -- in
 
-  when (not (null name_strings)) $
+  when (OptHide `notElem` opts &&
+	not (null name_strings)) $
 	  tell ["Warning: " ++ show mdl ++ 
 		": the following names could not be resolved:\n"++
 		"   " ++ concat (map (' ':) name_strings)
 		]
 
-  return (mdl, Interface { 
+  return (Interface { 
 		   iface_filename     = filename,
+		   iface_module	      = mdl,
 		   iface_package      = package,
 		   iface_env          = name_env,
-		   iface_import_env   = import_env,
 		   iface_reexported   = reexports,
-		   iface_exports      = renamed_export_list,
 		   iface_sub	      = sub_map,
 		   iface_orig_exports = pruned_export_list,
-		   iface_insts	      = instances,
 		   iface_decls        = decl_map,
 		   iface_info	      = maybe_info,
-		   iface_doc          = final_module_doc,
-		   iface_options      = opts
+		   iface_doc          = orig_module_doc,
+		   iface_options      = opts,
+		   iface_exports      = error "iface_exports",
+		   iface_insts	      = instances
 		}
       	  )
 
+-- -----------------------------------------------------------------------------
+-- Phase 2
+
+mkInterfacePhase2
+   :: Bool			-- verbose
+   -> Interface
+   -> Map HsQName HsQName	-- global doc-name mapping
+   -> ErrMsgM Interface
+
+mkInterfacePhase2 verbose iface gbl_doc_env =
+  case iface of {
+    Interface {
+	iface_module = this_mdl,
+	iface_env = env,
+	iface_reexported = reexports,
+	iface_orig_exports = orig_export_items,
+	iface_doc = orig_module_doc } ->
+
+   let
+     exported_visible_names = 
+	[orig | (nm,orig) <- Map.toAscList env, nm `notElem` reexports ]
+
+     -- build the import_env.
+     import_env = foldl fn gbl_doc_env exported_visible_names
+	where fn env qnm@(Qual _ nm) = Map.insert qnm (Qual this_mdl nm) env
+	      fn env (UnQual nm) = env
+
+     -- rename names in the exported declarations to point to things that
+     -- are closer, or maybe even exported by, the current module.
+     (renamed_export_list, missing_names1)
+        = runRnUnqualFM import_env (renameExportItems orig_export_items)
+
+     (final_module_doc, missing_names2)
+        = runRnUnqualFM import_env (renameMaybeDoc orig_module_doc)
+
+	-- we're only interested in reporting missing *qualfied*
+	-- names, the unqualified ones are the ones that couldn't
+	-- be resolved in phase 1 and have already been reported.
+     filtered_missing_names = 
+	filter isQual (missing_names1 ++ missing_names2)
+	where isQual (Qual _ _) = True
+	      isQual _ = False
+
+     missing_names = map show (nub filtered_missing_names)
+   in do
+
+	-- report things that we couldn't link to.  Only do this
+	-- for non-hidden modules.
+   when (OptHide `notElem` iface_options iface &&
+	 not (null missing_names)) $
+	  tell ["Warning: " ++ show this_mdl ++ 
+		": could not find link destinations for:\n"++
+		"   " ++ concat (map (' ':) missing_names)
+		]
+
+   --  trace (show (Map.toAscList import_env)) $ do
+
+   return iface{ iface_exports = renamed_export_list,
+	  	 iface_doc = final_module_doc }
+ }
+
+-- -----------------------------------------------------------------------------
+
 -- Try to generate instance declarations for derived instances.
 -- We can't do this properly without instance inference, but if a type
 -- variable occurs as a constructor argument, then we can just
@@ -782,29 +857,6 @@ all_subs_of_qname _ n@(UnQual _) =
     error $ "Main.all_subs_of_qname: unexpected unqual'd name:" ++ show n
 
 -- ----------------------------------------------------------------------------
--- Get a list of names exported by this module that are not actually
--- documented here, and build a mapping to point to where the
--- documentation for those names can be found.  This is used for
--- constructing the iface_reexports field of the Interface.
-
-getReExports :: Module
-   -> [HsQName]   -- all exported names
-   -> [HsQName]   -- exported names which are documented here
-   -> Map HsQName HsQName
-   -> Map HsName HsQName
-getReExports mdl exported exported_visible import_env
-  = Map.fromList (concat invisible_names)  
-  where
-   invisible_names = [ get_name n | n <- exported, 
-				       n `notElem` exported_visible ]
-
-   get_name (UnQual _) = []
-   get_name n@(Qual m un) = 
-	case Map.lookup n import_env of
-	    Nothing -> []
-	    Just n' -> [(un,n')]
- 
--- ----------------------------------------------------------------------------
 -- Building name environments
 
 -- The orig env maps names in the current source file to
@@ -841,46 +893,6 @@ buildOrigEnv this_mdl verbose mod_map imp_decls
 	  | otherwise          = mdl
 
 
--- The import env maps each "original" name referred to in the current
--- module to the qualified name that we want to link to in the
--- documentation.
-
-buildImportEnv :: ModuleMap -> Module
-        -> [HsQName]	   -- a list of names exported from here *with docs*
-	-> [HsImportDecl]  -- the import decls
-	-> Map HsQName HsQName
-buildImportEnv mod_map this_mod exported_names imp_decls
-  = foldr (flip (Map.unionWith (flip best_name))) Map.empty (map build imp_decls)
-  where
-	-- choose qualified results over unqualified ones.  In the future
-	-- we might make more intelligent decisions about which name to
-	-- link to.
-	best_name n@(Qual _ _) _ = n
-	best_name _ n@(Qual _ _) = n
-	best_name n _ = n
-
-	build imp_decl@(HsImportDecl _ mdl _ _ _) = 
-	  case Map.lookup mdl mod_map of
-       	    Nothing    -> Map.empty
-            Just iface -> Map.fromList (map import_map imported_names)
-	     where
-	      imported_names = processImportDecl mod_map imp_decl
-	      reexport_env = iface_reexported iface
-
-	      import_map (nm,qnm) = (qnm, maps_to)
- 	       where 
-		maps_to
-		 -- we re-export it, with docs
-		 | qnm `elem` exported_names = Qual this_mod nm
-		 -- re-exported from the other module, but not documented there:
-		 -- find the right place using the iface_reexported environment.
-		 | Just new_qnm <- Map.lookup nm reexport_env = new_qnm
-		 -- if the destination is hidden, we have nowhere to link to
-		 | OptHide `elem` iface_options iface  = UnQual nm
-		 -- otherwise, it's documented in the other module
-		 | otherwise = Qual mdl nm
-
-
 processImportDecl :: ModuleMap -> HsImportDecl -> [(HsName,HsQName)]
 processImportDecl mod_map (HsImportDecl _ mdl is_qualified maybe_as imp_specs)
     = case Map.lookup mdl mod_map of
@@ -920,6 +932,49 @@ processImportDecl mod_map (HsImportDecl _ mdl is_qualified maybe_as imp_specs)
 	    _ -> []
 
 -- -----------------------------------------------------------------------------
+
+-- | Build a mapping which for each original name, points to the "best"
+-- place to link to in the documentation.  For the definition of
+-- "best", we use "the module nearest the bottom of the dependency
+-- graph which exports this name", not including hidden modules.  When
+-- there are multiple choices, we pick a random one.
+-- 
+-- The interfaces are passed in in topologically sorted order, but we start
+-- by reversing the list so we can do a foldl.
+-- 
+buildGlobalDocEnv :: [Interface] -> Map HsQName HsQName
+buildGlobalDocEnv ifaces
+ = foldl upd Map.empty (reverse ifaces)
+ where
+  upd old_env iface
+     | OptHide `elem` iface_options iface
+     = old_env
+     | OptNotDefinitive `elem` iface_options iface
+     = foldl' keep_old old_env exported_names
+     | otherwise
+     = foldl' keep_new old_env exported_names
+     where
+	mdl = iface_module iface
+	exported_names = filter not_reexported (Map.elems (iface_env iface))
+
+	not_reexported (Qual _ n) = n `notElem` iface_reexported iface
+	not_reexported (UnQual n) = n `notElem` iface_reexported iface
+		-- UnQual probably shouldn't happen
+
+	keep_old env qnm = Map.insertWith const qnm (Qual mdl nm) env
+		where nm = nameOfQName qnm
+	keep_new env qnm = Map.insert qnm (Qual mdl nm) env 
+		where nm = nameOfQName qnm
+
+builtinDocEnv = Map.fromList (map (\a -> (a,a)) builtinNames)
+
+-- These names cannot be explicitly exported, so we need to treat
+-- them specially.
+builtinNames = 
+     [unit_tycon_qname, fun_tycon_qname, list_tycon_qname,
+      unit_con_name, nil_con_name]	
+
+-- -----------------------------------------------------------------------------
 -- Expand multiple type signatures
 
 expandDecl :: HsDecl -> [HsDecl]
@@ -1039,36 +1094,32 @@ sortModules mdls = mapM for_each_scc sccs
 -- -----------------------------------------------------------------------------
 -- Collect instances and attach them to declarations
 
-attachInstances :: [(Module,Interface)] -> [(Module,Interface)]
+attachInstances :: [Interface] -> [Interface]
 attachInstances mod_ifaces
   = map attach mod_ifaces
   where
   inst_map = collectInstances mod_ifaces
 
-  attach (mod,iface) = (mod, iface{ iface_exports = new_exports })
+  attach iface = iface{ iface_orig_exports = new_exports }
    where
-	new_exports = map attach_export (iface_exports iface)
-
-	rename_insts :: [InstHead] -> [InstHead]
-	rename_insts insts = fst (runRnFM (iface_import_env iface)
-				    (mapM renameInstHead insts))
+	new_exports = map attach_export (iface_orig_exports iface)
 
 	attach_export (ExportDecl nm decl _) =
 	    ExportDecl nm decl (case Map.lookup nm inst_map of
 				  Nothing -> []
-				  Just instheads -> rename_insts instheads)
+				  Just instheads -> instheads)
 	attach_export other_export =
 	    other_export
 
-collectInstances
-   :: [(Module,Interface)]
+collectInstances 
+   :: [Interface]
    -> Map HsQName [InstHead]  -- maps class/type names to instances
 
-collectInstances mod_ifaces
+collectInstances ifaces
   = Map.fromListWith (flip (++)) ty_inst_pairs `Map.union`
     Map.fromListWith (flip (++)) class_inst_pairs
   where
-    all_instances = concat (map (iface_insts.snd) mod_ifaces)
+    all_instances = concat (map iface_insts ifaces)
 
     class_inst_pairs = [ (cls, [(ctxt,(cls,args))])
 		       | HsInstDecl _ ctxt (cls,args) _ <- all_instances ]
@@ -1085,10 +1136,15 @@ collectInstances mod_ifaces
 -- FormatVersion hack to work out which one the interface file contains.
 
 thisFormatVersion :: FormatVersion
-thisFormatVersion = mkFormatVersion 1
+thisFormatVersion = mkFormatVersion 2
 
 -- | How we store interfaces.  Not everything is stored.
-type StoredInterface =
+type StoredInterface2 =
+   (Module,Maybe Doc,Maybe String,Bool,[(HsName,Module)],[HsName],
+      [(HsName,[HsName])])
+
+-- | How we store interfaces.  Not everything is stored.
+type StoredInterface1 =
    (Module,Maybe Doc,Maybe String,Bool,[(HsName,HsQName)],[(HsName,HsQName)],
       [(HsName,[HsName])])
 
@@ -1097,60 +1153,94 @@ type NullVersionStoredInterface =
    (Module,Maybe String,Bool,[(HsName,HsQName)],[(HsName,HsQName)],
       [(HsName,[HsName])])
 
-dumpInterfaces :: [(Module,Interface)] -> FilePath -> IO ()
-dumpInterfaces interfaces fileName =
+dumpInterfaces :: [Interface] -> Map HsQName HsQName -> FilePath -> IO ()
+dumpInterfaces interfaces global_doc_env fileName =
    do
       let
-         preparedInterfaces :: [StoredInterface]
+         preparedInterfaces :: [StoredInterface2]
          preparedInterfaces = map from_interface interfaces
 
       bh <- openBinMem 100000
       put_ bh thisFormatVersion
       put_ bh preparedInterfaces
+      putDocEnv bh global_doc_env
       writeBinMem bh fileName
 
 
-readIface :: FilePath -> IO [(Module,Interface)]
+readIface :: FilePath -> IO ([Interface], Map HsQName HsQName)
 readIface fileName = do
    bh <- readBinMem fileName
    formatVersion <- get bh
-   if formatVersion == thisFormatVersion
-      then
-         do
-            (stuff :: [StoredInterface]) <- get bh
-            return (map to_interface stuff)
-      else
-         if formatVersion == nullFormatVersion
-            then
-               do
-                  (stuff :: [NullVersionStoredInterface]) <- get bh
-                  return (map nullVersion_to_interface stuff)
-               else
-                  do
-                     noDieMsg (
-                        "Warning: The interface file " ++ show fileName 
-                           ++ " could not be read.\n"
-                           ++ "Maybe it's from a later version of Haddock?\n")
-                     return [] 
-
-from_interface :: (Module,Interface) -> StoredInterface
-from_interface (mdl,iface) =
-   (mdl, toDescription iface,iface_package iface,
+   case formatVersion of
+     v | v == thisFormatVersion -> do
+            (stuff :: [StoredInterface2]) <- get bh
+	    doc_env <- getDocEnv bh
+            return (map to_interface2 stuff, doc_env)
+     v | v == mkFormatVersion 1 -> do
+            (stuff :: [StoredInterface1]) <- get bh
+            return (map to_interface1 stuff, Map.empty)
+     v | v == nullFormatVersion -> do
+            (stuff :: [NullVersionStoredInterface]) <- get bh
+            return (map nullVersion_to_interface stuff, Map.empty)
+     otherwise -> do
+            noDieMsg (
+               "Warning: The interface file " ++ show fileName 
+                  ++ " could not be read.\n"
+                  ++ "Maybe it's from a later version of Haddock?\n")
+            return ([], Map.empty)
+
+from_interface :: Interface -> StoredInterface2
+from_interface iface =
+   (  iface_module iface,
+      toDescription iface,iface_package iface,
       OptHide `elem` iface_options iface,
-      Map.toAscList (iface_env iface), 
-      Map.toAscList (iface_reexported iface),
+      [(n,mdl) | (n,Qual mdl n') <- Map.toAscList (iface_env iface),
+		 if n /= n' then error "help!" else True], 
+      iface_reexported iface,
       Map.toAscList (iface_sub iface)
       )
 
-to_interface :: StoredInterface -> (Module,Interface)
-to_interface (mdl,descriptionOpt,package, hide, env, reexported, sub) = 
-   (mdl, Interface { 
+getDocEnv :: BinHandle -> IO (Map HsQName HsQName)
+getDocEnv bh = do
+   doc_env_list <- get bh
+   return (Map.fromList [(Qual mdl1 nm,Qual mdl2 nm) | 
+			 (mdl1,nm,mdl2) <- doc_env_list])
+
+putDocEnv :: BinHandle -> Map HsQName HsQName -> IO ()
+putDocEnv bh env = do
+   let doc_env_list = 
+	 [(mdl1,nm,mdl2) | (Qual mdl1 nm, Qual mdl2 _) <- Map.toAscList env]
+   put_ bh doc_env_list
+  
+
+to_interface1 :: StoredInterface1 -> Interface
+to_interface1 (mdl,descriptionOpt,package, hide, env, reexported, sub) = 
+   Interface { 
+      iface_module	 = mdl,
       iface_filename     = "",
       iface_package      = package,
       iface_env          = Map.fromList env,
-      iface_import_env   = Map.empty,
       iface_sub          = Map.fromList sub,
-      iface_reexported   = Map.fromList reexported,
+      iface_reexported   = map fst reexported,
+      iface_exports      = [],
+      iface_orig_exports = [],
+      iface_insts        = [],
+      iface_decls        = Map.empty,
+      iface_info         = toModuleInfo descriptionOpt,
+      iface_doc          = Nothing,
+      iface_options      = if hide then [OptHide] else []
+      }
+
+to_interface2 :: StoredInterface2 -> Interface
+to_interface2 (mdl,descriptionOpt,package, hide, env, reexported, sub) =
+   Interface { 
+      iface_module	 = mdl,
+      iface_filename     = "",
+      iface_package      = package,
+      iface_env          = 
+	Map.fromList [(n,Qual mdl n) | (n,mdl) <- env],
+      iface_sub          = Map.fromList sub,
+      iface_reexported   = reexported,
       iface_exports      = [],
       iface_orig_exports = [],
       iface_insts        = [],
@@ -1158,17 +1248,17 @@ to_interface (mdl,descriptionOpt,package, hide, env, reexported, sub) =
       iface_info         = toModuleInfo descriptionOpt,
       iface_doc          = Nothing,
       iface_options      = if hide then [OptHide] else []
-      })
+      }
 
-nullVersion_to_interface :: NullVersionStoredInterface -> (Module,Interface)
+nullVersion_to_interface :: NullVersionStoredInterface -> Interface
 nullVersion_to_interface (mdl, package, hide, env, reexported, sub) = 
-   (mdl, Interface { 
+   Interface { 
+      iface_module	 = mdl,
       iface_filename     = "",
       iface_package      = package,
       iface_env          = Map.fromList env,
-      iface_import_env   = Map.empty,
       iface_sub          = Map.fromList sub,
-      iface_reexported   = Map.fromList reexported,
+      iface_reexported   = map fst reexported,
       iface_exports      = [],
       iface_orig_exports = [],
       iface_insts        = [],
@@ -1176,7 +1266,7 @@ nullVersion_to_interface (mdl, package, hide, env, reexported, sub) =
       iface_info         = emptyModuleInfo,
       iface_doc          = Nothing,
       iface_options      = if hide then [OptHide] else []
-      })
+      }
 
 toModuleInfo :: Maybe Doc -> ModuleInfo
 toModuleInfo descriptionOpt = 
diff --git a/src/Map.hs b/src/Map.hs
index 173d4fcf..8e59f83e 100644
--- a/src/Map.hs
+++ b/src/Map.hs
@@ -34,13 +34,13 @@ insert :: Ord k => k -> a -> Map k a -> Map k a
 insert k a m = addToFM m k a
 
 insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
-insertWith c k a m = addToFM_C c m k a
+insertWith c k a m = addToFM_C (flip c) m k a
 
 union :: Ord k => Map k a -> Map k a -> Map k a
 union = flip plusFM
 
 unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
-unionWith c l r = plusFM_C c r l
+unionWith c l r = plusFM_C (flip c) r l
 
 unions :: Ord k => [Map k a] -> Map k a
 unions = foldl (flip plusFM) emptyFM