[project @ 2004-11-26 16:19:45 by simonmar]
[ghc-hetmet.git] / ghc / compiler / basicTypes / RdrName.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4
5 \section[RdrName]{@RdrName@}
6
7 \begin{code}
8 module RdrName (
9         RdrName(..),    -- Constructors exported only to BinIface
10
11         -- Construction
12         mkRdrUnqual, mkRdrQual, 
13         mkUnqual, mkVarUnqual, mkQual, mkOrig,
14         nameRdrName, getRdrName, 
15         mkDerivedRdrName, 
16
17         -- Destruction
18         rdrNameModule, rdrNameOcc, setRdrNameSpace,
19         isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isUnqual, 
20         isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
21
22         -- Printing;    instance Outputable RdrName
23
24         -- LocalRdrEnv
25         LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv,
26         lookupLocalRdrEnv, elemLocalRdrEnv,
27
28         -- GlobalRdrEnv
29         GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv, 
30         lookupGlobalRdrEnv, pprGlobalRdrEnv, globalRdrEnvElts,
31         lookupGRE_RdrName, lookupGRE_Name,
32
33         -- GlobalRdrElt, Provenance, ImportSpec
34         GlobalRdrElt(..), Provenance(..), ImportSpec(..),
35         isLocalGRE, unQualOK,
36         pprNameProvenance
37   ) where 
38
39 #include "HsVersions.h"
40
41 import OccName  ( NameSpace, varName,
42                   OccName, UserFS, 
43                   setOccNameSpace,
44                   mkOccFS, occNameFlavour,
45                   isDataOcc, isTvOcc, isTcOcc,
46                   OccEnv, emptyOccEnv, extendOccEnvList, lookupOccEnv, 
47                   elemOccEnv, plusOccEnv_C, extendOccEnv_C, foldOccEnv,
48                   occEnvElts
49                 )
50 import Module   ( Module, mkModuleFS )
51 import Name     ( Name, NamedThing(getName), nameModule, nameParent_maybe,
52                   nameOccName, isExternalName, nameSrcLoc )
53 import SrcLoc   ( isGoodSrcLoc, SrcSpan )
54 import Outputable
55 import Util     ( thenCmp )
56 \end{code}
57
58
59 %************************************************************************
60 %*                                                                      *
61 \subsection{The main data type}
62 %*                                                                      *
63 %************************************************************************
64
65 \begin{code}
66 data RdrName 
67   = Unqual OccName
68         -- Used for ordinary, unqualified occurrences 
69
70   | Qual Module OccName
71         -- A qualified name written by the user in 
72         -- *source* code.  The module isn't necessarily 
73         -- the module where the thing is defined; 
74         -- just the one from which it is imported
75
76   | Orig Module OccName
77         -- An original name; the module is the *defining* module.
78         -- This is used when GHC generates code that will be fed
79         -- into the renamer (e.g. from deriving clauses), but where
80         -- we want to say "Use Prelude.map dammit".  
81  
82   | Exact Name
83         -- We know exactly the Name. This is used 
84         --  (a) when the parser parses built-in syntax like "[]" 
85         --      and "(,)", but wants a RdrName from it
86         --  (b) when converting names to the RdrNames in IfaceTypes
87         --      Here an Exact RdrName always contains an External Name
88         --      (Internal Names are converted to simple Unquals)
89         --  (c) by Template Haskell, when TH has generated a unique name
90 \end{code}
91
92
93 %************************************************************************
94 %*                                                                      *
95 \subsection{Simple functions}
96 %*                                                                      *
97 %************************************************************************
98
99 \begin{code}
100 rdrNameModule :: RdrName -> Module
101 rdrNameModule (Qual m _) = m
102 rdrNameModule (Orig m _) = m
103 rdrNameModule (Exact n)  = nameModule n
104 rdrNameModule (Unqual n) = pprPanic "rdrNameModule" (ppr n)
105
106 rdrNameOcc :: RdrName -> OccName
107 rdrNameOcc (Qual _ occ) = occ
108 rdrNameOcc (Unqual occ) = occ
109 rdrNameOcc (Orig _ occ) = occ
110 rdrNameOcc (Exact name) = nameOccName name
111
112 setRdrNameSpace :: RdrName -> NameSpace -> RdrName
113 -- This rather gruesome function is used mainly by the parser
114 -- When parsing         data T a = T | T1 Int
115 -- we parse the data constructors as *types* because of parser ambiguities,
116 -- so then we need to change the *type constr* to a *data constr*
117 --
118 -- The original-name case *can* occur when parsing
119 --              data [] a = [] | a : [a]
120 -- For the orig-name case we return an unqualified name.
121 setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
122 setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
123 setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
124 setRdrNameSpace (Exact n)    ns = Orig (nameModule n)
125                                        (setOccNameSpace ns (nameOccName n))
126 \end{code}
127
128 \begin{code}
129         -- These two are the basic constructors
130 mkRdrUnqual :: OccName -> RdrName
131 mkRdrUnqual occ = Unqual occ
132
133 mkRdrQual :: Module -> OccName -> RdrName
134 mkRdrQual mod occ = Qual mod occ
135
136 mkOrig :: Module -> OccName -> RdrName
137 mkOrig mod occ = Orig mod occ
138
139 ---------------
140 mkDerivedRdrName :: Name -> (OccName -> OccName) -> (RdrName)
141 mkDerivedRdrName parent mk_occ
142   = mkOrig (nameModule parent) (mk_occ (nameOccName parent))
143
144 ---------------
145         -- These two are used when parsing source files
146         -- They do encode the module and occurrence names
147 mkUnqual :: NameSpace -> UserFS -> RdrName
148 mkUnqual sp n = Unqual (mkOccFS sp n)
149
150 mkVarUnqual :: UserFS -> RdrName
151 mkVarUnqual n = Unqual (mkOccFS varName n)
152
153 mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
154 mkQual sp (m, n) = Qual (mkModuleFS m) (mkOccFS sp n)
155
156 getRdrName :: NamedThing thing => thing -> RdrName
157 getRdrName name = nameRdrName (getName name)
158
159 nameRdrName :: Name -> RdrName
160 nameRdrName name = Exact name
161 -- Keep the Name even for Internal names, so that the
162 -- unique is still there for debug printing, particularly
163 -- of Types (which are converted to IfaceTypes before printing)
164
165 nukeExact :: Name -> RdrName
166 nukeExact n 
167   | isExternalName n = Orig (nameModule n) (nameOccName n)
168   | otherwise        = Unqual (nameOccName n)
169 \end{code}
170
171 \begin{code}
172 isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
173 isRdrTyVar   rn = isTvOcc   (rdrNameOcc rn)
174 isRdrTc      rn = isTcOcc   (rdrNameOcc rn)
175
176 isSrcRdrName (Unqual _) = True
177 isSrcRdrName (Qual _ _) = True
178 isSrcRdrName _          = False
179
180 isUnqual (Unqual _) = True
181 isUnqual other      = False
182
183 isQual (Qual _ _) = True
184 isQual _          = False
185
186 isOrig (Orig _ _) = True
187 isOrig _          = False
188
189 isOrig_maybe (Orig m n) = Just (m,n)
190 isOrig_maybe _          = Nothing
191
192 isExact (Exact _) = True
193 isExact other   = False
194
195 isExact_maybe (Exact n) = Just n
196 isExact_maybe other     = Nothing
197 \end{code}
198
199
200 %************************************************************************
201 %*                                                                      *
202 \subsection{Instances}
203 %*                                                                      *
204 %************************************************************************
205
206 \begin{code}
207 instance Outputable RdrName where
208     ppr (Exact name)   = ppr name
209     ppr (Unqual occ)   = ppr occ <+> ppr_name_space occ
210     ppr (Qual mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
211     ppr (Orig mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
212
213 ppr_name_space occ = ifPprDebug (parens (occNameFlavour occ))
214
215 instance OutputableBndr RdrName where
216     pprBndr _ n 
217         | isTvOcc (rdrNameOcc n) = char '@' <+> ppr n
218         | otherwise              = ppr n
219
220 instance Eq RdrName where
221     (Exact n1)    == (Exact n2)    = n1==n2
222         -- Convert exact to orig
223     (Exact n1)    == r2@(Orig _ _) = nukeExact n1 == r2
224     r1@(Orig _ _) == (Exact n2)    = r1 == nukeExact n2
225
226     (Orig m1 o1)  == (Orig m2 o2)  = m1==m2 && o1==o2
227     (Qual m1 o1)  == (Qual m2 o2)  = m1==m2 && o1==o2
228     (Unqual o1)   == (Unqual o2)   = o1==o2
229     r1 == r2 = False
230
231 instance Ord RdrName where
232     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
233     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
234     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
235     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
236
237         -- Exact < Unqual < Qual < Orig
238         -- [Note: Apr 2004] We used to use nukeExact to convert Exact to Orig 
239         --      before comparing so that Prelude.map == the exact Prelude.map, but 
240         --      that meant that we reported duplicates when renaming bindings 
241         --      generated by Template Haskell; e.g 
242         --      do { n1 <- newName "foo"; n2 <- newName "foo"; 
243         --           <decl involving n1,n2> }
244         --      I think we can do without this conversion
245     compare (Exact n1) (Exact n2) = n1 `compare` n2
246     compare (Exact n1) n2         = LT
247
248     compare (Unqual _)   (Exact _)    = GT
249     compare (Unqual o1)  (Unqual  o2) = o1 `compare` o2
250     compare (Unqual _)   _            = LT
251
252     compare (Qual _ _)   (Exact _)    = GT
253     compare (Qual _ _)   (Unqual _)   = GT
254     compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2) 
255     compare (Qual _ _)   (Orig _ _)   = LT
256
257     compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2) 
258     compare (Orig _ _)   _            = GT
259 \end{code}
260
261
262
263 %************************************************************************
264 %*                                                                      *
265                         LocalRdrEnv
266 %*                                                                      *
267 %************************************************************************
268
269 A LocalRdrEnv is used for local bindings (let, where, lambda, case)
270 It is keyed by OccName, because we never use it for qualified names.
271
272 \begin{code}
273 type LocalRdrEnv = OccEnv Name
274
275 emptyLocalRdrEnv = emptyOccEnv
276
277 extendLocalRdrEnv :: LocalRdrEnv -> [Name] -> LocalRdrEnv
278 extendLocalRdrEnv env names
279   = extendOccEnvList env [(nameOccName n, n) | n <- names]
280
281 lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
282 lookupLocalRdrEnv env (Exact name) = Just name
283 lookupLocalRdrEnv env (Unqual occ) = lookupOccEnv env occ
284 lookupLocalRdrEnv env other        = Nothing
285
286 elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
287 elemLocalRdrEnv rdr_name env 
288   | isUnqual rdr_name = rdrNameOcc rdr_name `elemOccEnv` env
289   | otherwise         = False
290 \end{code}
291
292
293 %************************************************************************
294 %*                                                                      *
295                         GlobalRdrEnv
296 %*                                                                      *
297 %************************************************************************
298
299 \begin{code}
300 type GlobalRdrEnv = OccEnv [GlobalRdrElt]
301         -- Keyed by OccName; when looking up a qualified name
302         -- we look up the OccName part, and then check the Provenance
303         -- to see if the appropriate qualification is valid.  This
304         -- saves routinely doubling the size of the env by adding both
305         -- qualified and unqualified names to the domain.
306         --
307         -- The list in the range is reqd because there may be name clashes
308         -- These only get reported on lookup, not on construction
309
310         -- INVARIANT: All the members of the list have distinct 
311         --            gre_name fields; that is, no duplicate Names
312
313 emptyGlobalRdrEnv = emptyOccEnv
314
315 globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
316 globalRdrEnvElts env = foldOccEnv (++) [] env
317
318 data GlobalRdrElt 
319   = GRE { gre_name   :: Name,
320           gre_prov   :: Provenance      -- Why it's in scope
321     }
322
323 instance Outputable GlobalRdrElt where
324   ppr gre = ppr name <+> pp_parent (nameParent_maybe name)
325                 <+> parens (pprNameProvenance gre)
326           where
327             name = gre_name gre
328             pp_parent (Just p) = brackets (text "parent:" <+> ppr p)
329             pp_parent Nothing  = empty
330
331 pprGlobalRdrEnv :: GlobalRdrEnv -> SDoc
332 pprGlobalRdrEnv env
333   = vcat (map pp (occEnvElts env))
334   where
335     pp gres = ppr (nameOccName (gre_name (head gres))) <> colon <+> 
336               vcat [ ppr (gre_name gre) <+> pprNameProvenance gre
337                    | gre <- gres]
338 \end{code}
339
340 \begin{code}
341 lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
342 lookupGlobalRdrEnv env rdr_name = case lookupOccEnv env rdr_name of
343                                         Nothing   -> []
344                                         Just gres -> gres
345
346 lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
347 lookupGRE_RdrName rdr_name env
348   = case lookupOccEnv env occ of
349         Nothing -> []
350         Just gres | isUnqual rdr_name -> filter unQualOK gres
351                   | otherwise         -> filter (hasQual mod) gres
352   where
353     mod = rdrNameModule rdr_name
354     occ = rdrNameOcc rdr_name
355
356 lookupGRE_Name :: GlobalRdrEnv -> Name -> [GlobalRdrElt]
357 lookupGRE_Name env name
358   = [ gre | gre <- lookupGlobalRdrEnv env (nameOccName name),
359             gre_name gre == name ]
360
361
362 isLocalGRE :: GlobalRdrElt -> Bool
363 isLocalGRE (GRE {gre_prov = LocalDef _}) = True
364 isLocalGRE other                         = False
365
366 unQualOK :: GlobalRdrElt -> Bool
367 -- An unqualifed version of this thing is in scope
368 unQualOK (GRE {gre_prov = LocalDef _})    = True
369 unQualOK (GRE {gre_prov = Imported is _}) = not (all is_qual is)
370
371 hasQual :: Module -> GlobalRdrElt -> Bool
372 -- A qualified version of this thing is in scope
373 hasQual mod (GRE {gre_prov = LocalDef m})    = m == mod
374 hasQual mod (GRE {gre_prov = Imported is _}) = any ((== mod) . is_as) is
375
376 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
377 plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
378
379 mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
380 mkGlobalRdrEnv gres
381   = foldr add emptyGlobalRdrEnv gres
382   where
383     add gre env = extendOccEnv_C (foldr insertGRE) env 
384                                  (nameOccName (gre_name gre)) 
385                                  [gre]
386
387 insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
388 insertGRE new_g [] = [new_g]
389 insertGRE new_g (old_g : old_gs)
390         | gre_name new_g == gre_name old_g
391         = new_g `plusGRE` old_g : old_gs
392         | otherwise
393         = old_g : insertGRE new_g old_gs
394
395 plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
396 -- Used when the gre_name fields match
397 plusGRE g1 g2
398   = GRE { gre_name = gre_name g1,
399           gre_prov = gre_prov g1 `plusProv` gre_prov g2 }
400 \end{code}
401
402
403 %************************************************************************
404 %*                                                                      *
405                         Provenance
406 %*                                                                      *
407 %************************************************************************
408
409 The "provenance" of something says how it came to be in scope.
410
411 \begin{code}
412 data Provenance
413   = LocalDef            -- Defined locally
414         Module
415
416   | Imported            -- Imported
417         [ImportSpec]    -- INVARIANT: non-empty
418         Bool            -- True iff the thing was named *explicitly* 
419                         -- in *any* of the import specs rather than being 
420                         -- imported as part of a group; 
421         -- e.g.
422         --      import B
423         --      import C( T(..) )
424         -- Here, everything imported by B, and the constructors of T
425         -- are not named explicitly; only T is named explicitly.
426         -- This info is used when warning of unused names.
427
428 data ImportSpec         -- Describes a particular import declaration
429                         -- Shared among all the Provenaces for a particular
430                         -- import declaration
431   = ImportSpec {
432         is_mod  :: Module,              -- 'import Muggle'
433                                         -- Note the Muggle may well not be 
434                                         -- the defining module for this thing!
435         is_as   :: Module,              -- 'as M' (or 'Muggle' if there is no 'as' clause)
436         is_qual :: Bool,                -- True <=> qualified (only)
437         is_loc  :: SrcSpan }            -- Location of import statment
438
439 -- Comparison of provenance is just used for grouping 
440 -- error messages (in RnEnv.warnUnusedBinds)
441 instance Eq Provenance where
442   p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
443
444 instance Eq ImportSpec where
445   p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
446
447 instance Ord Provenance where
448    compare (LocalDef _) (LocalDef _)   = EQ
449    compare (LocalDef _) (Imported _ _) = LT
450    compare (Imported _ _) (LocalDef _) = GT
451    compare (Imported is1 _) (Imported is2 _) = compare (head is1) (head is2)
452
453 instance Ord ImportSpec where
454    compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp` 
455                      (is_loc is1 `compare` is_loc is2)
456 \end{code}
457
458 \begin{code}
459 plusProv :: Provenance -> Provenance -> Provenance
460 -- Choose LocalDef over Imported
461 -- There is an obscure bug lurking here; in the presence
462 -- of recursive modules, something can be imported *and* locally
463 -- defined, and one might refer to it with a qualified name from
464 -- the import -- but I'm going to ignore that because it makes
465 -- the isLocalGRE predicate so much nicer this way
466 plusProv (LocalDef m1) (LocalDef m2) 
467   = pprPanic "plusProv" (ppr m1 <+> ppr m2)
468 plusProv p1@(LocalDef _) p2 = p1
469 plusProv p1 p2@(LocalDef _) = p2
470 plusProv (Imported is1 ex1) (Imported is2 ex2) 
471   = Imported (is1++is2) (ex1 || ex2)
472
473 pprNameProvenance :: GlobalRdrElt -> SDoc
474 pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef _})
475   = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
476 pprNameProvenance (GRE {gre_name = name, gre_prov = Imported (why:whys) _})
477   = sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))]
478
479 -- If we know the exact definition point (which we may do with GHCi)
480 -- then show that too.  But not if it's just "imported from X".
481 ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc)
482              | otherwise        = empty
483
484 instance Outputable ImportSpec where
485    ppr imp_spec
486      = ptext SLIT("imported from") <+> ppr (is_mod imp_spec) 
487         <+> ptext SLIT("at") <+> ppr (is_loc imp_spec)
488 \end{code}