-Why stop if errors in the first three passes: Suppose you're compiling
-a module with a top-level definition named \tr{scaleFloat}. Sadly,
-this is also a Prelude class-method name. \tr{rnModule3} will have
-detected this error, but: it will also have picked (arbitrarily) one
-of the two definitions for its final ``value'' name-function. If, by
-chance, it should have picked the class-method... when it comes to pin
-a Unique on the top-level (bogus) \tr{scaleFloat}, it will ask for the
-class-method's Unique (!); it doesn't have one, and you will get a
-panic.
-
-Another way to handle this would be for the duplicate detector to
-clobber duplicates with some ``safe'' value. Then things would be
-fine in \tr{rnModule4}. Maybe some other time...
+\begin{code}
+makeHiMap :: Maybe String -> IO (FiniteMap Module FilePath)
+
+makeHiMap Nothing = error "Rename.makeHiMap:no .hi map given by the GHC driver (?)"
+makeHiMap (Just f)
+ = readFile f >>= \ cts ->
+ return (snag_mod emptyFM cts [])
+ where
+ -- we alternate between "snag"ging mod(ule names) and path(names),
+ -- accumulating names (reversed) and the final resulting map
+ -- as we move along.
+
+ snag_mod map [] [] = map
+ snag_mod map (' ':cs) rmod = snag_path map (_PK_ (reverse rmod)) cs []
+ snag_mod map (c:cs) rmod = snag_mod map cs (c:rmod)
+
+ snag_path map mod [] rpath = addToFM map mod (reverse rpath)
+ snag_path map mod ('\n':cs) rpath = snag_mod (addToFM map mod (reverse rpath)) cs []
+ snag_path map mod (c:cs) rpath = snag_path map mod cs (c:rpath)
+\end{code}
+
+\begin{code}
+{- TESTING:
+pprPIface (ParsedIface m ?? v mv usgs lcm exm ims lfx ltdm lvdm lids ldp)
+ = ppAboves [
+ ppCat [ppPStr SLIT("interface"), ppPStr m, ppInt v,
+ case mv of { Nothing -> ppNil; Just n -> ppInt n }],
+
+ ppPStr SLIT("__versions__"),
+ ppAboves [ ppCat[ppPStr n, ppInt v] | (n,v) <- fmToList lcm ],
+
+ ppPStr SLIT("__exports__"),
+ ppAboves [ ppBesides[ppPStr n, ppSP, ppr PprDebug rn,
+ case ex of {ExportAll -> ppStr "(..)"; _ -> ppNil}]
+ | (n,(rn,ex)) <- fmToList exm ],
+
+ pp_ims (bagToList ims),
+ pp_fixities lfx,
+ pp_decls ltdm lvdm,
+ pp_insts (bagToList lids),
+ pp_pragmas ldp
+ ]
+ where
+ pp_ims [] = ppNil
+ pp_ims ms = ppAbove (ppPStr SLIT("__instance_modules__"))
+ (ppCat (map ppPStr ms))
+
+ pp_fixities fx
+ | isEmptyFM fx = ppNil
+ | otherwise = ppAboves (ppPStr SLIT("__fixities__")
+ : [ ppr PprDebug fix | (n, fix) <- fmToList fx])
+
+ pp_decls tds vds = ppAboves (ppPStr SLIT("__declarations__")
+ : [ pprRdrIfaceDecl d | (n, d) <- fmToList tds ++ fmToList vds])
+
+ pp_insts [] = ppNil
+ pp_insts is = ppAboves (ppPStr SLIT("__instances__")
+ : [ pprRdrInstDecl i | i <- is])
+
+ pp_pragmas ps | isEmptyFM ps = ppNil
+ | otherwise = panic "Rename.pp_pragmas"
+
+pprRdrIfaceDecl (TypeSig tc _ decl)
+ = ppBesides [ppStr "tycon=", ppr PprDebug tc, ppStr "; ", ppr PprDebug decl]
+
+pprRdrIfaceDecl (NewTypeSig tc dc _ decl)
+ = ppBesides [ppStr "tycon=", ppr PprDebug tc, ppStr "; datacon=", ppr PprDebug dc,
+ ppStr "; ", ppr PprDebug decl]
+
+pprRdrIfaceDecl (DataSig tc dcs dfs _ decl)
+ = ppBesides [ppStr "tycon=", ppr PprDebug tc, ppStr "; datacons=", ppr PprDebug dcs,
+ ppStr "; fields=", ppr PprDebug dfs, ppStr "; ", ppr PprDebug decl]
+
+pprRdrIfaceDecl (ClassSig c ops _ decl)
+ = ppBesides [ppStr "class=", ppr PprDebug c, ppStr "; ops=", ppr PprDebug ops,
+ ppStr "; ", ppr PprDebug decl]
+
+pprRdrIfaceDecl (ValSig f _ ty)
+ = ppBesides [ppr PprDebug f, ppStr " :: ", ppr PprDebug ty]
+
+pprRdrInstDecl (InstSig c t _ decl)
+ = ppBesides [ppStr "class=", ppr PprDebug c, ppStr " type=", ppr PprDebug t, ppStr "; ",
+ ppr PprDebug decl]
+-}
+\end{code}