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, mkRdrOrig, mkRdrUnqual,
  14         mkUnqual, mkQual, mkIfaceOrig, mkOrig,
  15         qualifyRdrName, unqualifyRdrName, mkRdrNameWkr,
  16         dummyRdrVarName, dummyRdrTcName,
  17
  18         -- Destruction
  19         rdrNameModule, rdrNameOcc, setRdrNameOcc,
  20         isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isUnqual, isOrig,
  21
  22         -- Environment
  23         RdrNameEnv,
  24         emptyRdrEnv, lookupRdrEnv, addListToRdrEnv, rdrEnvElts,
  25         extendRdrEnv, rdrEnvToList, elemRdrEnv, foldRdrEnv,
  26
  27         -- Printing;    instance Outputable RdrName
  28         pprUnqualRdrName
  29   ) where
  30
  31 #include "HsVersions.h"
  32
  33 import OccName  ( NameSpace, tcName,
  34                   OccName, UserFS, EncodedFS,
  35                   mkSysOccFS,
  36                   mkOccFS, mkVarOcc,
  37                   isDataOcc, isTvOcc, isTcOcc, mkWorkerOcc
  38                 )
  39 import Module   ( ModuleName,
  40                   mkSysModuleNameFS, mkModuleNameFS
  41                 )
  42 import FiniteMap
  43 import Outputable
  44 import Binary
  45 import Util     ( thenCmp )
  46 \end{code}
  47
  48
  49 %************************************************************************
  50 %*                                                                      *
  51 \subsection{The main data type}
  52 %*                                                                      *
  53 %************************************************************************
  54
  55 \begin{code}
  56 data RdrName = RdrName Qual OccName
  57   {-! derive: Binary !-}
  58
  59 data Qual
  60   = Unqual
  61
  62   | Qual ModuleName     -- A qualified name written by the user in source code
  63                         -- The module isn't necessarily the module where
  64                         -- the thing is defined; just the one from which it
  65                         -- is imported
  66
  67   | Orig ModuleName     -- This is an *original* name; the module is the place
  68                         -- where the thing was defined
  69   {-! derive: Binary !-}
  70
  71 \end{code}
  72
  73
  74 %************************************************************************
  75 %*                                                                      *
  76 \subsection{Simple functions}
  77 %*                                                                      *
  78 %************************************************************************
  79
  80 \begin{code}
  81 rdrNameModule :: RdrName -> ModuleName
  82 rdrNameModule (RdrName (Qual m) _) = m
  83 rdrNameModule (RdrName (Orig m) _) = m
  84 rdrNameModule n                    = pprPanic "rdrNameModule" (ppr n)
  85
  86 rdrNameOcc :: RdrName -> OccName
  87 rdrNameOcc (RdrName _ occ) = occ
  88
  89 setRdrNameOcc :: RdrName -> OccName -> RdrName
  90 setRdrNameOcc (RdrName q _) occ = RdrName q occ
  91 \end{code}
  92
  93 \begin{code}
  94         -- These two are the basic constructors
  95 mkRdrUnqual :: OccName -> RdrName
  96 mkRdrUnqual occ = RdrName Unqual occ
  97
  98 mkRdrQual :: ModuleName -> OccName -> RdrName
  99 mkRdrQual mod occ = RdrName (Qual mod) occ
 100
 101 mkRdrOrig :: ModuleName -> OccName -> RdrName
 102 mkRdrOrig mod occ = RdrName (Orig mod) occ
 103
 104 mkIfaceOrig :: NameSpace -> (EncodedFS, EncodedFS) -> RdrName
 105 mkIfaceOrig ns (m,n) = RdrName (Orig (mkSysModuleNameFS m)) (mkSysOccFS ns n)
 106
 107
 108         -- These two are used when parsing source files
 109         -- They do encode the module and occurrence names
 110 mkUnqual :: NameSpace -> UserFS -> RdrName
 111 mkUnqual sp n = RdrName Unqual (mkOccFS sp n)
 112
 113 mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
 114 mkQual sp (m, n) = RdrName (Qual (mkModuleNameFS m)) (mkOccFS sp n)
 115
 116 mkOrig :: NameSpace -> ModuleName -> UserFS -> RdrName
 117 mkOrig sp mod n = RdrName (Orig mod) (mkOccFS sp n)
 118
 119 qualifyRdrName :: ModuleName -> RdrName -> RdrName
 120         -- Sets the module name of a RdrName, even if it has one already
 121 qualifyRdrName mod (RdrName _ occ) = RdrName (Qual mod) occ
 122
 123 unqualifyRdrName :: RdrName -> RdrName
 124 unqualifyRdrName (RdrName _ occ) = RdrName Unqual occ
 125
 126 mkRdrNameWkr :: RdrName -> RdrName      -- Worker-ify it
 127 mkRdrNameWkr (RdrName qual occ) = RdrName qual (mkWorkerOcc occ)
 128 \end{code}
 129
 130 \begin{code}
 131         -- This guy is used by the reader when HsSyn has a slot for
 132         -- an implicit name that's going to be filled in by
 133         -- the renamer.  We can't just put "error..." because
 134         -- we sometimes want to print out stuff after reading but
 135         -- before renaming
 136 dummyRdrVarName = RdrName Unqual (mkVarOcc FSLIT("V-DUMMY"))
 137 dummyRdrTcName  = RdrName Unqual (mkOccFS tcName FSLIT("TC-DUMMY"))
 138 \end{code}
 139
 140
 141 \begin{code}
 142 isRdrDataCon (RdrName _ occ) = isDataOcc occ
 143 isRdrTyVar   (RdrName _ occ) = isTvOcc occ
 144 isRdrTc      (RdrName _ occ) = isTcOcc occ
 145
 146 isUnqual (RdrName Unqual _) = True
 147 isUnqual other              = False
 148
 149 isQual (RdrName (Qual _) _) = True
 150 isQual _                    = False
 151
 152 isOrig (RdrName (Orig _)    _) = True
 153 isOrig other                   = False
 154 \end{code}
 155
 156
 157 %************************************************************************
 158 %*                                                                      *
 159 \subsection{Instances}
 160 %*                                                                      *
 161 %************************************************************************
 162
 163 \begin{code}
 164 instance Outputable RdrName where
 165     ppr (RdrName qual occ) = pp_qual qual <> ppr occ
 166                            where
 167                              pp_qual Unqual      = empty
 168                              pp_qual (Qual mod)  = ppr mod <> dot
 169                              pp_qual (Orig mod)  = ppr mod <> dot
 170
 171 pprUnqualRdrName (RdrName qual occ) = ppr occ
 172
 173 instance Eq RdrName where
 174     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
 175     a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
 176
 177 instance Ord RdrName where
 178     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 179     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 180     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 181     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 182
 183     compare (RdrName q1 o1) (RdrName q2 o2)
 184         = (o1  `compare` o2) `thenCmp`
 185           (q1  `cmpQual` q2)
 186
 187 cmpQual Unqual      Unqual      = EQ
 188 cmpQual (Qual m1)   (Qual m2)   = m1 `compare` m2
 189 cmpQual (Orig m1)   (Orig m2)   = m1 `compare` m2
 190 cmpQual Unqual      _           = LT
 191 cmpQual (Qual _)    (Orig _)    = LT
 192 cmpQual _           _           = GT
 193 \end{code}
 194
 195
 196
 197 %************************************************************************
 198 %*                                                                      *
 199 \subsection{Environment}
 200 %*                                                                      *
 201 %************************************************************************
 202
 203 \begin{code}
 204 type RdrNameEnv a = FiniteMap RdrName a
 205
 206 emptyRdrEnv     :: RdrNameEnv a
 207 lookupRdrEnv    :: RdrNameEnv a -> RdrName -> Maybe a
 208 addListToRdrEnv :: RdrNameEnv a -> [(RdrName,a)] -> RdrNameEnv a
 209 extendRdrEnv    :: RdrNameEnv a -> RdrName -> a -> RdrNameEnv a
 210 rdrEnvToList    :: RdrNameEnv a -> [(RdrName, a)]
 211 rdrEnvElts      :: RdrNameEnv a -> [a]
 212 elemRdrEnv      :: RdrName -> RdrNameEnv a -> Bool
 213 foldRdrEnv      :: (RdrName -> a -> b -> b) -> b -> RdrNameEnv a -> b
 214
 215 emptyRdrEnv     = emptyFM
 216 lookupRdrEnv    = lookupFM
 217 addListToRdrEnv = addListToFM
 218 rdrEnvElts      = eltsFM
 219 extendRdrEnv    = addToFM
 220 rdrEnvToList    = fmToList
 221 elemRdrEnv      = elemFM
 222 foldRdrEnv      = foldFM
 223 \end{code}
 224 \begin{code}
 225 {-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-}
 226 instance Binary RdrName where
 227     put_ bh (RdrName aa ab) = do
 228             put_ bh aa
 229             put_ bh ab
 230     get bh = do
 231           aa <- get bh
 232           ab <- get bh
 233           return (RdrName aa ab)
 234
 235 instance Binary Qual where
 236     put_ bh Unqual = do
 237             putByte bh 0
 238     put_ bh (Qual aa) = do
 239             putByte bh 1
 240             put_ bh aa
 241     put_ bh (Orig ab) = do
 242             putByte bh 2
 243             put_ bh ab
 244     get bh = do
 245             h <- getByte bh
 246             case h of
 247               0 -> do return Unqual
 248               1 -> do aa <- get bh
 249                       return (Qual aa)
 250               _ -> do ab <- get bh
 251                       return (Orig ab)
 252
 253 --  Imported from other files :-
 254
 255 \end{code}