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