ghc/compiler/basicTypes/RdrName.lhs

   1 {-% DrIFT (Automatic class derivations for Haskell) v1.1 %-}
   2 %
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 \section[RdrName]{@RdrName@}
   7
   8 \begin{code}
   9 module RdrName (
  10         RdrName,
  11
  12         -- Construction
  13         mkRdrUnqual, mkRdrQual,
  14         mkUnqual, mkQual, mkOrig, mkIfaceOrig,
  15         nameRdrName, getRdrName,
  16         qualifyRdrName, unqualifyRdrName, mkRdrNameWkr,
  17         dummyRdrVarName, dummyRdrTcName,
  18
  19         -- Destruction
  20         rdrNameModule, rdrNameOcc, setRdrNameSpace,
  21         isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isUnqual,
  22         isOrig, isExact, isExact_maybe,
  23
  24         -- Environment
  25         RdrNameEnv,
  26         emptyRdrEnv, lookupRdrEnv, addListToRdrEnv, rdrEnvElts,
  27         extendRdrEnv, rdrEnvToList, elemRdrEnv, foldRdrEnv,
  28
  29         -- Printing;    instance Outputable RdrName
  30         pprUnqualRdrName
  31   ) where
  32
  33 #include "HsVersions.h"
  34
  35 import OccName  ( NameSpace, tcName,
  36                   OccName, UserFS, EncodedFS,
  37                   mkSysOccFS, setOccNameSpace,
  38                   mkOccFS, mkVarOcc, occNameFlavour,
  39                   isDataOcc, isTvOcc, isTcOcc, mkWorkerOcc
  40                 )
  41 import Module   ( ModuleName,
  42                   mkSysModuleNameFS, mkModuleNameFS
  43                 )
  44 import Name     ( Name, NamedThing(getName), nameModule, nameOccName )
  45 import Module   ( moduleName )
  46 import FiniteMap
  47 import Outputable
  48 import Binary
  49 import Util     ( thenCmp )
  50 \end{code}
  51
  52
  53 %************************************************************************
  54 %*                                                                      *
  55 \subsection{The main data type}
  56 %*                                                                      *
  57 %************************************************************************
  58
  59 \begin{code}
  60 data RdrName
  61   = Unqual OccName
  62         -- Used for ordinary, unqualified occurrences
  63
  64   | Qual ModuleName OccName
  65         -- A qualified name written by the user in
  66         -- *source* code.  The module isn't necessarily
  67         -- the module where the thing is defined;
  68         -- just the one from which it is imported
  69
  70   | Orig ModuleName OccName
  71         -- An original name; the module is the *defining* module.
  72         -- This is used when GHC generates code that will be fed
  73         -- into the renamer (e.g. from deriving clauses), but where
  74         -- we want to say "Use Prelude.map dammit".
  75
  76   | Exact Name
  77         -- We know exactly the Name. This is used
  78         --  (a) when the parser parses built-in syntax like "[]"
  79         --      and "(,)", but wants a RdrName from it
  80         --  (b) possibly, by the meta-programming stuff
  81 \end{code}
  82
  83
  84 %************************************************************************
  85 %*                                                                      *
  86 \subsection{Simple functions}
  87 %*                                                                      *
  88 %************************************************************************
  89
  90 \begin{code}
  91 rdrNameModule :: RdrName -> ModuleName
  92 rdrNameModule (Qual m _) = m
  93 rdrNameModule (Orig m _) = m
  94 rdrNameModule (Exact n)  = moduleName (nameModule n)
  95 rdrNameModule (Unqual n) = pprPanic "rdrNameModule" (ppr n)
  96
  97 rdrNameOcc :: RdrName -> OccName
  98 rdrNameOcc (Qual _ occ) = occ
  99 rdrNameOcc (Unqual occ) = occ
 100 rdrNameOcc (Orig _ occ) = occ
 101 rdrNameOcc (Exact name) = nameOccName name
 102
 103 setRdrNameSpace :: RdrName -> NameSpace -> RdrName
 104 -- This rather gruesome function is used mainly by the parser
 105 -- When parsing         data T a = T | T1 Int
 106 -- we parse the data constructors as *types* because of parser ambiguities,
 107 -- so then we need to change the *type constr* to a *data constr*
 108 --
 109 -- The original-name case *can* occur when parsing
 110 --              data [] a = [] | a : [a]
 111 -- For the orig-name case we return an unqualified name.
 112 setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace occ ns)
 113 setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace occ ns)
 114 setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace occ ns)
 115 setRdrNameSpace (Exact n)    ns = Unqual (setOccNameSpace (nameOccName n) ns)
 116 \end{code}
 117
 118 \begin{code}
 119         -- These two are the basic constructors
 120 mkRdrUnqual :: OccName -> RdrName
 121 mkRdrUnqual occ = Unqual occ
 122
 123 mkRdrQual :: ModuleName -> OccName -> RdrName
 124 mkRdrQual mod occ = Qual mod occ
 125
 126 mkOrig :: ModuleName -> OccName -> RdrName
 127 mkOrig mod occ = Orig mod occ
 128
 129 mkIfaceOrig :: NameSpace -> (EncodedFS, EncodedFS) -> RdrName
 130 mkIfaceOrig ns (m,n) = Qual (mkSysModuleNameFS m) (mkSysOccFS ns n)
 131
 132
 133         -- These two are used when parsing source files
 134         -- They do encode the module and occurrence names
 135 mkUnqual :: NameSpace -> UserFS -> RdrName
 136 mkUnqual sp n = Unqual (mkOccFS sp n)
 137
 138 mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
 139 mkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccFS sp n)
 140
 141 getRdrName :: NamedThing thing => thing -> RdrName
 142 getRdrName name = Exact (getName name)
 143
 144 nameRdrName :: Name -> RdrName
 145 nameRdrName name = Exact name
 146
 147 qualifyRdrName :: ModuleName -> RdrName -> RdrName
 148         -- Sets the module name of a RdrName, even if it has one already
 149 qualifyRdrName mod rn = Qual mod (rdrNameOcc rn)
 150
 151 unqualifyRdrName :: RdrName -> RdrName
 152 unqualifyRdrName rdr_name = Unqual (rdrNameOcc rdr_name)
 153
 154 mkRdrNameWkr :: RdrName -> RdrName      -- Worker-ify it
 155 mkRdrNameWkr rdr_name = Qual (rdrNameModule rdr_name)
 156                              (mkWorkerOcc (rdrNameOcc rdr_name))
 157 \end{code}
 158
 159 \begin{code}
 160         -- This guy is used by the reader when HsSyn has a slot for
 161         -- an implicit name that's going to be filled in by
 162         -- the renamer.  We can't just put "error..." because
 163         -- we sometimes want to print out stuff after reading but
 164         -- before renaming
 165 dummyRdrVarName = Unqual (mkVarOcc FSLIT("V-DUMMY"))
 166 dummyRdrTcName  = Unqual (mkOccFS tcName FSLIT("TC-DUMMY"))
 167 \end{code}
 168
 169
 170 \begin{code}
 171 isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
 172 isRdrTyVar   rn = isTvOcc   (rdrNameOcc rn)
 173 isRdrTc      rn = isTcOcc   (rdrNameOcc rn)
 174
 175 isUnqual (Unqual _) = True
 176 isUnqual other      = False
 177
 178 isQual (Qual _ _) = True
 179 isQual _          = False
 180
 181 isOrig (Orig _ _) = True
 182 isOrig _          = False
 183
 184 isExact (Exact _) = True
 185 isExact other   = False
 186
 187 isExact_maybe (Exact n) = Just n
 188 isExact_maybe other       = Nothing
 189 \end{code}
 190
 191
 192 %************************************************************************
 193 %*                                                                      *
 194 \subsection{Instances}
 195 %*                                                                      *
 196 %************************************************************************
 197
 198 \begin{code}
 199 instance Outputable RdrName where
 200     ppr (Exact name)   = ppr name
 201     ppr (Unqual occ)   = ppr occ <+> ppr_name_space occ
 202     ppr (Qual mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
 203     ppr (Orig mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
 204
 205 ppr_name_space occ = ifPprDebug (parens (text (occNameFlavour occ)))
 206
 207 instance OutputableBndr RdrName where
 208     pprBndr _ n
 209         | isTvOcc (rdrNameOcc n) = char '@' <+> ppr n
 210         | otherwise              = ppr n
 211
 212 pprUnqualRdrName rdr_name = ppr (rdrNameOcc rdr_name)
 213
 214 instance Eq RdrName where
 215     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
 216     a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
 217
 218 instance Ord RdrName where
 219     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 220     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 221     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 222     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 223
 224         -- Unqual < Qual < Orig < Exact
 225     compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
 226     compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
 227     compare (Unqual o1)  (Unqual  o2) = o1 `compare` o2
 228     compare (Exact n1)    (Exact n2)  = n1 `compare` n2
 229
 230     compare (Unqual _)   _            = LT
 231
 232     compare (Qual _ _)   (Orig _ _)   = LT
 233     compare (Qual _ _)   (Exact _)    = LT
 234
 235     compare (Orig _ _)   (Exact _)    = LT
 236
 237     compare _            _            = GT
 238 \end{code}
 239
 240
 241
 242 %************************************************************************
 243 %*                                                                      *
 244 \subsection{Environment}
 245 %*                                                                      *
 246 %************************************************************************
 247
 248 \begin{code}
 249 type RdrNameEnv a = FiniteMap RdrName a
 250
 251 emptyRdrEnv     :: RdrNameEnv a
 252 lookupRdrEnv    :: RdrNameEnv a -> RdrName -> Maybe a
 253 addListToRdrEnv :: RdrNameEnv a -> [(RdrName,a)] -> RdrNameEnv a
 254 extendRdrEnv    :: RdrNameEnv a -> RdrName -> a -> RdrNameEnv a
 255 rdrEnvToList    :: RdrNameEnv a -> [(RdrName, a)]
 256 rdrEnvElts      :: RdrNameEnv a -> [a]
 257 elemRdrEnv      :: RdrName -> RdrNameEnv a -> Bool
 258 foldRdrEnv      :: (RdrName -> a -> b -> b) -> b -> RdrNameEnv a -> b
 259
 260 emptyRdrEnv     = emptyFM
 261 lookupRdrEnv    = lookupFM
 262 addListToRdrEnv = addListToFM
 263 rdrEnvElts      = eltsFM
 264 extendRdrEnv    = addToFM
 265 rdrEnvToList    = fmToList
 266 elemRdrEnv      = elemFM
 267 foldRdrEnv      = foldFM
 268 \end{code}
 269
 270 \begin{code}
 271 instance Binary RdrName where
 272     put_ bh (Unqual aa) = do
 273             putByte bh 0
 274             put_ bh aa
 275
 276     put_ bh (Qual aa ab) = do
 277             putByte bh 1
 278             put_ bh aa
 279             put_ bh ab
 280
 281     put_ bh (Orig aa ab) = do
 282             putByte bh 2
 283             put_ bh aa
 284             put_ bh ab
 285
 286     put_ bh (Exact n) = pprPanic "No Binary instance for RdrName.Exact" (ppr n)
 287
 288     get bh = do
 289           h <- getByte bh
 290           case h of
 291             0 -> do aa <- get bh
 292                     return (Unqual aa)
 293             1 -> do aa <- get bh
 294                     ab <- get bh
 295                     return (Qual aa ab)
 296             _ -> do aa <- get bh
 297                     ab <- get bh
 298                     return (Orig aa ab)
 299 \end{code}