[project @ 2004-09-03 15:28:18 by simonmar]

[ghc-hetmet.git] / ghc / compiler / basicTypes / RdrName.lhs

diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs
index 62132c3..a4e34d4 100644 (file)
--- a/ghc/compiler/basicTypes/RdrName.lhs
+++ b/ghc/compiler/basicTypes/RdrName.lhs
@@ -50,9 +50,7 @@ import OccName        ( NameSpace, varName,
 import Module   ( ModuleName, mkModuleNameFS   )
 import Name    ( Name, NamedThing(getName), nameModuleName, nameParent_maybe,
                  nameOccName, isExternalName, nameSrcLoc )
-import Maybes  ( seqMaybe )
 import SrcLoc  ( isGoodSrcLoc, SrcSpan )
-import BasicTypes( DeprecTxt )
 import Outputable
 import Util    ( thenCmp )
 \end{code}
@@ -88,7 +86,7 @@ data RdrName
        --  (b) when converting names to the RdrNames in IfaceTypes
        --      Here an Exact RdrName always contains an External Name
        --      (Internal Names are converted to simple Unquals)
-       --  (c) possibly, by the meta-programming stuff
+       --  (c) by Template Haskell, when TH has generated a unique name
 \end{code}
 
 
@@ -212,7 +210,7 @@ instance Outputable RdrName where
     ppr (Qual mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
     ppr (Orig mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
 
-ppr_name_space occ = ifPprDebug (parens (text (occNameFlavour occ)))
+ppr_name_space occ = ifPprDebug (parens (occNameFlavour occ))
 
 instance OutputableBndr RdrName where
     pprBndr _ n 
@@ -236,21 +234,28 @@ instance Ord RdrName where
     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
     a >         b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 
-       -- Unqual < Qual < Orig
-       -- We always convert Exact to Orig before comparing
-    compare (Exact n1) (Exact n2) | n1==n2 = EQ        -- Short cut
-                                 | otherwise = nukeExact n1 `compare` nukeExact n2
-    compare (Exact n1) n2                    = nukeExact n1 `compare` n2
-    compare n1       (Exact n2)              = n1 `compare` nukeExact n2
-
-
-    compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2) 
-    compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2) 
+       -- Exact < Unqual < Qual < Orig
+       -- [Note: Apr 2004] We used to use nukeExact to convert Exact to Orig 
+       --      before comparing so that Prelude.map == the exact Prelude.map, but 
+       --      that meant that we reported duplicates when renaming bindings 
+       --      generated by Template Haskell; e.g 
+       --      do { n1 <- newName "foo"; n2 <- newName "foo"; 
+       --           <decl involving n1,n2> }
+       --      I think we can do without this conversion
+    compare (Exact n1) (Exact n2) = n1 `compare` n2
+    compare (Exact n1) n2        = LT
+
+    compare (Unqual _)   (Exact _)    = GT
     compare (Unqual o1)  (Unqual  o2) = o1 `compare` o2
- 
     compare (Unqual _)   _           = LT
+
+    compare (Qual _ _)   (Exact _)    = GT
+    compare (Qual _ _)   (Unqual _)   = GT
+    compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2) 
     compare (Qual _ _)   (Orig _ _)   = LT
-    compare _           _            = GT
+
+    compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2) 
+    compare (Orig _ _)   _           = GT
 \end{code}
 
 
@@ -312,8 +317,7 @@ globalRdrEnvElts env = foldOccEnv (++) [] env
 
 data GlobalRdrElt 
   = GRE { gre_name   :: Name,
-         gre_prov   :: Provenance,     -- Why it's in scope
-         gre_deprec :: Maybe DeprecTxt -- Whether this name is deprecated
+         gre_prov   :: Provenance      -- Why it's in scope
     }
 
 instance Outputable GlobalRdrElt where
@@ -391,11 +395,8 @@ insertGRE new_g (old_g : old_gs)
 plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
 -- Used when the gre_name fields match
 plusGRE g1 g2
-  = GRE { gre_name   = gre_name g1,
-         gre_prov   = gre_prov g1 `plusProv` gre_prov g2,
-         gre_deprec = gre_deprec g1 `seqMaybe` gre_deprec g2 }
-       -- Could the deprecs be different?  If we re-export
-       -- something deprecated, is it propagated?  I forget.
+  = GRE { gre_name = gre_name g1,
+         gre_prov = gre_prov g1 `plusProv` gre_prov g2 }
 \end{code}
 
 
@@ -475,11 +476,13 @@ pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef _})
 pprNameProvenance (GRE {gre_name = name, gre_prov = Imported (why:whys) _})
   = sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))]
 
+-- 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 loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc)
+            | otherwise        = empty
+
 instance Outputable ImportSpec where
    ppr imp_spec
      = ptext SLIT("imported from") <+> ppr (is_mod imp_spec) 
        <+> ptext SLIT("at") <+> ppr (is_loc imp_spec)
-
-ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc)
-            | otherwise        = empty
 \end{code}