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