X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FRdrName.lhs;h=5e184973ff3f084d5e8d30bd630129bb9f723885;hb=aca3dd74dac482e77e34058c4003df5387487aaa;hp=be60d03d5185924c4a74f92b4656ee9a28e3240a;hpb=72f807235dbed81e2610f3be280f6467cdf31a58;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs
index be60d03..5e18497 100644
--- a/compiler/basicTypes/RdrName.lhs
+++ b/compiler/basicTypes/RdrName.lhs
@@ -29,7 +29,7 @@ module RdrName (
 	lookupGlobalRdrEnv, extendGlobalRdrEnv,
 	pprGlobalRdrEnv, globalRdrEnvElts,
 	lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes,
-        hideSomeUnquals,
+        hideSomeUnquals, findLocalDupsRdrEnv,
 
 	-- GlobalRdrElt, Provenance, ImportSpec
 	GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK,
@@ -323,7 +323,7 @@ data Parent = NoParent | ParentIs Name
 
 instance Outputable Parent where
    ppr NoParent     = empty
-   ppr (ParentIs n) = ptext SLIT("parent:") <> ppr n
+   ppr (ParentIs n) = ptext (sLit "parent:") <> ppr n
    
 
 plusParent :: Parent -> Parent -> Parent
@@ -334,11 +334,11 @@ plusParent p1 p2 = ASSERT2( p1 == p2, parens (ppr p1) <+> parens (ppr p2) )
 plusParent :: Parent -> Parent -> Parent
 plusParent NoParent     rel = 
   ASSERT2( case rel of { NoParent -> True; other -> False }, 
-	   ptext SLIT("plusParent[NoParent]: ") <+> ppr rel )    
+	   ptext (sLit "plusParent[NoParent]: ") <+> ppr rel )    
   NoParent
 plusParent (ParentIs n) rel = 
   ASSERT2( case rel of { ParentIs m -> n==m;  other -> False }, 
-	   ptext SLIT("plusParent[ParentIs]:") <+> ppr n <> comma <+> ppr rel )
+	   ptext (sLit "plusParent[ParentIs]:") <+> ppr n <> comma <+> ppr rel )
   ParentIs n
  -}
 
@@ -463,6 +463,27 @@ mkGlobalRdrEnv gres
 				 (nameOccName (gre_name gre)) 
 				 [gre]
 
+findLocalDupsRdrEnv :: GlobalRdrEnv -> [OccName] -> (GlobalRdrEnv, [[Name]])
+-- For each OccName, see if there are multiple LocalDef definitions
+-- for it.  If so, remove all but one (to suppress subsequent error messages)
+-- and return a list of the duplicate bindings
+findLocalDupsRdrEnv rdr_env occs 
+  = go rdr_env [] occs
+  where
+    go rdr_env dups [] = (rdr_env, dups)
+    go rdr_env dups (occ:occs)
+      = case filter isLocalGRE gres of
+	  []       -> WARN( True, ppr occ <+> ppr rdr_env ) 
+		      go rdr_env dups occs	-- Weird!  No binding for occ
+	  [_]      -> go rdr_env dups occs	-- The common case
+	  dup_gres -> go (extendOccEnv rdr_env occ (head dup_gres : nonlocal_gres))
+   		         (map gre_name dup_gres : dups)
+			 occs
+      where
+        gres = lookupOccEnv rdr_env occ `orElse` []
+	nonlocal_gres = filterOut isLocalGRE gres
+
+
 insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
 insertGRE new_g [] = [new_g]
 insertGRE new_g (old_g : old_gs)
@@ -610,7 +631,7 @@ plusProv (Imported is1)  (Imported is2)  = Imported (is1++is2)
 pprNameProvenance :: GlobalRdrElt -> SDoc
 -- Print out the place where the name was imported
 pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef})
-  = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
+  = ptext (sLit "defined at") <+> ppr (nameSrcLoc name)
 pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys})
   = case whys of
 	(why:_) -> sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))]
@@ -619,13 +640,13 @@ pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys})
 -- If we know the exact definition point (which we may do with GHCi)
 -- then show that too.  But not if it's just "imported from X".
 ppr_defn :: SrcLoc -> SDoc
-ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc)
+ppr_defn loc | isGoodSrcLoc loc = parens (ptext (sLit "defined at") <+> ppr loc)
 	     | otherwise	= empty
 
 instance Outputable ImportSpec where
    ppr imp_spec
-     = ptext SLIT("imported from") <+> ppr (importSpecModule imp_spec) 
-	<+> if isGoodSrcSpan loc then ptext SLIT("at") <+> ppr loc
+     = ptext (sLit "imported from") <+> ppr (importSpecModule imp_spec) 
+	<+> if isGoodSrcSpan loc then ptext (sLit "at") <+> ppr loc
 				 else empty
      where
        loc = importSpecLoc imp_spec