2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[Name]{@Name@: to transmit name info from renamer to typechecker}
7 #include "HsVersions.h"
23 mkLocalName, isLocalName,
24 mkTopLevName, mkImportedName,
25 mkImplicitName, isImplicitName,
39 import CStrings ( identToC, cSEP )
40 import Outputable ( Outputable(..), ExportFlag(..), isConop )
41 import PprStyle ( PprStyle(..), codeStyle )
43 import PrelMods ( pRELUDE )
44 import SrcLoc ( mkBuiltinSrcLoc, mkUnknownSrcLoc )
45 import Unique ( pprUnique, Unique )
46 import Util ( thenCmp, _CMP_STRING_, panic )
49 %************************************************************************
51 \subsection[RdrName]{The @RdrName@ datatype; names read from files}
53 %************************************************************************
56 type Module = FAST_STRING
58 data RdrName = Unqual FAST_STRING
59 | Qual Module FAST_STRING
61 isUnqual (Unqual _) = True
62 isUnqual (Qual _ _) = False
64 isQual (Unqual _) = False
65 isQual (Qual _ _) = True
67 isConopRdr (Unqual n) = isConop n
68 isConopRdr (Qual m n) = isConop n
70 appendRdr (Unqual n) str = Unqual (n _APPEND_ str)
71 appendRdr (Qual m n) str = Qual m (n _APPEND_ str)
73 rdrToOrig (Unqual n) = (pRELUDE, n)
74 rdrToOrig (Qual m n) = (m, n)
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)
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 }
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 }
91 instance Ord3 RdrName where
94 instance NamedThing RdrName where
95 -- We're sorta faking it here
97 = Global u rdr_name prov ex [rdr_name]
99 u = panic "NamedThing.RdrName:Unique"
100 prov = panic "NamedThing.RdrName:Provenance"
101 ex = panic "NamedThing.RdrName:ExportFlag"
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)
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 '.']
113 pp_name sty n | codeStyle sty = identToC n
114 | otherwise = ppPStr n
116 showRdr sty rdr = ppShow 100 (ppr sty rdr)
119 %************************************************************************
121 \subsection[Name-datatype]{The @Name@ datatype}
123 %************************************************************************
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.
139 = LocalDef SrcLoc -- locally defined; give its source location
141 | Imported SrcLoc -- imported; give the *original* source location
142 -- [SrcLoc] -- any import source location(s)
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
154 mkImplicitName :: Unique -> RdrName -> Name
155 mkImplicitName u o = Global u o Implicit NotExported []
157 mkBuiltinName :: Unique -> Module -> FAST_STRING -> Name
158 mkBuiltinName u m n = Global u (Unqual n) Builtin NotExported []
160 -- ToDo: what about module ???
161 -- ToDo: exported when compiling builtin ???
163 isLocalName (Local _ _ _) = True
164 isLocalName _ = False
166 isImplicitName (Global _ _ Implicit _ _) = True
167 isImplicitName _ = False
169 isBuiltinName (Global _ _ Builtin _ _) = True
170 isBuiltinName _ = False
175 %************************************************************************
177 \subsection[Name-instances]{Instance declarations}
179 %************************************************************************
182 cmpName n1 n2 = c n1 n2
184 c (Local u1 _ _) (Local u2 _ _) = cmp u1 u2
185 c (Global u1 _ _ _ _) (Global u2 _ _ _ _) = cmp u1 u2
187 c other_1 other_2 -- the tags *must* be different
188 = let tag1 = tag_Name n1
191 if tag1 _LT_ tag2 then LT_ else GT_
193 tag_Name (Local _ _ _) = (ILIT(1) :: FAST_INT)
194 tag_Name (Global _ _ _ _ _) = ILIT(2)
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 }
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 }
208 instance Ord3 Name where
211 instance Uniquable Name where
212 uniqueOf = nameUnique
214 instance NamedThing Name where
219 nameUnique (Local u _ _) = u
220 nameUnique (Global u _ _ _ _) = u
222 nameOrigName (Local _ n _) = (panic "NamedThing.Local.nameOrigName", n)
223 nameOrigName (Global _ orig _ _ _) = rdrToOrig orig
225 nameOccName (Local _ n _) = Unqual n
226 nameOccName (Global _ orig _ _ [] ) = orig
227 nameOccName (Global _ orig _ _ occs) = head occs
229 nameExportFlag (Local _ _ _) = NotExported
230 nameExportFlag (Global _ _ _ exp _) = exp
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
238 isLocallyDefinedName (Local _ _ _) = True
239 isLocallyDefinedName (Global _ _ (LocalDef _) _ _) = True
240 isLocallyDefinedName (Global _ _ (Imported _) _ _) = False
241 isLocallyDefinedName (Global _ _ Implicit _ _) = False
242 isLocallyDefinedName (Global _ _ Builtin _ _) = False
244 isPreludeDefinedName (Local _ n _) = False
245 isPreludeDefinedName (Global _ orig _ _ _) = isUnqual orig
249 instance Outputable Name where
251 ppr PprDebug (Local u n _) = pp_debug u (ppPStr n)
252 ppr PprDebug (Global u o _ _ _) = pp_debug u (ppr PprDebug o)
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
261 = ppBesides [thing, ppStr "{-", pprUnique uniq, ppStr "-}" ]
263 pp_all orig prov exp occs
264 = ppBesides [ppr PprShowAll orig, ppr PprShowAll occs, pp_prov prov, pp_exp exp]
266 pp_exp NotExported = ppNil
267 pp_exp ExportAll = ppPStr SLIT("/EXP(..)")
268 pp_exp ExportAbs = ppPStr SLIT("/EXP")
270 pp_prov Implicit = ppPStr SLIT("/IMPLICIT")
271 pp_prov Builtin = ppPStr SLIT("/BUILTIN")