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 ns occ)
 113 setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
 114 setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
 115 setRdrNameSpace (Exact n)    ns = Unqual (setOccNameSpace ns (nameOccName n))
 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 = Orig (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
 158 origFromName :: Name -> RdrName
 159 origFromName n = Orig (moduleName (nameModule n)) (nameOccName n)
 160 \end{code}
 161
 162 \begin{code}
 163         -- This guy is used by the reader when HsSyn has a slot for
 164         -- an implicit name that's going to be filled in by
 165         -- the renamer.  We can't just put "error..." because
 166         -- we sometimes want to print out stuff after reading but
 167         -- before renaming
 168 dummyRdrVarName = Unqual (mkVarOcc FSLIT("V-DUMMY"))
 169 dummyRdrTcName  = Unqual (mkOccFS tcName FSLIT("TC-DUMMY"))
 170 \end{code}
 171
 172
 173 \begin{code}
 174 isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
 175 isRdrTyVar   rn = isTvOcc   (rdrNameOcc rn)
 176 isRdrTc      rn = isTcOcc   (rdrNameOcc rn)
 177
 178 isUnqual (Unqual _) = True
 179 isUnqual other      = False
 180
 181 isQual (Qual _ _) = True
 182 isQual _          = False
 183
 184 isOrig (Orig _ _) = True
 185 isOrig _          = False
 186
 187 isExact (Exact _) = True
 188 isExact other   = False
 189
 190 isExact_maybe (Exact n) = Just n
 191 isExact_maybe other     = Nothing
 192 \end{code}
 193
 194
 195 %************************************************************************
 196 %*                                                                      *
 197 \subsection{Instances}
 198 %*                                                                      *
 199 %************************************************************************
 200
 201 \begin{code}
 202 instance Outputable RdrName where
 203     ppr (Exact name)   = ppr name
 204     ppr (Unqual occ)   = ppr occ <+> ppr_name_space occ
 205     ppr (Qual mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
 206     ppr (Orig mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
 207
 208 ppr_name_space occ = ifPprDebug (parens (text (occNameFlavour occ)))
 209
 210 instance OutputableBndr RdrName where
 211     pprBndr _ n
 212         | isTvOcc (rdrNameOcc n) = char '@' <+> ppr n
 213         | otherwise              = ppr n
 214
 215 pprUnqualRdrName rdr_name = ppr (rdrNameOcc rdr_name)
 216
 217 instance Eq RdrName where
 218     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
 219     a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
 220
 221 instance Ord RdrName where
 222     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 223     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 224     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 225     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 226
 227         -- Unqual < Qual < Orig < Exact
 228     compare (Exact n1)    (Exact n2)  = n1 `compare` n2
 229     compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
 230     compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
 231     compare (Unqual o1)  (Unqual  o2) = o1 `compare` o2
 232
 233         -- Convert Exact to Orig
 234     compare (Exact n1)    n2          = origFromName n1 `compare` n2
 235     compare n1            (Exact n2)  = n1 `compare` origFromName n2
 236
 237     compare (Unqual _)   _            = LT
 238     compare (Qual _ _)   (Orig _ _)   = LT
 239     compare _            _            = GT
 240 \end{code}
 241
 242
 243
 244 %************************************************************************
 245 %*                                                                      *
 246 \subsection{Environment}
 247 %*                                                                      *
 248 %************************************************************************
 249
 250 \begin{code}
 251 type RdrNameEnv a = FiniteMap RdrName a
 252
 253 emptyRdrEnv     :: RdrNameEnv a
 254 lookupRdrEnv    :: RdrNameEnv a -> RdrName -> Maybe a
 255 addListToRdrEnv :: RdrNameEnv a -> [(RdrName,a)] -> RdrNameEnv a
 256 extendRdrEnv    :: RdrNameEnv a -> RdrName -> a -> RdrNameEnv a
 257 rdrEnvToList    :: RdrNameEnv a -> [(RdrName, a)]
 258 rdrEnvElts      :: RdrNameEnv a -> [a]
 259 elemRdrEnv      :: RdrName -> RdrNameEnv a -> Bool
 260 foldRdrEnv      :: (RdrName -> a -> b -> b) -> b -> RdrNameEnv a -> b
 261
 262 emptyRdrEnv     = emptyFM
 263 lookupRdrEnv    = lookupFM
 264 addListToRdrEnv = addListToFM
 265 rdrEnvElts      = eltsFM
 266 extendRdrEnv    = addToFM
 267 rdrEnvToList    = fmToList
 268 elemRdrEnv      = elemFM
 269 foldRdrEnv      = foldFM
 270 \end{code}
 271
 272 \begin{code}
 273 instance Binary RdrName where
 274     put_ bh (Unqual aa) = do
 275             putByte bh 0
 276             put_ bh aa
 277
 278     put_ bh (Qual aa ab) = do
 279             putByte bh 1
 280             put_ bh aa
 281             put_ bh ab
 282
 283     put_ bh (Orig aa ab) = do
 284             putByte bh 2
 285             put_ bh aa
 286             put_ bh ab
 287
 288     put_ bh (Exact n) = pprPanic "No Binary instance for RdrName.Exact" (ppr n)
 289
 290     get bh = do
 291           h <- getByte bh
 292           case h of
 293             0 -> do aa <- get bh
 294                     return (Unqual aa)
 295             1 -> do aa <- get bh
 296                     ab <- get bh
 297                     return (Qual aa ab)
 298             _ -> do aa <- get bh
 299                     ab <- get bh
 300                     return (Orig aa ab)
 301 \end{code}