[project @ 2005-03-31 10:16:33 by simonmar]
[ghc-hetmet.git] / ghc / compiler / basicTypes / RdrName.lhs
index df4b4d1..2dca6a0 100644 (file)
@@ -10,11 +10,9 @@ module RdrName (
 
        -- Construction
        mkRdrUnqual, mkRdrQual, 
-       mkUnqual, mkVarUnqual, mkQual, mkOrig, mkIfaceOrig, 
+       mkUnqual, mkVarUnqual, mkQual, mkOrig,
        nameRdrName, getRdrName, 
-       qualifyRdrName, unqualifyRdrName, 
        mkDerivedRdrName, 
-       dummyRdrVarName, dummyRdrTcName,
 
        -- Destruction
        rdrNameModule, rdrNameOcc, setRdrNameSpace,
@@ -22,7 +20,6 @@ module RdrName (
        isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
 
        -- Printing;    instance Outputable RdrName
-       pprUnqualRdrName,
 
        -- LocalRdrEnv
        LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv,
@@ -35,27 +32,25 @@ module RdrName (
 
        -- GlobalRdrElt, Provenance, ImportSpec
        GlobalRdrElt(..), Provenance(..), ImportSpec(..),
-       isLocalGRE, unQualOK, hasQual,
+       isLocalGRE, unQualOK,
        pprNameProvenance
   ) where 
 
 #include "HsVersions.h"
 
-import OccName ( NameSpace, tcName, varName,
-                 OccName, UserFS, EncodedFS,
-                 mkSysOccFS, setOccNameSpace,
-                 mkOccFS, mkVarOcc, occNameFlavour,
+import OccName ( NameSpace, varName,
+                 OccName, UserFS, 
+                 setOccNameSpace,
+                 mkOccFS, occNameFlavour,
                  isDataOcc, isTvOcc, isTcOcc,
                  OccEnv, emptyOccEnv, extendOccEnvList, lookupOccEnv, 
                  elemOccEnv, plusOccEnv_C, extendOccEnv_C, foldOccEnv,
                  occEnvElts
                )
-import Module   ( ModuleName, mkSysModuleNameFS, mkModuleNameFS        )
-import Name    ( Name, NamedThing(getName), nameModuleName, nameParent_maybe,
+import Module   ( Module, mkModuleFS )
+import Name    ( Name, NamedThing(getName), nameModule, nameParent_maybe,
                  nameOccName, isExternalName, nameSrcLoc )
-import Maybes  ( seqMaybe )
-import SrcLoc  ( SrcLoc, isGoodSrcLoc )
-import BasicTypes( DeprecTxt )
+import SrcLoc  ( isGoodSrcLoc, SrcSpan )
 import Outputable
 import Util    ( thenCmp )
 \end{code}
@@ -72,13 +67,13 @@ data RdrName
   = Unqual OccName
        -- Used for ordinary, unqualified occurrences 
 
-  | Qual ModuleName OccName
+  | Qual Module OccName
        -- A qualified name written by the user in 
-       -- *source* code.  The module isn't necessarily 
+       --  *source* code.  The module isn't necessarily 
        -- the module where the thing is defined; 
        -- just the one from which it is imported
 
-  | Orig ModuleName OccName
+  | Orig Module OccName
        -- An original name; the module is the *defining* module.
        -- This is used when GHC generates code that will be fed
        -- into the renamer (e.g. from deriving clauses), but where
@@ -91,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}
 
 
@@ -102,10 +97,10 @@ data RdrName
 %************************************************************************
 
 \begin{code}
-rdrNameModule :: RdrName -> ModuleName
+rdrNameModule :: RdrName -> Module
 rdrNameModule (Qual m _) = m
 rdrNameModule (Orig m _) = m
-rdrNameModule (Exact n)  = nameModuleName n
+rdrNameModule (Exact n)  = nameModule n
 rdrNameModule (Unqual n) = pprPanic "rdrNameModule" (ppr n)
 
 rdrNameOcc :: RdrName -> OccName
@@ -126,7 +121,7 @@ setRdrNameSpace :: RdrName -> NameSpace -> RdrName
 setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
 setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
 setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
-setRdrNameSpace (Exact n)    ns = Orig (nameModuleName n)
+setRdrNameSpace (Exact n)    ns = Orig (nameModule n)
                                       (setOccNameSpace ns (nameOccName n))
 \end{code}
 
@@ -135,19 +130,16 @@ setRdrNameSpace (Exact n)    ns = Orig (nameModuleName n)
 mkRdrUnqual :: OccName -> RdrName
 mkRdrUnqual occ = Unqual occ
 
-mkRdrQual :: ModuleName -> OccName -> RdrName
+mkRdrQual :: Module -> OccName -> RdrName
 mkRdrQual mod occ = Qual mod occ
 
-mkOrig :: ModuleName -> OccName -> RdrName
+mkOrig :: Module -> OccName -> RdrName
 mkOrig mod occ = Orig mod occ
 
-mkIfaceOrig :: NameSpace -> EncodedFS -> EncodedFS -> RdrName
-mkIfaceOrig ns m n = Orig (mkSysModuleNameFS m) (mkSysOccFS ns n)
-
 ---------------
 mkDerivedRdrName :: Name -> (OccName -> OccName) -> (RdrName)
 mkDerivedRdrName parent mk_occ
-  = mkOrig (nameModuleName parent) (mk_occ (nameOccName parent))
+  = mkOrig (nameModule parent) (mk_occ (nameOccName parent))
 
 ---------------
        -- These two are used when parsing source files
@@ -159,7 +151,7 @@ mkVarUnqual :: UserFS -> RdrName
 mkVarUnqual n = Unqual (mkOccFS varName n)
 
 mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
-mkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccFS sp n)
+mkQual sp (m, n) = Qual (mkModuleFS m) (mkOccFS sp n)
 
 getRdrName :: NamedThing thing => thing -> RdrName
 getRdrName name = nameRdrName (getName name)
@@ -170,31 +162,13 @@ nameRdrName name = Exact name
 -- unique is still there for debug printing, particularly
 -- of Types (which are converted to IfaceTypes before printing)
 
-qualifyRdrName :: ModuleName -> RdrName -> RdrName
-       -- Sets the module name of a RdrName, even if it has one already
-qualifyRdrName mod rn = Qual mod (rdrNameOcc rn)
-
-unqualifyRdrName :: RdrName -> RdrName
-unqualifyRdrName rdr_name = Unqual (rdrNameOcc rdr_name)
-
 nukeExact :: Name -> RdrName
 nukeExact n 
-  | isExternalName n = Orig (nameModuleName n) (nameOccName n)
+  | isExternalName n = Orig (nameModule n) (nameOccName n)
   | otherwise       = Unqual (nameOccName n)
 \end{code}
 
 \begin{code}
-       -- This guy is used by the reader when HsSyn has a slot for
-       -- an implicit name that's going to be filled in by
-       -- the renamer.  We can't just put "error..." because
-       -- we sometimes want to print out stuff after reading but
-       -- before renaming
-dummyRdrVarName = Unqual (mkVarOcc FSLIT("V-DUMMY"))
-dummyRdrTcName  = Unqual (mkOccFS tcName FSLIT("TC-DUMMY"))
-\end{code}
-
-
-\begin{code}
 isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
 isRdrTyVar   rn = isTvOcc   (rdrNameOcc rn)
 isRdrTc      rn = isTcOcc   (rdrNameOcc rn)
@@ -236,15 +210,13 @@ 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 
        | isTvOcc (rdrNameOcc n) = char '@' <+> ppr n
        | otherwise              = ppr n
 
-pprUnqualRdrName rdr_name = ppr (rdrNameOcc rdr_name)
-
 instance Eq RdrName where
     (Exact n1)           == (Exact n2)    = n1==n2
        -- Convert exact to orig
@@ -262,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}
 
 
@@ -338,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
@@ -390,7 +368,7 @@ unQualOK :: GlobalRdrElt -> Bool
 unQualOK (GRE {gre_prov = LocalDef _})    = True
 unQualOK (GRE {gre_prov = Imported is _}) = not (all is_qual is)
 
-hasQual :: ModuleName -> GlobalRdrElt -> Bool
+hasQual :: Module -> GlobalRdrElt -> Bool
 -- A qualified version of this thing is in scope
 hasQual mod (GRE {gre_prov = LocalDef m})    = m == mod
 hasQual mod (GRE {gre_prov = Imported is _}) = any ((== mod) . is_as) is
@@ -417,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}
 
 
@@ -436,7 +411,7 @@ The "provenance" of something says how it came to be in scope.
 \begin{code}
 data Provenance
   = LocalDef           -- Defined locally
