ghc/compiler/basicTypes/RdrName.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4
   5 \section[RdrName]{@RdrName@}
   6
   7 \begin{code}
   8 module RdrName (
   9         RdrName(..),    -- Constructors exported only to BinIface
  10
  11         -- Construction
  12         mkRdrUnqual, mkRdrQual,
  13         mkUnqual, mkVarUnqual, mkQual, mkOrig,
  14         nameRdrName, getRdrName,
  15         mkDerivedRdrName,
  16
  17         -- Destruction
  18         rdrNameModule, rdrNameOcc, setRdrNameSpace,
  19         isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isUnqual,
  20         isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
  21
  22         -- Printing;    instance Outputable RdrName
  23
  24         -- LocalRdrEnv
  25         LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv,
  26         lookupLocalRdrEnv, elemLocalRdrEnv,
  27
  28         -- GlobalRdrEnv
  29         GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
  30         lookupGlobalRdrEnv, pprGlobalRdrEnv, globalRdrEnvElts,
  31         lookupGRE_RdrName, lookupGRE_Name,
  32
  33         -- GlobalRdrElt, Provenance, ImportSpec
  34         GlobalRdrElt(..), Provenance(..), ImportSpec(..),
  35         isLocalGRE, unQualOK,
  36         pprNameProvenance
  37   ) where
  38
  39 #include "HsVersions.h"
  40
  41 import OccName  ( NameSpace, varName,
  42                   OccName, UserFS,
  43                   setOccNameSpace,
  44                   mkOccFS, occNameFlavour,
  45                   isDataOcc, isTvOcc, isTcOcc,
  46                   OccEnv, emptyOccEnv, extendOccEnvList, lookupOccEnv,
  47                   elemOccEnv, plusOccEnv_C, extendOccEnv_C, foldOccEnv,
  48                   occEnvElts
  49                 )
  50 import Module   ( ModuleName, mkModuleNameFS    )
  51 import Name     ( Name, NamedThing(getName), nameModuleName, nameParent_maybe,
  52                   nameOccName, isExternalName, nameSrcLoc )
  53 import SrcLoc   ( isGoodSrcLoc, SrcSpan )
  54 import Outputable
  55 import Util     ( thenCmp )
  56 \end{code}
  57
  58
  59 %************************************************************************
  60 %*                                                                      *
  61 \subsection{The main data type}
  62 %*                                                                      *
  63 %************************************************************************
  64
  65 \begin{code}
  66 data RdrName
  67   = Unqual OccName
  68         -- Used for ordinary, unqualified occurrences
  69
  70   | Qual ModuleName OccName
  71         -- A qualified name written by the user in
  72         -- *source* code.  The module isn't necessarily
  73         -- the module where the thing is defined;
  74         -- just the one from which it is imported
  75
  76   | Orig ModuleName OccName
  77         -- An original name; the module is the *defining* module.
  78         -- This is used when GHC generates code that will be fed
  79         -- into the renamer (e.g. from deriving clauses), but where
  80         -- we want to say "Use Prelude.map dammit".
  81
  82   | Exact Name
  83         -- We know exactly the Name. This is used
  84         --  (a) when the parser parses built-in syntax like "[]"
  85         --      and "(,)", but wants a RdrName from it
  86         --  (b) when converting names to the RdrNames in IfaceTypes
  87         --      Here an Exact RdrName always contains an External Name
  88         --      (Internal Names are converted to simple Unquals)
  89         --  (c) possibly, by the meta-programming stuff
  90 \end{code}
  91
  92
  93 %************************************************************************
  94 %*                                                                      *
  95 \subsection{Simple functions}
  96 %*                                                                      *
  97 %************************************************************************
  98
  99 \begin{code}
 100 rdrNameModule :: RdrName -> ModuleName
 101 rdrNameModule (Qual m _) = m
 102 rdrNameModule (Orig m _) = m
 103 rdrNameModule (Exact n)  = nameModuleName n
 104 rdrNameModule (Unqual n) = pprPanic "rdrNameModule" (ppr n)
 105
 106 rdrNameOcc :: RdrName -> OccName
 107 rdrNameOcc (Qual _ occ) = occ
 108 rdrNameOcc (Unqual occ) = occ
 109 rdrNameOcc (Orig _ occ) = occ
 110 rdrNameOcc (Exact name) = nameOccName name
 111
 112 setRdrNameSpace :: RdrName -> NameSpace -> RdrName
 113 -- This rather gruesome function is used mainly by the parser
 114 -- When parsing         data T a = T | T1 Int
 115 -- we parse the data constructors as *types* because of parser ambiguities,
 116 -- so then we need to change the *type constr* to a *data constr*
 117 --
 118 -- The original-name case *can* occur when parsing
 119 --              data [] a = [] | a : [a]
 120 -- For the orig-name case we return an unqualified name.
 121 setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
 122 setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
 123 setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
 124 setRdrNameSpace (Exact n)    ns = Orig (nameModuleName n)
 125                                        (setOccNameSpace ns (nameOccName n))
 126 \end{code}
 127
 128 \begin{code}
 129         -- These two are the basic constructors
 130 mkRdrUnqual :: OccName -> RdrName
 131 mkRdrUnqual occ = Unqual occ
 132
 133 mkRdrQual :: ModuleName -> OccName -> RdrName
 134 mkRdrQual mod occ = Qual mod occ
 135
 136 mkOrig :: ModuleName -> OccName -> RdrName
 137 mkOrig mod occ = Orig mod occ
 138
 139 ---------------
 140 mkDerivedRdrName :: Name -> (OccName -> OccName) -> (RdrName)
 141 mkDerivedRdrName parent mk_occ
 142   = mkOrig (nameModuleName parent) (mk_occ (nameOccName parent))
 143
 144 ---------------
 145         -- These two are used when parsing source files
 146         -- They do encode the module and occurrence names
 147 mkUnqual :: NameSpace -> UserFS -> RdrName
 148 mkUnqual sp n = Unqual (mkOccFS sp n)
 149
 150 mkVarUnqual :: UserFS -> RdrName
 151 mkVarUnqual n = Unqual (mkOccFS varName n)
 152
 153 mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
 154 mkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccFS sp n)
 155
 156 getRdrName :: NamedThing thing => thing -> RdrName
 157 getRdrName name = nameRdrName (getName name)
 158
 159 nameRdrName :: Name -> RdrName
 160 nameRdrName name = Exact name
 161 -- Keep the Name even for Internal names, so that the
 162 -- unique is still there for debug printing, particularly
 163 -- of Types (which are converted to IfaceTypes before printing)
 164
 165 nukeExact :: Name -> RdrName
 166 nukeExact n
 167   | isExternalName n = Orig (nameModuleName n) (nameOccName n)
 168   | otherwise        = Unqual (nameOccName n)
 169 \end{code}
 170
 171 \begin{code}
 172 isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
 173 isRdrTyVar   rn = isTvOcc   (rdrNameOcc rn)
 174 isRdrTc      rn = isTcOcc   (rdrNameOcc rn)
 175
 176 isSrcRdrName (Unqual _) = True
 177 isSrcRdrName (Qual _ _) = True
 178 isSrcRdrName _          = False
 179
 180 isUnqual (Unqual _) = True
 181 isUnqual other      = False
 182
 183 isQual (Qual _ _) = True
 184 isQual _          = False
 185
 186 isOrig (Orig _ _) = True
 187 isOrig _          = False
 188
 189 isOrig_maybe (Orig m n) = Just (m,n)
 190 isOrig_maybe _          = Nothing
 191
 192 isExact (Exact _) = True
 193 isExact other   = False
 194
 195 isExact_maybe (Exact n) = Just n
 196 isExact_maybe other     = Nothing
 197 \end{code}
 198
 199
 200 %************************************************************************
 201 %*                                                                      *
 202 \subsection{Instances}
 203 %*                                                                      *
 204 %************************************************************************
 205
 206 \begin{code}
 207 instance Outputable RdrName where
 208     ppr (Exact name)   = ppr name
 209     ppr (Unqual occ)   = ppr occ <+> ppr_name_space occ
 210     ppr (Qual mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
 211     ppr (Orig mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
 212
 213 ppr_name_space occ = ifPprDebug (parens (text (occNameFlavour occ)))
 214
 215 instance OutputableBndr RdrName where
 216     pprBndr _ n
 217         | isTvOcc (rdrNameOcc n) = char '@' <+> ppr n
 218         | otherwise              = ppr n
 219
 220 instance Eq RdrName where
 221     (Exact n1)    == (Exact n2)    = n1==n2
 222         -- Convert exact to orig
 223     (Exact n1)    == r2@(Orig _ _) = nukeExact n1 == r2
 224     r1@(Orig _ _) == (Exact n2)    = r1 == nukeExact n2
 225
 226     (Orig m1 o1)  == (Orig m2 o2)  = m1==m2 && o1==o2
 227     (Qual m1 o1)  == (Qual m2 o2)  = m1==m2 && o1==o2
 228     (Unqual o1)   == (Unqual o2)   = o1==o2
 229     r1 == r2 = False
 230
 231 instance Ord RdrName where
 232     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 233     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 234     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 235     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 236
 237         -- Unqual < Qual < Orig
 238         -- We always convert Exact to Orig before comparing
 239     compare (Exact n1) (Exact n2) | n1==n2 = EQ -- Short cut
 240                                   | otherwise = nukeExact n1 `compare` nukeExact n2
 241     compare (Exact n1) n2                     = nukeExact n1 `compare` n2
 242     compare n1        (Exact n2)              = n1 `compare` nukeExact n2
 243
 244
 245     compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
 246     compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
 247     compare (Unqual o1)  (Unqual  o2) = o1 `compare` o2
 248
 249     compare (Unqual _)   _            = LT
 250     compare (Qual _ _)   (Orig _ _)   = LT
 251     compare _            _            = GT
 252 \end{code}
 253
 254
 255
 256 %************************************************************************
 257 %*                                                                      *
 258                         LocalRdrEnv
 259 %*                                                                      *
 260 %************************************************************************
 261
 262 A LocalRdrEnv is used for local bindings (let, where, lambda, case)
 263 It is keyed by OccName, because we never use it for qualified names.
 264
 265 \begin{code}
 266 type LocalRdrEnv = OccEnv Name
 267
 268 emptyLocalRdrEnv = emptyOccEnv
 269
 270 extendLocalRdrEnv :: LocalRdrEnv -> [Name] -> LocalRdrEnv
 271 extendLocalRdrEnv env names
 272   = extendOccEnvList env [(nameOccName n, n) | n <- names]
 273
 274 lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
 275 lookupLocalRdrEnv env (Exact name) = Just name
 276 lookupLocalRdrEnv env (Unqual occ) = lookupOccEnv env occ
 277 lookupLocalRdrEnv env other        = Nothing
 278
 279 elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
 280 elemLocalRdrEnv rdr_name env
 281   | isUnqual rdr_name = rdrNameOcc rdr_name `elemOccEnv` env
 282   | otherwise         = False
 283 \end{code}
 284
 285
 286 %************************************************************************
 287 %*                                                                      *
 288                         GlobalRdrEnv
 289 %*                                                                      *
 290 %************************************************************************
 291
 292 \begin{code}
 293 type GlobalRdrEnv = OccEnv [GlobalRdrElt]
 294         -- Keyed by OccName; when looking up a qualified name
 295         -- we look up the OccName part, and then check the Provenance
 296         -- to see if the appropriate qualification is valid.  This
 297         -- saves routinely doubling the size of the env by adding both
 298         -- qualified and unqualified names to the domain.
 299         --
 300         -- The list in the range is reqd because there may be name clashes
 301         -- These only get reported on lookup, not on construction
 302
 303         -- INVARIANT: All the members of the list have distinct
 304         --            gre_name fields; that is, no duplicate Names
 305
 306 emptyGlobalRdrEnv = emptyOccEnv
 307
 308 globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
 309 globalRdrEnvElts env = foldOccEnv (++) [] env
 310
 311 data GlobalRdrElt
 312   = GRE { gre_name   :: Name,
 313           gre_prov   :: Provenance      -- Why it's in scope
 314     }
 315
 316 instance Outputable GlobalRdrElt where
 317   ppr gre = ppr name <+> pp_parent (nameParent_maybe name)
 318                 <+> parens (pprNameProvenance gre)
 319           where
 320             name = gre_name gre
 321             pp_parent (Just p) = brackets (text "parent:" <+> ppr p)
 322             pp_parent Nothing  = empty
 323
 324 pprGlobalRdrEnv :: GlobalRdrEnv -> SDoc
 325 pprGlobalRdrEnv env
 326   = vcat (map pp (occEnvElts env))
 327   where
 328     pp gres = ppr (nameOccName (gre_name (head gres))) <> colon <+>
 329               vcat [ ppr (gre_name gre) <+> pprNameProvenance gre
 330                    | gre <- gres]
 331 \end{code}
 332
 333 \begin{code}
 334 lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
 335 lookupGlobalRdrEnv env rdr_name = case lookupOccEnv env rdr_name of
 336                                         Nothing   -> []
 337                                         Just gres -> gres
 338
 339 lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
 340 lookupGRE_RdrName rdr_name env
 341   = case lookupOccEnv env occ of
 342         Nothing -> []
 343         Just gres | isUnqual rdr_name -> filter unQualOK gres
 344                   | otherwise         -> filter (hasQual mod) gres
 345   where
 346     mod = rdrNameModule rdr_name
 347     occ = rdrNameOcc rdr_name
 348
 349 lookupGRE_Name :: GlobalRdrEnv -> Name -> [GlobalRdrElt]
 350 lookupGRE_Name env name
 351   = [ gre | gre <- lookupGlobalRdrEnv env (nameOccName name),
 352             gre_name gre == name ]
 353
 354
 355 isLocalGRE :: GlobalRdrElt -> Bool
 356 isLocalGRE (GRE {gre_prov = LocalDef _}) = True
 357 isLocalGRE other                         = False
 358
 359 unQualOK :: GlobalRdrElt -> Bool
 360 -- An unqualifed version of this thing is in scope
 361 unQualOK (GRE {gre_prov = LocalDef _})    = True
 362 unQualOK (GRE {gre_prov = Imported is _}) = not (all is_qual is)
 363
 364 hasQual :: ModuleName -> GlobalRdrElt -> Bool
 365 -- A qualified version of this thing is in scope
 366 hasQual mod (GRE {gre_prov = LocalDef m})    = m == mod
 367 hasQual mod (GRE {gre_prov = Imported is _}) = any ((== mod) . is_as) is
 368
 369 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
 370 plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
 371
 372 mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
 373 mkGlobalRdrEnv gres
 374   = foldr add emptyGlobalRdrEnv gres
 375   where
 376     add gre env = extendOccEnv_C (foldr insertGRE) env
 377                                  (nameOccName (gre_name gre))
 378                                  [gre]
 379
 380 insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
 381 insertGRE new_g [] = [new_g]
 382 insertGRE new_g (old_g : old_gs)
 383         | gre_name new_g == gre_name old_g
 384         = new_g `plusGRE` old_g : old_gs
 385         | otherwise
 386         = old_g : insertGRE new_g old_gs
 387
 388 plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
 389 -- Used when the gre_name fields match
 390 plusGRE g1 g2
 391   = GRE { gre_name = gre_name g1,
 392           gre_prov = gre_prov g1 `plusProv` gre_prov g2 }
 393 \end{code}
 394
 395
 396 %************************************************************************
 397 %*                                                                      *
 398                         Provenance
 399 %*                                                                      *
 400 %************************************************************************
 401
 402 The "provenance" of something says how it came to be in scope.
 403
 404 \begin{code}
 405 data Provenance
 406   = LocalDef            -- Defined locally
 407         ModuleName
 408
 409   | Imported            -- Imported
 410         [ImportSpec]    -- INVARIANT: non-empty
 411         Bool            -- True iff the thing was named *explicitly*
 412                         -- in *any* of the import specs rather than being
 413                         -- imported as part of a group;
 414         -- e.g.
 415         --      import B
 416         --      import C( T(..) )
 417         -- Here, everything imported by B, and the constructors of T
 418         -- are not named explicitly; only T is named explicitly.
 419         -- This info is used when warning of unused names.
 420
 421 data ImportSpec         -- Describes a particular import declaration
 422                         -- Shared among all the Provenaces for a particular
 423                         -- import declaration
 424   = ImportSpec {
 425         is_mod  :: ModuleName,          -- 'import Muggle'
 426                                         -- Note the Muggle may well not be
 427                                         -- the defining module for this thing!
 428         is_as   :: ModuleName,          -- 'as M' (or 'Muggle' if there is no 'as' clause)
 429         is_qual :: Bool,                -- True <=> qualified (only)
 430         is_loc  :: SrcSpan }            -- Location of import statment
 431
 432 -- Comparison of provenance is just used for grouping
 433 -- error messages (in RnEnv.warnUnusedBinds)
 434 instance Eq Provenance where
 435   p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
 436
 437 instance Eq ImportSpec where
 438   p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
 439
 440 instance Ord Provenance where
 441    compare (LocalDef _) (LocalDef _)   = EQ
 442    compare (LocalDef _) (Imported _ _) = LT
 443    compare (Imported _ _) (LocalDef _) = GT
 444    compare (Imported is1 _) (Imported is2 _) = compare (head is1) (head is2)
 445
 446 instance Ord ImportSpec where
 447    compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp`
 448                      (is_loc is1 `compare` is_loc is2)
 449 \end{code}
 450
 451 \begin{code}
 452 plusProv :: Provenance -> Provenance -> Provenance
 453 -- Choose LocalDef over Imported
 454 -- There is an obscure bug lurking here; in the presence
 455 -- of recursive modules, something can be imported *and* locally
 456 -- defined, and one might refer to it with a qualified name from
 457 -- the import -- but I'm going to ignore that because it makes
 458 -- the isLocalGRE predicate so much nicer this way
 459 plusProv (LocalDef m1) (LocalDef m2)
 460   = pprPanic "plusProv" (ppr m1 <+> ppr m2)
 461 plusProv p1@(LocalDef _) p2 = p1
 462 plusProv p1 p2@(LocalDef _) = p2
 463 plusProv (Imported is1 ex1) (Imported is2 ex2)
 464   = Imported (is1++is2) (ex1 || ex2)
 465
 466 pprNameProvenance :: GlobalRdrElt -> SDoc
 467 pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef _})
 468   = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
 469 pprNameProvenance (GRE {gre_name = name, gre_prov = Imported (why:whys) _})
 470   = sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))]
 471
 472 instance Outputable ImportSpec where
 473    ppr imp_spec
 474      = ptext SLIT("imported from") <+> ppr (is_mod imp_spec)
 475         <+> ptext SLIT("at") <+> ppr (is_loc imp_spec)
 476
 477 ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc)
 478              | otherwise        = empty
 479 \end{code}