[project @ 2005-04-04 11:55:11 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / RnEnv.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[RnEnv]{Environment manipulation for the renamer monad}
5
6 \begin{code}
7 module RnEnv ( 
8         newTopSrcBinder, 
9         lookupLocatedBndrRn, lookupBndrRn, 
10         lookupLocatedTopBndrRn, lookupTopBndrRn,
11         lookupLocatedOccRn, lookupOccRn, 
12         lookupLocatedGlobalOccRn, lookupGlobalOccRn,
13         lookupTopFixSigNames, lookupSrcOcc_maybe,
14         lookupFixityRn, lookupLocatedSigOccRn, 
15         lookupLocatedInstDeclBndr,
16         lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
17
18         newLocalsRn, newIPNameRn,
19         bindLocalNames, bindLocalNamesFV,
20         bindLocatedLocalsFV, bindLocatedLocalsRn,
21         bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
22         bindTyVarsRn, extendTyVarEnvFVRn,
23         bindLocalFixities,
24
25         checkDupNames, mapFvRn,
26         warnUnusedMatches, warnUnusedModules, warnUnusedImports, 
27         warnUnusedTopBinds, warnUnusedLocalBinds,
28         dataTcOccs, unknownNameErr,
29     ) where
30
31 #include "HsVersions.h"
32
33 import LoadIface        ( loadHomeInterface, loadSrcInterface )
34 import IfaceEnv         ( lookupOrig, newGlobalBinder, newIPName )
35 import HsSyn            ( FixitySig(..), HsExpr(..), SyntaxExpr, SyntaxTable,
36                           HsType(..), HsExplicitForAll(..), LHsTyVarBndr, LHsType, 
37                           LSig, Sig(..), Fixity, hsLTyVarName, hsLTyVarLocNames, replaceTyVarName )
38 import RdrHsSyn         ( extractHsTyRdrTyVars )
39 import RdrName          ( RdrName, rdrNameModule, isQual, isUnqual, isOrig,
40                           mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
41                           pprGlobalRdrEnv, lookupGRE_RdrName, 
42                           isExact_maybe, isSrcRdrName,
43                           GlobalRdrElt(..), GlobalRdrEnv, lookupGlobalRdrEnv, 
44                           isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
45                           Provenance(..), pprNameProvenance, ImportSpec(..) 
46                         )
47 import HscTypes         ( availNames, ModIface(..), FixItem(..), lookupFixity )
48 import TcRnMonad
49 import Name             ( Name, nameIsLocalOrFrom, mkInternalName, 
50                           nameSrcLoc, nameOccName, nameModule, nameParent, isExternalName )
51 import NameSet
52 import OccName          ( tcName, isDataOcc, occNameFlavour, reportIfUnused )
53 import Module           ( Module )
54 import PrelNames        ( mkUnboundName, rOOT_MAIN, iNTERACTIVE, consDataConKey, hasKey )
55 import UniqSupply
56 import BasicTypes       ( IPName, mapIPName )
57 import SrcLoc           ( SrcSpan, srcSpanStart, Located(..), eqLocated, unLoc,
58                           srcLocSpan, getLoc, combineSrcSpans, srcSpanStartLine, srcSpanEndLine )
59 import Outputable
60 import Util             ( sortLe )
61 import ListSetOps       ( removeDups )
62 import List             ( nubBy )
63 import DynFlags
64 \end{code}
65
66 %*********************************************************
67 %*                                                      *
68                 Source-code binders
69 %*                                                      *
70 %*********************************************************
71
72 \begin{code}
73 newTopSrcBinder :: Module -> Maybe Name -> Located RdrName -> RnM Name
74 newTopSrcBinder this_mod mb_parent (L loc rdr_name)
75   | Just name <- isExact_maybe rdr_name
76   =     -- This is here to catch 
77         --   (a) Exact-name binders created by Template Haskell
78         --   (b) The PrelBase defn of (say) [] and similar, for which
79         --       the parser reads the special syntax and returns an Exact RdrName
80         -- We are at a binding site for the name, so check first that it 
81         -- the current module is the correct one; otherwise GHC can get
82         -- very confused indeed. This test rejects code like
83         --      data T = (,) Int Int
84         -- unless we are in GHC.Tup
85     ASSERT2( isExternalName name,  ppr name )
86     do  checkErr (this_mod == nameModule name)
87                  (badOrigBinding rdr_name)
88         returnM name
89
90
91   | isOrig rdr_name
92   = do  checkErr (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
93                  (badOrigBinding rdr_name)
94         -- When reading External Core we get Orig names as binders, 
95         -- but they should agree with the module gotten from the monad
96         --
97         -- We can get built-in syntax showing up here too, sadly.  If you type
98         --      data T = (,,,)
99         -- the constructor is parsed as a type, and then RdrHsSyn.tyConToDataCon 
100         -- uses setRdrNameSpace to make it into a data constructors.  At that point
101         -- the nice Exact name for the TyCon gets swizzled to an Orig name.
102         -- Hence the badOrigBinding error message.
103         --
104         -- Except for the ":Main.main = ..." definition inserted into 
105         -- the Main module; ugh!
106
107         -- Because of this latter case, we call newGlobalBinder with a module from 
108         -- the RdrName, not from the environment.  In principle, it'd be fine to 
109         -- have an arbitrary mixture of external core definitions in a single module,
110         -- (apart from module-initialisation issues, perhaps).
111         newGlobalBinder rdr_mod (rdrNameOcc rdr_name) mb_parent 
112                         (srcSpanStart loc) --TODO, should pass the whole span
113
114   | otherwise
115   = newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc)
116   where
117     rdr_mod  = rdrNameModule rdr_name
118 \end{code}
119
120 %*********************************************************
121 %*                                                      *
122         Source code occurrences
123 %*                                                      *
124 %*********************************************************
125
126 Looking up a name in the RnEnv.
127
128 \begin{code}
129 lookupLocatedBndrRn :: Located RdrName -> RnM (Located Name)
130 lookupLocatedBndrRn = wrapLocM lookupBndrRn
131
132 lookupBndrRn :: RdrName -> RnM Name
133 -- NOTE: assumes that the SrcSpan of the binder has already been setSrcSpan'd
134 lookupBndrRn rdr_name
135   = getLocalRdrEnv              `thenM` \ local_env ->
136     case lookupLocalRdrEnv local_env rdr_name of 
137           Just name -> returnM name
138           Nothing   -> lookupTopBndrRn rdr_name
139
140 lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
141 lookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn
142
143 lookupTopBndrRn :: RdrName -> RnM Name
144 -- Look up a top-level source-code binder.   We may be looking up an unqualified 'f',
145 -- and there may be several imported 'f's too, which must not confuse us.
146 -- For example, this is OK:
147 --      import Foo( f )
148 --      infix 9 f       -- The 'f' here does not need to be qualified
149 --      f x = x         -- Nor here, of course
150 -- So we have to filter out the non-local ones.
151 --
152 -- A separate function (importsFromLocalDecls) reports duplicate top level
153 -- decls, so here it's safe just to choose an arbitrary one.
154 --
155 -- There should never be a qualified name in a binding position in Haskell,
156 -- but there can be if we have read in an external-Core file.
157 -- The Haskell parser checks for the illegal qualified name in Haskell 
158 -- source files, so we don't need to do so here.
159
160 lookupTopBndrRn rdr_name
161   | Just name <- isExact_maybe rdr_name
162   = returnM name
163
164   | isOrig rdr_name     
165         -- This deals with the case of derived bindings, where
166         -- we don't bother to call newTopSrcBinder first
167         -- We assume there is no "parent" name
168   = do  { loc <- getSrcSpanM
169         ; newGlobalBinder (rdrNameModule rdr_name)
170                           (rdrNameOcc rdr_name) Nothing (srcSpanStart loc) }
171
172   | otherwise
173   = do  { mb_gre <- lookupGreLocalRn rdr_name
174         ; case mb_gre of
175                 Nothing  -> unboundName rdr_name
176                 Just gre -> returnM (gre_name gre) }
177               
178 -- lookupLocatedSigOccRn is used for type signatures and pragmas
179 -- Is this valid?
180 --   module A
181 --      import M( f )
182 --      f :: Int -> Int
183 --      f x = x
184 -- It's clear that the 'f' in the signature must refer to A.f
185 -- The Haskell98 report does not stipulate this, but it will!
186 -- So we must treat the 'f' in the signature in the same way
187 -- as the binding occurrence of 'f', using lookupBndrRn
188 lookupLocatedSigOccRn :: Located RdrName -> RnM (Located Name)
189 lookupLocatedSigOccRn = lookupLocatedBndrRn
190
191 -- lookupInstDeclBndr is used for the binders in an 
192 -- instance declaration.   Here we use the class name to
193 -- disambiguate.  
194
195 lookupLocatedInstDeclBndr :: Name -> Located RdrName -> RnM (Located Name)
196 lookupLocatedInstDeclBndr cls = wrapLocM (lookupInstDeclBndr cls)
197
198 lookupInstDeclBndr :: Name -> RdrName -> RnM Name
199 lookupInstDeclBndr cls_name rdr_name
200   | isUnqual rdr_name   -- Find all the things the rdr-name maps to
201   = do  {               -- and pick the one with the right parent name
202           let { is_op gre     = cls_name == nameParent (gre_name gre)
203               ; occ           = rdrNameOcc rdr_name
204               ; lookup_fn env = filter is_op (lookupGlobalRdrEnv env occ) }
205         ; mb_gre <- lookupGreRn_help rdr_name lookup_fn
206         ; case mb_gre of
207             Just gre -> return (gre_name gre)
208             Nothing  -> do { addErr (unknownInstBndrErr cls_name rdr_name)
209                            ; return (mkUnboundName rdr_name) } }
210
211   | otherwise   -- Occurs in derived instances, where we just
212                 -- refer directly to the right method
213   = ASSERT2( not (isQual rdr_name), ppr rdr_name )
214           -- NB: qualified names are rejected by the parser
215     lookupImportedName rdr_name
216
217 newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
218 newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
219
220 --------------------------------------------------
221 --              Occurrences
222 --------------------------------------------------
223
224 lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
225 lookupLocatedOccRn = wrapLocM lookupOccRn
226
227 -- lookupOccRn looks up an occurrence of a RdrName
228 lookupOccRn :: RdrName -> RnM Name
229 lookupOccRn rdr_name
230   = getLocalRdrEnv                      `thenM` \ local_env ->
231     case lookupLocalRdrEnv local_env rdr_name of
232           Just name -> returnM name
233           Nothing   -> lookupGlobalOccRn rdr_name
234
235 lookupLocatedGlobalOccRn :: Located RdrName -> RnM (Located Name)
236 lookupLocatedGlobalOccRn = wrapLocM lookupGlobalOccRn
237
238 lookupGlobalOccRn :: RdrName -> RnM Name
239 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global 
240 -- environment.  It's used only for
241 --      record field names
242 --      class op names in class and instance decls
243
244 lookupGlobalOccRn rdr_name
245   | not (isSrcRdrName rdr_name)
246   = lookupImportedName rdr_name 
247
248   | otherwise
249   =     -- First look up the name in the normal environment.
250    lookupGreRn rdr_name                 `thenM` \ mb_gre ->
251    case mb_gre of {
252         Just gre -> returnM (gre_name gre) ;
253         Nothing   -> 
254
255         -- We allow qualified names on the command line to refer to 
256         --  *any* name exported by any module in scope, just as if 
257         -- there was an "import qualified M" declaration for every 
258         -- module.
259    getModule            `thenM` \ mod ->
260    if isQual rdr_name && mod == iNTERACTIVE then        
261                                         -- This test is not expensive,
262         lookupQualifiedName rdr_name    -- and only happens for failed lookups
263    else 
264         unboundName rdr_name }
265
266 lookupImportedName :: RdrName -> TcRnIf m n Name
267 -- Lookup the occurrence of an imported name
268 -- The RdrName is *always* qualified or Exact
269 -- Treat it as an original name, and conjure up the Name
270 -- Usually it's Exact or Orig, but it can be Qual if it
271 --      comes from an hi-boot file.  (This minor infelicity is 
272 --      just to reduce duplication in the parser.)
273 lookupImportedName rdr_name
274   | Just n <- isExact_maybe rdr_name 
275         -- This happens in derived code
276   = returnM n
277
278   | otherwise   -- Always Orig, even when reading a .hi-boot file
279   = ASSERT( not (isUnqual rdr_name) )
280     lookupOrig (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
281
282 unboundName :: RdrName -> RnM Name
283 unboundName rdr_name 
284   = do  { addErr (unknownNameErr rdr_name)
285         ; env <- getGlobalRdrEnv;
286         ; traceRn (vcat [unknownNameErr rdr_name, 
287                          ptext SLIT("Global envt is:"),
288                          nest 3 (pprGlobalRdrEnv env)])
289         ; returnM (mkUnboundName rdr_name) }
290
291 --------------------------------------------------
292 --      Lookup in the Global RdrEnv of the module
293 --------------------------------------------------
294
295 lookupSrcOcc_maybe :: RdrName -> RnM (Maybe Name)
296 -- No filter function; does not report an error on failure
297 lookupSrcOcc_maybe rdr_name
298   = do  { mb_gre <- lookupGreRn rdr_name
299         ; case mb_gre of
300                 Nothing  -> returnM Nothing
301                 Just gre -> returnM (Just (gre_name gre)) }
302         
303 -------------------------
304 lookupGreRn :: RdrName -> RnM (Maybe GlobalRdrElt)
305 -- Just look up the RdrName in the GlobalRdrEnv
306 lookupGreRn rdr_name 
307   = lookupGreRn_help rdr_name (lookupGRE_RdrName rdr_name)
308
309 lookupGreLocalRn :: RdrName -> RnM (Maybe GlobalRdrElt)
310 -- Similar, but restricted to locally-defined things
311 lookupGreLocalRn rdr_name 
312   = lookupGreRn_help rdr_name lookup_fn
313   where
314     lookup_fn env = filter isLocalGRE (lookupGRE_RdrName rdr_name env)
315
316 lookupGreRn_help :: RdrName                     -- Only used in error message
317                  -> (GlobalRdrEnv -> [GlobalRdrElt])    -- Lookup function
318                  -> RnM (Maybe GlobalRdrElt)
319 -- Checks for exactly one match; reports deprecations
320 -- Returns Nothing, without error, if too few
321 lookupGreRn_help rdr_name lookup 
322   = do  { env <- getGlobalRdrEnv
323         ; case lookup env of
324             []    -> returnM Nothing
325             [gre] -> returnM (Just gre)
326             gres  -> do { addNameClashErrRn rdr_name gres
327                         ; returnM (Just (head gres)) } }
328
329 ------------------------------
330 --      GHCi support
331 ------------------------------
332
333 -- A qualified name on the command line can refer to any module at all: we
334 -- try to load the interface if we don't already have it.
335 lookupQualifiedName :: RdrName -> RnM Name
336 lookupQualifiedName rdr_name
337  = let 
338        mod = rdrNameModule rdr_name
339        occ = rdrNameOcc rdr_name
340    in
341    -- Note: we want to behave as we would for a source file import here,
342    -- and respect hiddenness of modules/packages, hence loadSrcInterface.
343    loadSrcInterface doc mod False       `thenM` \ iface ->
344
345    case  [ (mod,occ) | 
346            (mod,avails) <- mi_exports iface,
347            avail        <- avails,
348            name         <- availNames avail,
349            name == occ ] of
350       ((mod,occ):ns) -> ASSERT (null ns) 
351                         lookupOrig mod occ
352       _ -> unboundName rdr_name
353   where
354     doc = ptext SLIT("Need to find") <+> ppr rdr_name
355 \end{code}
356
357 %*********************************************************
358 %*                                                      *
359                 Fixities
360 %*                                                      *
361 %*********************************************************
362
363 \begin{code}
364 lookupTopFixSigNames :: RdrName -> RnM [Name]
365 -- GHC extension: look up both the tycon and data con 
366 -- for con-like things
367 lookupTopFixSigNames rdr_name
368   | Just n <- isExact_maybe rdr_name    
369         -- Special case for (:), which doesn't get into the GlobalRdrEnv
370   = return [n]  -- For this we don't need to try the tycon too
371   | otherwise
372   = do  { mb_gres <- mapM lookupGreLocalRn (dataTcOccs rdr_name)
373         ; return [gre_name gre | Just gre <- mb_gres] }
374
375 --------------------------------
376 bindLocalFixities :: [FixitySig RdrName] -> RnM a -> RnM a
377 -- Used for nested fixity decls
378 -- No need to worry about type constructors here,
379 -- Should check for duplicates but we don't
380 bindLocalFixities fixes thing_inside
381   | null fixes = thing_inside
382   | otherwise  = mappM rn_sig fixes     `thenM` \ new_bit ->
383                  extendFixityEnv new_bit thing_inside
384   where
385     rn_sig (FixitySig lv@(L loc v) fix)
386         = addLocM lookupBndrRn lv       `thenM` \ new_v ->
387           returnM (new_v, (FixItem (rdrNameOcc v) fix loc))
388 \end{code}
389
390 --------------------------------
391 lookupFixity is a bit strange.  
392
393 * Nested local fixity decls are put in the local fixity env, which we
394   find with getFixtyEnv
395
396 * Imported fixities are found in the HIT or PIT
397
398 * Top-level fixity decls in this module may be for Names that are
399     either  Global         (constructors, class operations)
400     or      Local/Exported (everything else)
401   (See notes with RnNames.getLocalDeclBinders for why we have this split.)
402   We put them all in the local fixity environment
403
404 \begin{code}
405 lookupFixityRn :: Name -> RnM Fixity
406 lookupFixityRn name
407   = getModule                           `thenM` \ this_mod ->
408     if nameIsLocalOrFrom this_mod name
409     then        -- It's defined in this module
410         getFixityEnv            `thenM` \ local_fix_env ->
411         traceRn (text "lookupFixityRn" <+> (ppr name $$ ppr local_fix_env)) `thenM_`
412         returnM (lookupFixity local_fix_env name)
413
414     else        -- It's imported
415       -- For imported names, we have to get their fixities by doing a
416       -- loadHomeInterface, and consulting the Ifaces that comes back
417       -- from that, because the interface file for the Name might not
418       -- have been loaded yet.  Why not?  Suppose you import module A,
419       -- which exports a function 'f', thus;
420       --        module CurrentModule where
421       --          import A( f )
422       --        module A( f ) where
423       --          import B( f )
424       -- Then B isn't loaded right away (after all, it's possible that
425       -- nothing from B will be used).  When we come across a use of
426       -- 'f', we need to know its fixity, and it's then, and only
427       -- then, that we load B.hi.  That is what's happening here.
428       --
429       -- loadHomeInterface will find B.hi even if B is a hidden module,
430       -- and that's what we want.
431         initIfaceTcRn (loadHomeInterface doc name)      `thenM` \ iface ->
432         returnM (mi_fix_fn iface (nameOccName name))
433   where
434     doc      = ptext SLIT("Checking fixity for") <+> ppr name
435
436 dataTcOccs :: RdrName -> [RdrName]
437 -- If the input is a data constructor, return both it and a type
438 -- constructor.  This is useful when we aren't sure which we are
439 -- looking at.
440 dataTcOccs rdr_name
441   | Just n <- isExact_maybe rdr_name            -- Ghastly special case
442   , n `hasKey` consDataConKey = [rdr_name]      -- see note below
443   | isDataOcc occ             = [rdr_name_tc, rdr_name]
444   | otherwise                 = [rdr_name]
445   where    
446     occ         = rdrNameOcc rdr_name
447     rdr_name_tc = setRdrNameSpace rdr_name tcName
448
449 -- If the user typed "[]" or "(,,)", we'll generate an Exact RdrName,
450 -- and setRdrNameSpace generates an Orig, which is fine
451 -- But it's not fine for (:), because there *is* no corresponding type
452 -- constructor.  If we generate an Orig tycon for GHC.Base.(:), it'll
453 -- appear to be in scope (because Orig's simply allocate a new name-cache
454 -- entry) and then we get an error when we use dataTcOccs in 
455 -- TcRnDriver.tcRnGetInfo.  Large sigh.
456 \end{code}
457
458 %************************************************************************
459 %*                                                                      *
460                         Rebindable names
461         Dealing with rebindable syntax is driven by the 
462         Opt_NoImplicitPrelude dynamic flag.
463
464         In "deriving" code we don't want to use rebindable syntax
465         so we switch off the flag locally
466
467 %*                                                                      *
468 %************************************************************************
469
470 Haskell 98 says that when you say "3" you get the "fromInteger" from the
471 Standard Prelude, regardless of what is in scope.   However, to experiment
472 with having a language that is less coupled to the standard prelude, we're
473 trying a non-standard extension that instead gives you whatever "Prelude.fromInteger"
474 happens to be in scope.  Then you can
475         import Prelude ()
476         import MyPrelude as Prelude
477 to get the desired effect.
478
479 At the moment this just happens for
480   * fromInteger, fromRational on literals (in expressions and patterns)
481   * negate (in expressions)
482   * minus  (arising from n+k patterns)
483   * "do" notation
484
485 We store the relevant Name in the HsSyn tree, in 
486   * HsIntegral/HsFractional     
487   * NegApp
488   * NPlusKPat
489   * HsDo
490 respectively.  Initially, we just store the "standard" name (PrelNames.fromIntegralName,
491 fromRationalName etc), but the renamer changes this to the appropriate user
492 name if Opt_NoImplicitPrelude is on.  That is what lookupSyntaxName does.
493
494 We treat the orignal (standard) names as free-vars too, because the type checker
495 checks the type of the user thing against the type of the standard thing.
496
497 \begin{code}
498 lookupSyntaxName :: Name                                -- The standard name
499                  -> RnM (SyntaxExpr Name, FreeVars)     -- Possibly a non-standard name
500 lookupSyntaxName std_name
501   = doptM Opt_ImplicitPrelude           `thenM` \ implicit_prelude -> 
502     if implicit_prelude then normal_case
503     else
504         -- Get the similarly named thing from the local environment
505     lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
506     returnM (HsVar usr_name, unitFV usr_name)
507   where
508     normal_case = returnM (HsVar std_name, emptyFVs)
509
510 lookupSyntaxTable :: [Name]                             -- Standard names
511                   -> RnM (SyntaxTable Name, FreeVars)   -- See comments with HsExpr.ReboundNames
512 lookupSyntaxTable std_names
513   = doptM Opt_ImplicitPrelude           `thenM` \ implicit_prelude -> 
514     if implicit_prelude then normal_case 
515     else
516         -- Get the similarly named thing from the local environment
517     mappM (lookupOccRn . mkRdrUnqual . nameOccName) std_names   `thenM` \ usr_names ->
518
519     returnM (std_names `zip` map HsVar usr_names, mkFVs usr_names)
520   where
521     normal_case = returnM (std_names `zip` map HsVar std_names, emptyFVs)
522 \end{code}
523
524
525 %*********************************************************
526 %*                                                      *
527 \subsection{Binding}
528 %*                                                      *
529 %*********************************************************
530
531 \begin{code}
532 newLocalsRn :: [Located RdrName] -> RnM [Name]
533 newLocalsRn rdr_names_w_loc
534   = newUniqueSupply             `thenM` \ us ->
535     returnM (zipWith mk rdr_names_w_loc (uniqsFromSupply us))
536   where
537     mk (L loc rdr_name) uniq
538         | Just name <- isExact_maybe rdr_name = name
539                 -- This happens in code generated by Template Haskell 
540         | otherwise = ASSERT2( isUnqual rdr_name, ppr rdr_name )
541                         -- We only bind unqualified names here
542                         -- lookupRdrEnv doesn't even attempt to look up a qualified RdrName
543                       mkInternalName uniq (rdrNameOcc rdr_name) (srcSpanStart loc)
544
545 bindLocatedLocalsRn :: SDoc     -- Documentation string for error message
546                     -> [Located RdrName]
547                     -> ([Name] -> RnM a)
548                     -> RnM a
549 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
550   =     -- Check for duplicate names
551     checkDupNames doc_str rdr_names_w_loc       `thenM_`
552
553         -- Warn about shadowing, but only in source modules
554     ifOptM Opt_WarnNameShadowing 
555       (checkShadowing doc_str rdr_names_w_loc)  `thenM_`
556
557         -- Make fresh Names and extend the environment
558     newLocalsRn rdr_names_w_loc         `thenM` \ names ->
559     getLocalRdrEnv                      `thenM` \ local_env ->
560     setLocalRdrEnv (extendLocalRdrEnv local_env names)
561                    (enclosed_scope names)
562
563
564 bindLocalNames :: [Name] -> RnM a -> RnM a
565 bindLocalNames names enclosed_scope
566   = getLocalRdrEnv              `thenM` \ name_env ->
567     setLocalRdrEnv (extendLocalRdrEnv name_env names)
568                     enclosed_scope
569
570 bindLocalNamesFV :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
571 bindLocalNamesFV names enclosed_scope
572   = do  { (result, fvs) <- bindLocalNames names enclosed_scope
573         ; returnM (result, delListFromNameSet fvs names) }
574
575
576 -------------------------------------
577         -- binLocalsFVRn is the same as bindLocalsRn
578         -- except that it deals with free vars
579 bindLocatedLocalsFV :: SDoc -> [Located RdrName] -> ([Name] -> RnM (a,FreeVars))
580   -> RnM (a, FreeVars)
581 bindLocatedLocalsFV doc rdr_names enclosed_scope
582   = bindLocatedLocalsRn doc rdr_names   $ \ names ->
583     enclosed_scope names                `thenM` \ (thing, fvs) ->
584     returnM (thing, delListFromNameSet fvs names)
585
586 -------------------------------------
587 bindTyVarsRn :: SDoc -> [LHsTyVarBndr RdrName]
588               -> ([LHsTyVarBndr Name] -> RnM a)
589               -> RnM a
590 -- Haskell-98 binding of type variables; e.g. within a data type decl
591 bindTyVarsRn doc_str tyvar_names enclosed_scope
592   = let
593         located_tyvars = hsLTyVarLocNames tyvar_names
594     in
595     bindLocatedLocalsRn doc_str located_tyvars  $ \ names ->
596     enclosed_scope (zipWith replace tyvar_names names)
597     where 
598         replace (L loc n1) n2 = L loc (replaceTyVarName n1 n2)
599
600 bindPatSigTyVars :: [LHsType RdrName] -> ([Name] -> RnM a) -> RnM a
601   -- Find the type variables in the pattern type 
602   -- signatures that must be brought into scope
603 bindPatSigTyVars tys thing_inside
604   = do  { scoped_tyvars <- doptM Opt_ScopedTypeVariables
605         ; if not scoped_tyvars then 
606                 thing_inside []
607           else 
608     do  { name_env <- getLocalRdrEnv
609         ; let locd_tvs  = [ tv | ty <- tys
610                                , tv <- extractHsTyRdrTyVars ty
611                                , not (unLoc tv `elemLocalRdrEnv` name_env) ]
612               nubbed_tvs = nubBy eqLocated locd_tvs
613                 -- The 'nub' is important.  For example:
614                 --      f (x :: t) (y :: t) = ....
615                 -- We don't want to complain about binding t twice!
616
617         ; bindLocatedLocalsRn doc_sig nubbed_tvs thing_inside }}
618   where
619     doc_sig = text "In a pattern type-signature"
620
621 bindPatSigTyVarsFV :: [LHsType RdrName]
622                    -> RnM (a, FreeVars)
623                    -> RnM (a, FreeVars)
624 bindPatSigTyVarsFV tys thing_inside
625   = bindPatSigTyVars tys        $ \ tvs ->
626     thing_inside                `thenM` \ (result,fvs) ->
627     returnM (result, fvs `delListFromNameSet` tvs)
628
629 bindSigTyVarsFV :: [LSig Name]
630                 -> RnM (a, FreeVars)
631                 -> RnM (a, FreeVars)
632 -- Bind the top-level forall'd type variables in the sigs.
633 -- E.g  f :: a -> a
634 --      f = rhs
635 --      The 'a' scopes over the rhs
636 --
637 -- NB: there'll usually be just one (for a function binding)
638 --     but if there are many, one may shadow the rest; too bad!
639 --      e.g  x :: [a] -> [a]
640 --           y :: [(a,a)] -> a
641 --           (x,y) = e
642 --      In e, 'a' will be in scope, and it'll be the one from 'y'!
643 bindSigTyVarsFV sigs thing_inside
644   = do  { scoped_tyvars <- doptM Opt_ScopedTypeVariables
645         ; if not scoped_tyvars then 
646                 thing_inside 
647           else
648                 bindLocalNamesFV tvs thing_inside }
649   where
650     tvs = [ hsLTyVarName ltv 
651           | L _ (Sig _ (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs, ltv <- ltvs ]
652         -- Note the pattern-match on "Explicit"; we only bind
653         -- type variables from signatures with an explicit top-level for-all
654                                 
655
656 extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
657         -- This function is used only in rnSourceDecl on InstDecl
658 extendTyVarEnvFVRn tyvars thing_inside = bindLocalNamesFV tyvars thing_inside
659
660 -------------------------------------
661 checkDupNames :: SDoc
662               -> [Located RdrName]
663               -> RnM ()
664 checkDupNames doc_str rdr_names_w_loc
665   =     -- Check for duplicated names in a binding group
666     mappM_ (dupNamesErr doc_str) dups
667   where
668     (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc
669
670 -------------------------------------
671 checkShadowing doc_str loc_rdr_names
672   = getLocalRdrEnv              `thenM` \ local_env ->
673     getGlobalRdrEnv             `thenM` \ global_env ->
674     let
675       check_shadow (L loc rdr_name)
676         |  rdr_name `elemLocalRdrEnv` local_env 
677         || not (null (lookupGRE_RdrName rdr_name global_env ))
678         = setSrcSpan loc $ addWarn (shadowedNameWarn doc_str rdr_name)
679         | otherwise = returnM ()
680     in
681     mappM_ check_shadow loc_rdr_names
682 \end{code}
683
684
685 %************************************************************************
686 %*                                                                      *
687 \subsection{Free variable manipulation}
688 %*                                                                      *
689 %************************************************************************
690
691 \begin{code}
692 -- A useful utility
693 mapFvRn f xs = mappM f xs       `thenM` \ stuff ->
694                let
695                   (ys, fvs_s) = unzip stuff
696                in
697                returnM (ys, plusFVs fvs_s)
698 \end{code}
699
700
701 %************************************************************************
702 %*                                                                      *
703 \subsection{Envt utility functions}
704 %*                                                                      *
705 %************************************************************************
706
707 \begin{code}
708 warnUnusedModules :: [(Module,SrcSpan)] -> RnM ()
709 warnUnusedModules mods
710   = ifOptM Opt_WarnUnusedImports (mappM_ bleat mods)
711   where
712     bleat (mod,loc) = setSrcSpan loc $ addWarn (mk_warn mod)
713     mk_warn m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+> 
714                          text "is imported, but nothing from it is used",
715                          parens (ptext SLIT("except perhaps instances visible in") <+>
716                                    quotes (ppr m))]
717
718 warnUnusedImports, warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
719 warnUnusedImports gres  = ifOptM Opt_WarnUnusedImports (warnUnusedGREs gres)
720 warnUnusedTopBinds gres = ifOptM Opt_WarnUnusedBinds   (warnUnusedGREs gres)
721
722 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM ()
723 warnUnusedLocalBinds names = ifOptM Opt_WarnUnusedBinds   (warnUnusedLocals names)
724 warnUnusedMatches    names = ifOptM Opt_WarnUnusedMatches (warnUnusedLocals names)
725
726 -------------------------
727 --      Helpers
728 warnUnusedGREs gres 
729  = warnUnusedBinds [(n,Just p) | GRE {gre_name = n, gre_prov = p} <- gres]
730
731 warnUnusedLocals names
732  = warnUnusedBinds [(n,Nothing) | n<-names]
733
734 warnUnusedBinds :: [(Name,Maybe Provenance)] -> RnM ()
735 warnUnusedBinds names  = mappM_ warnUnusedName (filter reportable names)
736  where reportable (name,_) = reportIfUnused (nameOccName name)
737
738 -------------------------
739
740 warnUnusedName :: (Name, Maybe Provenance) -> RnM ()
741 warnUnusedName (name, prov)
742   = addWarnAt loc $
743     sep [msg <> colon, 
744          nest 2 $ occNameFlavour (nameOccName name) <+> quotes (ppr name)]
745         -- TODO should be a proper span
746   where
747     (loc,msg) = case prov of
748                   Just (Imported is _) -> 
749                      ( is_loc (head is), imp_from (is_mod imp_spec) )
750                      where
751                          imp_spec = head is
752                   other -> 
753                      ( srcLocSpan (nameSrcLoc name), unused_msg )
754
755     unused_msg   = text "Defined but not used"
756     imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"
757 \end{code}
758
759 \begin{code}
760 addNameClashErrRn rdr_name (np1:nps)
761   = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
762                   ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
763   where
764     msg1 = ptext  SLIT("either") <+> mk_ref np1
765     msgs = [ptext SLIT("    or") <+> mk_ref np | np <- nps]
766     mk_ref gre = quotes (ppr (gre_name gre)) <> comma <+> pprNameProvenance gre
767
768 shadowedNameWarn doc shadow
769   = hsep [ptext SLIT("This binding for"), 
770                quotes (ppr shadow),
771                ptext SLIT("shadows an existing binding")]
772     $$ doc
773
774 unknownNameErr rdr_name
775   = sep [ptext SLIT("Not in scope:"), 
776          nest 2 $ occNameFlavour (rdrNameOcc rdr_name) <+> quotes (ppr rdr_name)]
777
778 unknownInstBndrErr cls op
779   = quotes (ppr op) <+> ptext SLIT("is not a (visible) method of class") <+> quotes (ppr cls)
780
781 badOrigBinding name
782   = ptext SLIT("Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
783         -- The rdrNameOcc is because we don't want to print Prelude.(,)
784
785 dupNamesErr :: SDoc -> [Located RdrName] -> RnM ()
786 dupNamesErr descriptor located_names
787   = setSrcSpan big_loc $
788     addErr (vcat [ptext SLIT("Conflicting definitions for") <+> quotes (ppr name1),
789                   locations,
790                   descriptor])
791   where
792     L _ name1 = head located_names
793     locs      = map getLoc located_names
794     big_loc   = foldr1 combineSrcSpans locs
795     one_line  = srcSpanStartLine big_loc == srcSpanEndLine big_loc
796     locations | one_line  = empty 
797               | otherwise = ptext SLIT("Bound at:") <+> 
798                             vcat (map ppr (sortLe (<=) locs))
799 \end{code}