-       ModuleName
+       Module
 
   | Imported           -- Imported
        [ImportSpec]    -- INVARIANT: non-empty
@@ -454,12 +429,12 @@ data ImportSpec           -- Describes a particular import declaration
                        -- Shared among all the Provenaces for a particular
                        -- import declaration
   = ImportSpec {
-       is_mod  :: ModuleName,          -- 'import Muggle'
+       is_mod  :: Module,              -- 'import Muggle'
                                        -- Note the Muggle may well not be 
                                        -- the defining module for this thing!
-       is_as   :: ModuleName,          -- 'as M' (or 'Muggle' if there is no 'as' clause)
+       is_as   :: Module,              -- 'as M' (or 'Muggle' if there is no 'as' clause)
        is_qual :: Bool,                -- True <=> qualified (only)
-       is_loc  :: SrcLoc }             -- Location of import statment
+       is_loc  :: SrcSpan }            -- Location of import statment
 
 -- Comparison of provenance is just used for grouping 
 -- error messages (in RnEnv.warnUnusedBinds)
@@ -499,12 +474,15 @@ pprNameProvenance :: GlobalRdrElt -> SDoc
 pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef _})
   = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
 pprNameProvenance (GRE {gre_name = name, gre_prov = Imported (why:whys) _})
-  = sep [ppr_reason why, nest 2 (ppr_defn (nameSrcLoc name))]
-
-ppr_reason imp_spec
- = ptext SLIT("imported from") <+> ppr (is_mod imp_spec) 
-       <+> ptext SLIT("at") <+> ppr (is_loc imp_spec)
+  = 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)
 \end{code}