1 {-% DrIFT (Automatic class derivations for Haskell) v1.1 %-}
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 \section[RdrName]{@RdrName@}
13 mkRdrUnqual, mkRdrQual,
14 mkUnqual, mkQual, mkOrig, mkIfaceOrig,
15 nameRdrName, getRdrName,
16 qualifyRdrName, unqualifyRdrName, mkRdrNameWkr,
17 dummyRdrVarName, dummyRdrTcName,
20 rdrNameModule, rdrNameOcc, setRdrNameSpace,
21 isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isUnqual,
22 isOrig, isExact, isExact_maybe,
26 emptyRdrEnv, lookupRdrEnv, addListToRdrEnv, rdrEnvElts,
27 extendRdrEnv, rdrEnvToList, elemRdrEnv, foldRdrEnv,
29 -- Printing; instance Outputable RdrName
33 #include "HsVersions.h"
35 import OccName ( NameSpace, tcName,
36 OccName, UserFS, EncodedFS,
37 mkSysOccFS, setOccNameSpace,
38 mkOccFS, mkVarOcc, occNameFlavour,
39 isDataOcc, isTvOcc, isTcOcc, mkWorkerOcc
41 import Module ( ModuleName,
42 mkSysModuleNameFS, mkModuleNameFS
44 import Name ( Name, NamedThing(getName), nameModule, nameOccName )
45 import Module ( moduleName )
49 import Util ( thenCmp )
53 %************************************************************************
55 \subsection{The main data type}
57 %************************************************************************
62 -- Used for ordinary, unqualified occurrences
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
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".
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
84 %************************************************************************
86 \subsection{Simple functions}
88 %************************************************************************
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)
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
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*
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))
119 -- These two are the basic constructors
120 mkRdrUnqual :: OccName -> RdrName
121 mkRdrUnqual occ = Unqual occ
123 mkRdrQual :: ModuleName -> OccName -> RdrName
124 mkRdrQual mod occ = Qual mod occ
126 mkOrig :: ModuleName -> OccName -> RdrName
127 mkOrig mod occ = Orig mod occ
129 mkIfaceOrig :: NameSpace -> EncodedFS -> EncodedFS -> RdrName
130 mkIfaceOrig ns m n = Orig (mkSysModuleNameFS m) (mkSysOccFS ns n)
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)
138 mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
139 mkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccFS sp n)
141 getRdrName :: NamedThing thing => thing -> RdrName
142 getRdrName name = Exact (getName name)
144 nameRdrName :: Name -> RdrName
145 nameRdrName name = Exact name
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)
151 unqualifyRdrName :: RdrName -> RdrName
152 unqualifyRdrName rdr_name = Unqual (rdrNameOcc rdr_name)
154 mkRdrNameWkr :: RdrName -> RdrName -- Worker-ify it
155 mkRdrNameWkr rdr_name = Qual (rdrNameModule rdr_name)
156 (mkWorkerOcc (rdrNameOcc rdr_name))
158 origFromName :: Name -> RdrName
159 origFromName n = Orig (moduleName (nameModule n)) (nameOccName n)
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
168 dummyRdrVarName = Unqual (mkVarOcc FSLIT("V-DUMMY"))
169 dummyRdrTcName = Unqual (mkOccFS tcName FSLIT("TC-DUMMY"))
174 isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
175 isRdrTyVar rn = isTvOcc (rdrNameOcc rn)
176 isRdrTc rn = isTcOcc (rdrNameOcc rn)
178 isUnqual (Unqual _) = True
179 isUnqual other = False
181 isQual (Qual _ _) = True
184 isOrig (Orig _ _) = True
187 isExact (Exact _) = True
188 isExact other = False
190 isExact_maybe (Exact n) = Just n
191 isExact_maybe other = Nothing
195 %************************************************************************
197 \subsection{Instances}
199 %************************************************************************
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
208 ppr_name_space occ = ifPprDebug (parens (text (occNameFlavour occ)))
210 instance OutputableBndr RdrName where
212 | isTvOcc (rdrNameOcc n) = char '@' <+> ppr n
215 pprUnqualRdrName rdr_name = ppr (rdrNameOcc rdr_name)
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 }
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 }
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
233 -- Convert Exact to Orig
234 compare (Exact n1) n2 = origFromName n1 `compare` n2
235 compare n1 (Exact n2) = n1 `compare` origFromName n2
237 compare (Unqual _) _ = LT
238 compare (Qual _ _) (Orig _ _) = LT
244 %************************************************************************
246 \subsection{Environment}
248 %************************************************************************
251 type RdrNameEnv a = FiniteMap RdrName a
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
262 emptyRdrEnv = emptyFM
263 lookupRdrEnv = lookupFM
264 addListToRdrEnv = addListToFM
266 extendRdrEnv = addToFM
267 rdrEnvToList = fmToList
273 instance Binary RdrName where
274 put_ bh (Unqual aa) = do
278 put_ bh (Qual aa ab) = do
283 put_ bh (Orig aa ab) = do
288 put_ bh (Exact n) = pprPanic "No Binary instance for RdrName.Exact" (ppr n)