ghc/compiler/basicTypes/Name.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[Name]{@Name@: to transmit name info from renamer to typechecker}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module Name (
  10         Module(..),
  11
  12         RdrName(..),
  13         isUnqual,
  14         isQual,
  15         isConopRdr,
  16         appendRdr,
  17         rdrToOrig,
  18         showRdr,
  19         cmpRdr,
  20
  21         Name,
  22         Provenance,
  23         mkLocalName, isLocalName,
  24         mkTopLevName, mkImportedName,
  25         mkImplicitName, isImplicitName,
  26         mkBuiltinName,
  27
  28         nameUnique,
  29         nameOrigName,
  30         nameOccName,
  31         nameExportFlag,
  32         nameSrcLoc,
  33         isLocallyDefinedName,
  34         isPreludeDefinedName
  35     ) where
  36
  37 import Ubiq
  38
  39 import CStrings         ( identToC, cSEP )
  40 import Outputable       ( Outputable(..), ExportFlag(..), isConop )
  41 import PprStyle         ( PprStyle(..), codeStyle )
  42 import Pretty
  43 import PrelMods         ( pRELUDE )
  44 import SrcLoc           ( mkBuiltinSrcLoc, mkUnknownSrcLoc )
  45 import Unique           ( pprUnique, Unique )
  46 import Util             ( thenCmp, _CMP_STRING_, panic )
  47 \end{code}
  48
  49 %************************************************************************
  50 %*                                                                      *
  51 \subsection[RdrName]{The @RdrName@ datatype; names read from files}
  52 %*                                                                      *
  53 %************************************************************************
  54
  55 \begin{code}
  56 type Module = FAST_STRING
  57
  58 data RdrName  = Unqual FAST_STRING
  59               | Qual Module FAST_STRING
  60
  61 isUnqual (Unqual _) = True
  62 isUnqual (Qual _ _) = False
  63
  64 isQual (Unqual _) = False
  65 isQual (Qual _ _) = True
  66
  67 isConopRdr (Unqual n) = isConop n
  68 isConopRdr (Qual m n) = isConop n
  69
  70 appendRdr (Unqual n) str = Unqual (n _APPEND_ str)
  71 appendRdr (Qual m n) str = Qual m (n _APPEND_ str)
  72
  73 rdrToOrig (Unqual n) = (pRELUDE, n)
  74 rdrToOrig (Qual m n) = (m, n)
  75
  76 cmpRdr (Unqual n1)  (Unqual n2)  = _CMP_STRING_ n1 n2
  77 cmpRdr (Unqual n1)  (Qual m2 n2) = LT_
  78 cmpRdr (Qual m1 n1) (Unqual n2)  = GT_
  79 cmpRdr (Qual m1 n1) (Qual m2 n2) = thenCmp (_CMP_STRING_ m1 m2) (_CMP_STRING_ n1 n2)
  80
  81 instance Eq RdrName where
  82     a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
  83     a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
  84
  85 instance Ord RdrName where
  86     a <= b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
  87     a <  b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> False; GT__ -> False }
  88     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
  89     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
  90
  91 instance Ord3 RdrName where
  92     cmp = cmpRdr
  93
  94 instance NamedThing RdrName where
  95     -- We're sorta faking it here
  96     getName rdr_name
  97       = Global u rdr_name prov ex [rdr_name]
  98       where
  99         u    = panic "NamedThing.RdrName:Unique"
 100         prov = panic "NamedThing.RdrName:Provenance"
 101         ex   = panic "NamedThing.RdrName:ExportFlag"
 102
 103 instance Outputable RdrName where
 104     ppr sty (Unqual n) = pp_name sty n
 105     ppr sty (Qual m n) = ppBeside (pp_mod sty m) (pp_name sty n)
 106
 107 pp_mod PprInterface        m = ppNil
 108 pp_mod PprForC             m = ppBesides [identToC m, ppPStr cSEP]
 109 pp_mod (PprForAsm False _) m = ppBesides [identToC m, ppPStr cSEP]
 110 pp_mod (PprForAsm True  _) m = ppBesides [ppPStr cSEP, identToC m, ppPStr cSEP]
 111 pp_mod _                   m = ppBesides [ppPStr m, ppChar '.']
 112
 113 pp_name sty n | codeStyle sty = identToC n
 114               | otherwise     = ppPStr n
 115
 116 showRdr sty rdr = ppShow 100 (ppr sty rdr)
 117 \end{code}
 118
 119 %************************************************************************
 120 %*                                                                      *
 121 \subsection[Name-datatype]{The @Name@ datatype}
 122 %*                                                                      *
 123 %************************************************************************
 124
 125 \begin{code}
 126 data Name
 127   = Local    Unique
 128              FAST_STRING
 129              SrcLoc
 130
 131   | Global   Unique
 132              RdrName      -- original name; Unqual => prelude
 133              Provenance   -- where it came from
 134              ExportFlag   -- is it exported?
 135              [RdrName]    -- ordered occurrence names (usually just one);
 136                           -- first may be *un*qual.
 137
 138 data Provenance
 139   = LocalDef SrcLoc       -- locally defined; give its source location
 140
 141   | Imported SrcLoc       -- imported; give the *original* source location
 142          --  [SrcLoc]     -- any import source location(s)
 143
 144   | Implicit
 145   | Builtin
 146 \end{code}
 147
 148 \begin{code}
 149 mkLocalName = Local
 150
 151 mkTopLevName   u orig locn exp occs = Global u orig (LocalDef locn) exp occs
 152 mkImportedName u orig locn exp occs = Global u orig (Imported locn) exp occs
 153
 154 mkImplicitName :: Unique -> RdrName -> Name
 155 mkImplicitName u o = Global u o Implicit NotExported []
 156
 157 mkBuiltinName :: Unique -> Module -> FAST_STRING -> Name
 158 mkBuiltinName u m n = Global u (Unqual n) Builtin NotExported []
 159
 160         -- ToDo: what about module ???
 161         -- ToDo: exported when compiling builtin ???
 162
 163 isLocalName (Local _ _ _) = True
 164 isLocalName _           = False
 165
 166 isImplicitName (Global _ _ Implicit _ _) = True
 167 isImplicitName _                         = False
 168
 169 isBuiltinName  (Global _ _ Builtin  _ _) = True
 170 isBuiltinName  _                         = False
 171 \end{code}
 172
 173
 174
 175 %************************************************************************
 176 %*                                                                      *
 177 \subsection[Name-instances]{Instance declarations}
 178 %*                                                                      *
 179 %************************************************************************
 180
 181 \begin{code}
 182 cmpName n1 n2 = c n1 n2
 183   where
 184     c (Local    u1 _ _)     (Local    u2 _ _)     = cmp u1 u2
 185     c (Global   u1 _ _ _ _) (Global   u2 _ _ _ _) = cmp u1 u2
 186
 187     c other_1 other_2           -- the tags *must* be different
 188       = let tag1 = tag_Name n1
 189             tag2 = tag_Name n2
 190         in
 191         if tag1 _LT_ tag2 then LT_ else GT_
 192
 193     tag_Name (Local    _ _ _)     = (ILIT(1) :: FAST_INT)
 194     tag_Name (Global   _ _ _ _ _) = ILIT(2)
 195 \end{code}
 196
 197 \begin{code}
 198 instance Eq Name where
 199     a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
 200     a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
 201
 202 instance Ord Name where
 203     a <= b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
 204     a <  b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> False; GT__ -> False }
 205     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
 206     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
 207
 208 instance Ord3 Name where
 209     cmp = cmpName
 210
 211 instance Uniquable Name where
 212     uniqueOf = nameUnique
 213
 214 instance NamedThing Name where
 215     getName n = n
 216 \end{code}
 217
 218 \begin{code}
 219 nameUnique (Local    u _ _)     = u
 220 nameUnique (Global   u _ _ _ _) = u
 221
 222 nameOrigName (Local    _ n _)        = (panic "NamedThing.Local.nameOrigName", n)
 223 nameOrigName (Global   _ orig _ _ _) = rdrToOrig orig
 224
 225 nameOccName (Local    _ n _)           = Unqual n
 226 nameOccName (Global   _ orig _ _ []  ) = orig
 227 nameOccName (Global   _ orig _ _ occs) = head occs
 228
 229 nameExportFlag (Local    _ _ _)       = NotExported
 230 nameExportFlag (Global   _ _ _ exp _) = exp
 231
 232 nameSrcLoc (Local  _ _ loc)                   = loc
 233 nameSrcLoc (Global _ _ (LocalDef loc) _ _) = loc
 234 nameSrcLoc (Global _ _ (Imported loc) _ _) = loc
 235 nameSrcLoc (Global _ _ Implicit       _ _) = mkUnknownSrcLoc
 236 nameSrcLoc (Global _ _ Builtin        _ _) = mkBuiltinSrcLoc
 237
 238 isLocallyDefinedName (Local  _ _ _)                = True
 239 isLocallyDefinedName (Global _ _ (LocalDef _) _ _) = True
 240 isLocallyDefinedName (Global _ _ (Imported _) _ _) = False
 241 isLocallyDefinedName (Global _ _ Implicit     _ _) = False
 242 isLocallyDefinedName (Global _ _ Builtin      _ _) = False
 243
 244 isPreludeDefinedName (Local    _ n _)        = False
 245 isPreludeDefinedName (Global   _ orig _ _ _) = isUnqual orig
 246 \end{code}
 247
 248 \begin{code}
 249 instance Outputable Name where
 250 #ifdef DEBUG
 251     ppr PprDebug (Local    u n _)     = pp_debug u (ppPStr n)
 252     ppr PprDebug (Global   u o _ _ _) = pp_debug u (ppr PprDebug o)
 253 #endif
 254     ppr sty        (Local    u n _)             = pp_name sty n
 255     ppr PprForUser (Global   u o _ _ []  )      = ppr PprForUser o
 256     ppr PprForUser (Global   u o _ _ occs)      = ppr PprForUser (head occs)
 257     ppr PprShowAll (Global   u o prov exp occs) = pp_all o prov exp occs
 258     ppr sty        (Global   u o _ _ _)         = ppr sty o
 259
 260 pp_debug uniq thing
 261   = ppBesides [thing, ppStr "{-", pprUnique uniq, ppStr "-}" ]
 262
 263 pp_all orig prov exp occs
 264   = ppBesides [ppr PprShowAll orig, ppr PprShowAll occs, pp_prov prov, pp_exp exp]
 265
 266 pp_exp NotExported = ppNil
 267 pp_exp ExportAll   = ppPStr SLIT("/EXP(..)")
 268 pp_exp ExportAbs   = ppPStr SLIT("/EXP")
 269
 270 pp_prov Implicit = ppPStr SLIT("/IMPLICIT")
 271 pp_prov Builtin  = ppPStr SLIT("/BUILTIN")
 272 pp_prov _        = ppNil
 273 \end{code}
 274