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
  85 rdrNameOcc :: RdrName -> OccName
  86 rdrNameOcc (RdrName _ occ) = occ
  87
  88 setRdrNameOcc :: RdrName -> OccName -> RdrName
  89 setRdrNameOcc (RdrName q _) occ = RdrName q occ
  90 \end{code}
  91
  92 \begin{code}
  93         -- These two are the basic constructors
  94 mkRdrUnqual :: OccName -> RdrName
  95 mkRdrUnqual occ = RdrName Unqual occ
  96
  97 mkRdrQual :: ModuleName -> OccName -> RdrName
  98 mkRdrQual mod occ = RdrName (Qual mod) occ
  99
 100 mkRdrOrig :: ModuleName -> OccName -> RdrName
 101 mkRdrOrig mod occ = RdrName (Orig mod) occ
 102
 103 mkIfaceOrig :: NameSpace -> (EncodedFS, EncodedFS) -> RdrName
 104 mkIfaceOrig ns (m,n) = RdrName (Orig (mkSysModuleNameFS m)) (mkSysOccFS ns n)
 105
 106
 107         -- These two are used when parsing source files
 108         -- They do encode the module and occurrence names
 109 mkUnqual :: NameSpace -> UserFS -> RdrName
 110 mkUnqual sp n = RdrName Unqual (mkOccFS sp n)
 111
 112 mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
 113 mkQual sp (m, n) = RdrName (Qual (mkModuleNameFS m)) (mkOccFS sp n)
 114
 115 mkOrig :: NameSpace -> ModuleName -> UserFS -> RdrName
 116 mkOrig sp mod n = RdrName (Orig mod) (mkOccFS sp n)
 117
 118 qualifyRdrName :: ModuleName -> RdrName -> RdrName
 119         -- Sets the module name of a RdrName, even if it has one already
 120 qualifyRdrName mod (RdrName _ occ) = RdrName (Qual mod) occ
 121
 122 unqualifyRdrName :: RdrName -> RdrName
 123 unqualifyRdrName (RdrName _ occ) = RdrName Unqual occ
 124
 125 mkRdrNameWkr :: RdrName -> RdrName      -- Worker-ify it
 126 mkRdrNameWkr (RdrName qual occ) = RdrName qual (mkWorkerOcc occ)
 127 \end{code}
 128
 129 \begin{code}
 130         -- This guy is used by the reader when HsSyn has a slot for
 131         -- an implicit name that's going to be filled in by
 132         -- the renamer.  We can't just put "error..." because
 133         -- we sometimes want to print out stuff after reading but
 134         -- before renaming
 135 dummyRdrVarName = RdrName Unqual (mkVarOcc FSLIT("V-DUMMY"))
 136 dummyRdrTcName  = RdrName Unqual (mkOccFS tcName FSLIT("TC-DUMMY"))
 137 \end{code}
 138
 139
 140 \begin{code}
 141 isRdrDataCon (RdrName _ occ) = isDataOcc occ
 142 isRdrTyVar   (RdrName _ occ) = isTvOcc occ
 143 isRdrTc      (RdrName _ occ) = isTcOcc occ
 144
 145 isUnqual (RdrName Unqual _) = True
 146 isUnqual other              = False
 147
 148 isQual (RdrName (Qual _) _) = True
 149 isQual _                    = False
 150
 151 isOrig (RdrName (Orig _)    _) = True
 152 isOrig other                   = False
 153 \end{code}
 154
 155
 156 %************************************************************************
 157 %*                                                                      *
 158 \subsection{Instances}
 159 %*                                                                      *
 160 %************************************************************************
 161
 162 \begin{code}
 163 instance Outputable RdrName where
 164     ppr (RdrName qual occ) = pp_qual qual <> ppr occ
 165                            where
 166                              pp_qual Unqual      = empty
 167                              pp_qual (Qual mod)  = ppr mod <> dot
 168                              pp_qual (Orig mod)  = ppr mod <> dot
 169
 170 pprUnqualRdrName (RdrName qual occ) = ppr occ
 171
 172 instance Eq RdrName where
 173     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
 174     a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
 175
 176 instance Ord RdrName where
 177     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 178     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 179     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 180     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 181
 182     compare (RdrName q1 o1) (RdrName q2 o2)
 183         = (o1  `compare` o2) `thenCmp`
 184           (q1  `cmpQual` q2)
 185
 186 cmpQual Unqual      Unqual      = EQ
 187 cmpQual (Qual m1)   (Qual m2)   = m1 `compare` m2
 188 cmpQual (Orig m1)   (Orig m2)   = m1 `compare` m2
 189 cmpQual Unqual      _           = LT
 190 cmpQual (Qual _)    (Orig _)    = LT
 191 cmpQual _           _           = GT
 192 \end{code}
 193
 194
 195
 196 %************************************************************************
 197 %*                                                                      *
 198 \subsection{Environment}
 199 %*                                                                      *
 200 %************************************************************************
 201
 202 \begin{code}
 203 type RdrNameEnv a = FiniteMap RdrName a
 204
 205 emptyRdrEnv     :: RdrNameEnv a
 206 lookupRdrEnv    :: RdrNameEnv a -> RdrName -> Maybe a
 207 addListToRdrEnv :: RdrNameEnv a -> [(RdrName,a)] -> RdrNameEnv a
 208 extendRdrEnv    :: RdrNameEnv a -> RdrName -> a -> RdrNameEnv a
 209 rdrEnvToList    :: RdrNameEnv a -> [(RdrName, a)]
 210 rdrEnvElts      :: RdrNameEnv a -> [a]
 211 elemRdrEnv      :: RdrName -> RdrNameEnv a -> Bool
 212 foldRdrEnv      :: (RdrName -> a -> b -> b) -> b -> RdrNameEnv a -> b
 213
 214 emptyRdrEnv     = emptyFM
 215 lookupRdrEnv    = lookupFM
 216 addListToRdrEnv = addListToFM
 217 rdrEnvElts      = eltsFM
 218 extendRdrEnv    = addToFM
 219 rdrEnvToList    = fmToList
 220 elemRdrEnv      = elemFM
 221 foldRdrEnv      = foldFM
 222 \end{code}
 223 \begin{code}
 224 {-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-}
 225 instance Binary RdrName where
 226     put_ bh (RdrName aa ab) = do
 227             put_ bh aa
 228             put_ bh ab
 229     get bh = do
 230           aa <- get bh
 231           ab <- get bh
 232           return (RdrName aa ab)
 233
 234 instance Binary Qual where
 235     put_ bh Unqual = do
 236             putByte bh 0
 237     put_ bh (Qual aa) = do
 238             putByte bh 1
 239             put_ bh aa
 240     put_ bh (Orig ab) = do
 241             putByte bh 2
 242             put_ bh ab
 243     get bh = do
 244             h <- getByte bh
 245             case h of
 246               0 -> do return Unqual
 247               1 -> do aa <- get bh
 248                       return (Qual aa)
 249               _ -> do ab <- get bh
 250                       return (Orig ab)
 251
 252 --  Imported from other files :-
 253
 254 \end{code}