RnEnv.lhs 43 KB
Newer Older
1
%
2
% (c) The GRASP/AQUA Project, Glasgow University, 1992-2006
3
4
5
6
%
\section[RnEnv]{Environment manipulation for the renamer monad}

\begin{code}
7
module RnEnv ( 
8
	newTopSrcBinder, lookupFamInstDeclBndr,
Ian Lynagh's avatar
Ian Lynagh committed
9
	lookupLocatedTopBndrRn, lookupTopBndrRn,
10
	lookupLocatedOccRn, lookupOccRn, 
11
12
13
	lookupLocatedGlobalOccRn, 
	lookupGlobalOccRn, lookupGlobalOccRn_maybe,
	lookupLocalDataTcNames, lookupSigOccRn,
14
	lookupFixityRn, lookupTyFixityRn, 
15
	lookupInstDeclBndr, lookupSubBndr, lookupConstructorFields,
16
	lookupSyntaxName, lookupSyntaxTable, 
17
	lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe,
18
	getLookupOccRn, addUsedRdrNames,
19

20
21
	newLocalBndrRn, newLocalBndrsRn, newIPNameRn,
	bindLocalName, bindLocalNames, bindLocalNamesFV, 
22
	MiniFixityEnv, emptyFsEnv, extendFsEnv, lookupFsEnv,
23
	addLocalFixities,
24
	bindLocatedLocalsFV, bindLocatedLocalsRn,
25
	bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
26
	bindTyVarsRn, bindTyVarsFV, extendTyVarEnvFVRn,
27

28
	checkDupRdrNames, checkDupAndShadowedRdrNames,
29
30
        checkDupNames, checkDupAndShadowedNames, 
	addFvRn, mapFvRn, mapMaybeFvRn, mapFvRnCPS,
Ian Lynagh's avatar
Ian Lynagh committed
31
	warnUnusedMatches,
32
	warnUnusedTopBinds, warnUnusedLocalBinds,
33
	dataTcOccs, unknownNameErr, kindSigErr, perhapsForallMsg
34
    ) where
35

36
#include "HsVersions.h"
37

Simon Marlow's avatar
Simon Marlow committed
38
import LoadIface	( loadInterfaceForName, loadSrcInterface )
39
import IfaceEnv		( lookupOrig, newGlobalBinder, newIPName )
Ian Lynagh's avatar
Ian Lynagh committed
40
import HsSyn
41
import RdrHsSyn		( extractHsTyRdrTyVars )
42
import RdrName
43
import HscTypes		( availNames, ModIface(..), FixItem(..), lookupFixity)
44
import TcEnv		( tcLookupDataCon, tcLookupField, isBrackStage )
45
import TcRnMonad
46
import Id		( isRecordSelector )
47
import Name		( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName,
48
			  nameSrcLoc, nameSrcSpan, nameOccName, nameModule, isExternalName )
49
import NameSet
50
import NameEnv
51
import UniqFM
52
import DataCon		( dataConFieldLabels )
53
import OccName
54
import PrelNames	( mkUnboundName, rOOT_MAIN, iNTERACTIVE, 
55
56
			  consDataConKey, forall_tv_RDR )
import Unique
Ian Lynagh's avatar
Ian Lynagh committed
57
import BasicTypes
58
import ErrUtils		( Message )
Ian Lynagh's avatar
Ian Lynagh committed
59
import SrcLoc
60
import Outputable
61
import Util
62
import Maybes
63
import ListSetOps	( removeDups )
64
import DynFlags
65
import FastString
Ian Lynagh's avatar
Ian Lynagh committed
66
import Control.Monad
Ian Lynagh's avatar
Ian Lynagh committed
67
import Data.List
68
import qualified Data.Set as Set
Ian Lynagh's avatar
Ian Lynagh committed
69
70
71
72
73
74
\end{code}

\begin{code}
-- XXX
thenM :: Monad a => a b -> (b -> a c) -> a c
thenM = (>>=)
75
76
77
78
\end{code}

%*********************************************************
%*							*
79
		Source-code binders
80
81
82
83
%*							*
%*********************************************************

\begin{code}
84
85
newTopSrcBinder :: Located RdrName -> RnM Name
newTopSrcBinder (L loc rdr_name)
86
  | Just name <- isExact_maybe rdr_name
87
  =	-- This is here to catch 
88
89
90
	--   (a) Exact-name binders created by Template Haskell
	--   (b) The PrelBase defn of (say) [] and similar, for which
	--	 the parser reads the special syntax and returns an Exact RdrName
91
   	-- We are at a binding site for the name, so check first that it 
92
	-- the current module is the correct one; otherwise GHC can get
93
94
95
	-- very confused indeed. This test rejects code like
	--	data T = (,) Int Int
	-- unless we are in GHC.Tup
96
    ASSERT2( isExternalName name,  ppr name )
97
98
    do	{ this_mod <- getModule
        ; unless (this_mod == nameModule name)
99
100
	         (addErrAt loc (badOrigBinding rdr_name))
	; return name }
101

102

Simon Marlow's avatar
Simon Marlow committed
103
  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
104
105
  = do	{ this_mod <- getModule
        ; unless (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
106
	         (addErrAt loc (badOrigBinding rdr_name))
107
108
	-- When reading External Core we get Orig names as binders, 
	-- but they should agree with the module gotten from the monad
109
	--
110
111
112
113
114
115
	-- We can get built-in syntax showing up here too, sadly.  If you type
	--	data T = (,,,)
	-- the constructor is parsed as a type, and then RdrHsSyn.tyConToDataCon 
	-- uses setRdrNameSpace to make it into a data constructors.  At that point
	-- the nice Exact name for the TyCon gets swizzled to an Orig name.
	-- Hence the badOrigBinding error message.
116
	--
117
118
119
120
121
122
	-- Except for the ":Main.main = ..." definition inserted into 
	-- the Main module; ugh!

	-- Because of this latter case, we call newGlobalBinder with a module from 
	-- the RdrName, not from the environment.  In principle, it'd be fine to 
	-- have an arbitrary mixture of external core definitions in a single module,
123
	-- (apart from module-initialisation issues, perhaps).
124
	; newGlobalBinder rdr_mod rdr_occ loc }
125
		--TODO, should pass the whole span
126
127

  | otherwise
128
  = do	{ unless (not (isQual rdr_name))
129
130
131
	         (addErrAt loc (badQualBndrErr rdr_name))
	 	-- Binders should not be qualified; if they are, and with a different
		-- module name, we we get a confusing "M.T is not in scope" error later
132
133
134
135
136
137
138
139
140

	; stage <- getStage
	; if isBrackStage stage then
	        -- We are inside a TH bracket, so make an *Internal* name
		-- See Note [Top-level Names in Template Haskell decl quotes] in RnNames
	     do { uniq <- newUnique
	        ; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) } 
	  else	
	  	-- Normal case
141
142
             do { this_mod <- getModule
                ; newGlobalBinder this_mod (rdrNameOcc rdr_name) loc } }
143
144
145
146
\end{code}

%*********************************************************
%*							*
147
	Source code occurrences
148
149
150
151
152
%*							*
%*********************************************************

Looking up a name in the RnEnv.

153
154
155
156
157
158
159
160
161
162
163
164
Note [Type and class operator definitions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We want to reject all of these unless we have -XTypeOperators (Trac #3265)
   data a :*: b  = ...
   class a :*: b where ...
   data (:*:) a b  = ....
   class (:*:) a b where ...
The latter two mean that we are not just looking for a
*syntactically-infix* declaration, but one that uses an operator
OccName.  We use OccName.isSymOcc to detect that case, which isn't
terribly efficient, but there seems to be no better way.

165
\begin{code}
166
167
168
169
170
171
172
lookupTopBndrRn :: RdrName -> RnM Name
lookupTopBndrRn n = do nopt <- lookupTopBndrRn_maybe n
                       case nopt of 
                         Just n' -> return n'
                         Nothing -> do traceRn $ text "lookupTopBndrRn"
                                       unboundName n

173
174
175
lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn

176
lookupTopBndrRn_maybe :: RdrName -> RnM (Maybe Name)
177
-- Look up a top-level source-code binder.   We may be looking up an unqualified 'f',
178
-- and there may be several imported 'f's too, which must not confuse us.
179
180
181
182
-- For example, this is OK:
--	import Foo( f )
--	infix 9 f	-- The 'f' here does not need to be qualified
--	f x = x		-- Nor here, of course
183
-- So we have to filter out the non-local ones.
184
--
185
186
-- A separate function (importsFromLocalDecls) reports duplicate top level
-- decls, so here it's safe just to choose an arbitrary one.
187
--
188
189
190
191
-- There should never be a qualified name in a binding position in Haskell,
-- but there can be if we have read in an external-Core file.
-- The Haskell parser checks for the illegal qualified name in Haskell 
-- source files, so we don't need to do so here.
192

193
lookupTopBndrRn_maybe rdr_name
194
  | Just name <- isExact_maybe rdr_name
195
  = return (Just name)
196

Simon Marlow's avatar
Simon Marlow committed
197
  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name	
198
199
200
	-- This deals with the case of derived bindings, where
	-- we don't bother to call newTopSrcBinder first
	-- We assume there is no "parent" name
201
  = do	{ loc <- getSrcSpanM
202
203
        ; n <- newGlobalBinder rdr_mod rdr_occ loc 
        ; return (Just n)}
204
205

  | otherwise
206
207
208
209
  = do	{  -- Check for operators in type or class declarations
           -- See Note [Type and class operator definitions]
          let occ = rdrNameOcc rdr_name
        ; when (isTcOcc occ && isSymOcc occ)
210
               (do { op_ok <- xoptM Opt_TypeOperators
211
	           ; unless op_ok (addErr (opDeclErr rdr_name)) })
212
213

    	; mb_gre <- lookupGreLocalRn rdr_name
214
	; case mb_gre of
215
216
		Nothing  -> return Nothing
		Just gre -> return (Just $ gre_name gre) }
217
	      
218

219
-----------------------------------------------
220
lookupInstDeclBndr :: Name -> RdrName -> RnM Name
221
222
223
224
225
226
-- This is called on the method name on the left-hand side of an 
-- instance declaration binding. eg.  instance Functor T where
--                                       fmap = ...
--                                       ^^^^ called on this
-- Regardless of how many unqualified fmaps are in scope, we want
-- the one that comes from the Functor class.
227
228
229
230
231
--
-- Furthermore, note that we take no account of whether the 
-- name is only in scope qualified.  I.e. even if method op is
-- in scope as M.op, we still allow plain 'op' on the LHS of
-- an instance decl
232
233
234
235
236
237
238
lookupInstDeclBndr cls rdr
  = do { when (isQual rdr)
       	      (addErr (badQualBndrErr rdr)) 
	       	-- In an instance decl you aren't allowed
      	     	-- to use a qualified name for the method
		-- (Although it'd make perfect sense.)
       ; lookupSubBndr (ParentIs cls) doc rdr }
239
  where
Ian Lynagh's avatar
Ian Lynagh committed
240
    doc = ptext (sLit "method of class") <+> quotes (ppr cls)
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255

-----------------------------------------------
lookupConstructorFields :: Name -> RnM [Name]
-- Look up the fields of a given constructor
--   *	For constructors from this module, use the record field env,
--	which is itself gathered from the (as yet un-typechecked)
--	data type decls
-- 
--    *	For constructors from imported modules, use the *type* environment
--	since imported modles are already compiled, the info is conveniently
--	right there

lookupConstructorFields con_name
  = do	{ this_mod <- getModule
	; if nameIsLocalOrFrom this_mod con_name then
256
	  do { RecFields field_env _ <- getRecFieldEnv
257
	     ; return (lookupNameEnv field_env con_name `orElse` []) }
258
	  else 
259
260
261
262
	  do { con <- tcLookupDataCon con_name
	     ; return (dataConFieldLabels con) } }

-----------------------------------------------
263
264
265
266
267
268
269
270
271
272
273
274
-- Used for record construction and pattern matching
-- When the -XDisambiguateRecordFields flag is on, take account of the
-- constructor name to disambiguate which field to use; it's just the
-- same as for instance decls
-- 
-- NB: Consider this:
--	module Foo where { data R = R { fld :: Int } }
--	module Odd where { import Foo; fld x = x { fld = 3 } }
-- Arguably this should work, because the reference to 'fld' is
-- unambiguous because there is only one field id 'fld' in scope.
-- But currently it's rejected.

275
276
277
278
279
lookupSubBndr :: Parent  -- NoParent   => just look it up as usual
			 -- ParentIs p => use p to disambiguate
              -> SDoc -> RdrName 
              -> RnM Name
lookupSubBndr parent doc rdr_name
280
281
282
283
284
285
286
287
  | Just n <- isExact_maybe rdr_name   -- This happens in derived code
  = return n

  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
  = lookupOrig rdr_mod rdr_occ

  | otherwise	-- Find all the things the rdr-name maps to
  = do	{	-- and pick the one with the right parent name
288
	; env <- getGlobalRdrEnv
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
289
        ; let gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
290
	; case pick parent gres  of
291
292
293
		-- NB: lookupGlobalRdrEnv, not lookupGRE_RdrName!
		--     The latter does pickGREs, but we want to allow 'x'
		--     even if only 'M.x' is in scope
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
294
	    [gre] -> do { addUsedRdrNames (used_rdr_names gre)
295
                        ; return (gre_name gre) }
296
	    []    -> do { addErr (unknownSubordinateErr doc rdr_name)
297
			; traceRn (text "RnEnv.lookup_sub_bndr" <+> (ppr rdr_name $$ ppr gres))
298
299
			; return (mkUnboundName rdr_name) }
	    gres  -> do { addNameClashErrRn rdr_name gres
300
301
302
303
304
305
306
			; return (gre_name (head gres)) } }
  where
    pick NoParent gres		-- Normal lookup 
      = pickGREs rdr_name gres
    pick (ParentIs p) gres	-- Disambiguating lookup
      | isUnqual rdr_name = filter (right_parent p) gres
      | otherwise         = filter (right_parent p) (pickGREs rdr_name gres)
307

308
309
    right_parent p (GRE { gre_par = ParentIs p' }) = p==p' 
    right_parent _ _                               = False
310

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
311
312
313
314
315
316
317
318
319
    -- Note [Usage for sub-bndrs]
    used_rdr_names gre
      | isQual rdr_name = [rdr_name]
      | otherwise       = case gre_prov gre of
                            LocalDef -> [rdr_name]
			    Imported is -> map mk_qual_rdr is
    mk_qual_rdr imp_spec = mkRdrQual (is_as (is_decl imp_spec)) rdr_occ
    rdr_occ = rdrNameOcc rdr_name    

320
321
newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
322

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
323
324
325
-- If the family is declared locally, it will not yet be in the main
-- environment; hence, we pass in an extra one here, which we check first.
-- See "Note [Looking up family names in family instances]" in 'RnNames'.
326
--
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
327
328
329
330
331
332
333
lookupFamInstDeclBndr :: GlobalRdrEnv -> Located RdrName -> RnM Name
lookupFamInstDeclBndr tyclGroupEnv (L loc rdr_name)
  = setSrcSpan loc $
      case lookupGRE_RdrName rdr_name tyclGroupEnv of
        (gre:_) -> return $ gre_name gre
          -- if there is more than one, an error will be raised elsewhere
        []      -> lookupOccRn rdr_name
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
334
\end{code}
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
335

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
336
337
338
339
340
341
342
343
344
345
346
Note [Usage for sub-bndrs]
~~~~~~~~~~~~~~~~~~~~~~~~~~
If you have this
   import qualified M( C( f ) ) 
   intance M.C T where
     f x = x
then is the qualified import M.f used?  Obviously yes.
But the RdrName used in the instance decl is unqualified.  In effect,
we fill in the qualification by looking for f's whose class is M.C
But when adding to the UsedRdrNames we must make that qualification
explicit, otherwise we get "Redundant import of M.C".
347

348
349
350
--------------------------------------------------
--		Occurrences
--------------------------------------------------
351

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
352
\begin{code}
353
354
355
getLookupOccRn :: RnM (Name -> Maybe Name)
getLookupOccRn
  = getLocalRdrEnv			`thenM` \ local_env ->
356
    return (lookupLocalRdrOcc local_env . nameOccName)
357

358
359
360
lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
lookupLocatedOccRn = wrapLocM lookupOccRn

361
-- lookupOccRn looks up an occurrence of a RdrName
362
lookupOccRn :: RdrName -> RnM Name
363
lookupOccRn rdr_name
364
  = getLocalRdrEnv			`thenM` \ local_env ->
365
    case lookupLocalRdrEnv local_env rdr_name of
366
	  Just name -> return name
367
368
	  Nothing   -> lookupGlobalOccRn rdr_name

369
370
371
lookupLocatedGlobalOccRn :: Located RdrName -> RnM (Located Name)
lookupLocatedGlobalOccRn = wrapLocM lookupGlobalOccRn

372
lookupGlobalOccRn :: RdrName -> RnM Name
373
-- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global 
374
375
-- environment.  Adds an error message if the RdrName is not in scope.
-- Also has a special case for GHCi.
376

377
lookupGlobalOccRn rdr_name
378
379
380
381
382
383
384
385
386
387
388
  = do { -- First look up the name in the normal environment.
         mb_name <- lookupGlobalOccRn_maybe rdr_name
       ; case mb_name of {
		Just n  -> return n ;
		Nothing -> do

       { -- We allow qualified names on the command line to refer to 
	 --  *any* name exported by any module in scope, just as if there
	 -- was an "import qualified M" declaration for every module.
	 allow_qual <- doptM Opt_ImplicitImportQualified
       ; mod <- getModule
389
390
               -- This test is not expensive,
               -- and only happens for failed lookups
391
392
393
394
395
396
397
398
399
400
401
       ; if isQual rdr_name && allow_qual && mod == iNTERACTIVE
         then lookupQualifiedName rdr_name
         else unboundName rdr_name } } }

lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
-- No filter function; does not report an error on failure

lookupGlobalOccRn_maybe rdr_name
  | Just n <- isExact_maybe rdr_name   -- This happens in derived code
  = return (Just n)

Simon Marlow's avatar
Simon Marlow committed
402
  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
403
  = do { n <- lookupOrig rdr_mod rdr_occ; return (Just n) }
Simon Marlow's avatar
Simon Marlow committed
404
405

  | otherwise
406
407
408
409
410
  = do	{ mb_gre <- lookupGreRn_maybe rdr_name
	; case mb_gre of
		Nothing  -> return Nothing
		Just gre -> return (Just (gre_name gre)) }

411
412
413
414
415
416

unboundName :: RdrName -> RnM Name
unboundName rdr_name 
  = do	{ addErr (unknownNameErr rdr_name)
	; env <- getGlobalRdrEnv;
	; traceRn (vcat [unknownNameErr rdr_name, 
Ian Lynagh's avatar
Ian Lynagh committed
417
			 ptext (sLit "Global envt is:"),
418
			 nest 3 (pprGlobalRdrEnv env)])
419
	; return (mkUnboundName rdr_name) }
420
421
422
423
424

--------------------------------------------------
--	Lookup in the Global RdrEnv of the module
--------------------------------------------------

425
lookupGreRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
426
-- Just look up the RdrName in the GlobalRdrEnv
427
lookupGreRn_maybe rdr_name 
428
  = lookupGreRn_help rdr_name (lookupGRE_RdrName rdr_name)
429

430
431
432
433
434
435
436
lookupGreRn :: RdrName -> RnM GlobalRdrElt
-- If not found, add error message, and return a fake GRE
lookupGreRn rdr_name 
  = do	{ mb_gre <- lookupGreRn_maybe rdr_name
	; case mb_gre of {
	    Just gre -> return gre ;
	    Nothing  -> do
437
438
	{ traceRn $ text "lookupGreRn"
	; name <- unboundName rdr_name
439
440
441
	; return (GRE { gre_name = name, gre_par = NoParent,
		        gre_prov = LocalDef }) }}}

442
443
444
445
446
447
448
lookupGreLocalRn :: RdrName -> RnM (Maybe GlobalRdrElt)
-- Similar, but restricted to locally-defined things
lookupGreLocalRn rdr_name 
  = lookupGreRn_help rdr_name lookup_fn
  where
    lookup_fn env = filter isLocalGRE (lookupGRE_RdrName rdr_name env)

449
lookupGreRn_help :: RdrName			-- Only used in error message
450
451
452
453
454
455
456
		 -> (GlobalRdrEnv -> [GlobalRdrElt])	-- Lookup function
		 -> RnM (Maybe GlobalRdrElt)
-- Checks for exactly one match; reports deprecations
-- Returns Nothing, without error, if too few
lookupGreRn_help rdr_name lookup 
  = do	{ env <- getGlobalRdrEnv
	; case lookup env of
457
458
459
	    []	  -> return Nothing
	    [gre] -> do { addUsedRdrName gre rdr_name
                        ; return (Just gre) }
460
	    gres  -> do { addNameClashErrRn rdr_name gres
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
			; return (Just (head gres)) } }

addUsedRdrName :: GlobalRdrElt -> RdrName -> RnM ()
-- Record usage of imported RdrNames
addUsedRdrName gre rdr
  | isLocalGRE gre = return ()
  | otherwise      = do { env <- getGblEnv
       			; updMutVar (tcg_used_rdrnames env)
		                    (\s -> Set.insert rdr s) }

addUsedRdrNames :: [RdrName] -> RnM ()
-- Record used sub-binders
-- We don't check for imported-ness here, because it's inconvenient
-- and not stritly necessary.
addUsedRdrNames rdrs
  = do { env <- getGblEnv
       ; updMutVar (tcg_used_rdrnames env)
	 	   (\s -> foldr Set.insert s rdrs) }
479
480
481
482

------------------------------
--	GHCi support
------------------------------
483

484
-- A qualified name on the command line can refer to any module at all: we
485
-- try to load the interface if we don't already have it.
486
lookupQualifiedName :: RdrName -> RnM Name
487
lookupQualifiedName rdr_name
Simon Marlow's avatar
Simon Marlow committed
488
  | Just (mod,occ) <- isQual_maybe rdr_name
489
490
   -- Note: we want to behave as we would for a source file import here,
   -- and respect hiddenness of modules/packages, hence loadSrcInterface.
491
   = loadSrcInterface doc mod False Nothing	`thenM` \ iface ->
492
493
494
495
496
497
498
499
500

   case  [ (mod,occ) | 
	   (mod,avails) <- mi_exports iface,
    	   avail	<- avails,
    	   name 	<- availNames avail,
    	   name == occ ] of
      ((mod,occ):ns) -> ASSERT (null ns) 
			lookupOrig mod occ
      _ -> unboundName rdr_name
Simon Marlow's avatar
Simon Marlow committed
501
502
503

  | otherwise
  = pprPanic "RnEnv.lookupQualifiedName" (ppr rdr_name)
504
  where
Ian Lynagh's avatar
Ian Lynagh committed
505
    doc = ptext (sLit "Need to find") <+> ppr rdr_name
506
\end{code}
507

508
509
Note [Looking up signature names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
lookupSigOccRn is used for type signatures and pragmas
Is this valid?
  module A
	import M( f )
	f :: Int -> Int
	f x = x
It's clear that the 'f' in the signature must refer to A.f
The Haskell98 report does not stipulate this, but it will!
So we must treat the 'f' in the signature in the same way
as the binding occurrence of 'f', using lookupBndrRn

However, consider this case:
	import M( f )
	f :: Int -> Int
	g x = x
We don't want to say 'f' is out of scope; instead, we want to
return the imported 'f', so that later on the reanamer will
correctly report "misplaced type sig".

\begin{code}
530
lookupSigOccRn :: Maybe NameSet	   -- Just ns => these are the binders
531
				   -- 	 	 in the same group
532
				   -- Nothing => signatures without 
533
				   -- 		 binders are expected
534
535
536
				   --		 (a) top-level (SPECIALISE prags)
				   -- 		 (b) class decls
				   --		 (c) hs-boot files
537
538
539
540
541
542
543
544
545
	       -> Sig RdrName
	       -> Located RdrName -> RnM (Located Name)
lookupSigOccRn mb_bound_names sig
  = wrapLocM $ \ rdr_name -> 
    do { mb_name <- lookupBindGroupOcc mb_bound_names (hsSigDoc sig) rdr_name
       ; case mb_name of
	   Left err   -> do { addErr err; return (mkUnboundName rdr_name) }
	   Right name -> return name }

546
547
lookupBindGroupOcc :: Maybe NameSet  -- See notes on the (Maybe NameSet)
	           -> SDoc           --  in lookupSigOccRn
548
549
550
	           -> RdrName -> RnM (Either Message Name)
-- Looks up the RdrName, expecting it to resolve to one of the 
-- bound names passed in.  If not, return an appropriate error message
551
552
--
-- See Note [Looking up signature names]
553
lookupBindGroupOcc mb_bound_names what rdr_name
Ian Lynagh's avatar
Ian Lynagh committed
554
  = do  { local_env <- getLocalRdrEnv
555
556
        ; case lookupLocalRdrEnv local_env rdr_name of {
            Just n  -> check_local_name n;
Ian Lynagh's avatar
Ian Lynagh committed
557
            Nothing -> do       -- Not defined in a nested scope
558
559

        { env <- getGlobalRdrEnv 
Ian Lynagh's avatar
Ian Lynagh committed
560
561
562
563
564
565
566
567
        ; let gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
        ; case (filter isLocalGRE gres) of
            (gre:_) -> check_local_name (gre_name gre)
                        -- If there is more than one local GRE for the 
                        -- same OccName 'f', that will be reported separately
                        -- as a duplicate top-level binding for 'f'
            [] | null gres -> bale_out_with empty
               | otherwise -> bale_out_with import_msg
568
        }}}
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
    where
      check_local_name name 	-- The name is in scope, and not imported
  	  = case mb_bound_names of
  		  Just bound_names | not (name `elemNameSet` bound_names)
				   -> bale_out_with local_msg
	 	  _other -> return (Right name)

      bale_out_with msg 
  	= return (Left (sep [ ptext (sLit "The") <+> what
  				<+> ptext (sLit "for") <+> quotes (ppr rdr_name)
  			   , nest 2 $ ptext (sLit "lacks an accompanying binding")]
  		       $$ nest 2 msg))

      local_msg = parens $ ptext (sLit "The")  <+> what <+> ptext (sLit "must be given where")
  			   <+> quotes (ppr rdr_name) <+> ptext (sLit "is declared")

      import_msg = parens $ ptext (sLit "You cannot give a") <+> what
    			  <+> ptext (sLit "for an imported value")

---------------
lookupLocalDataTcNames :: NameSet -> SDoc -> RdrName -> RnM [Name]
-- GHC extension: look up both the tycon and data con 
-- for con-like things
-- Complain if neither is in scope
lookupLocalDataTcNames bound_names what rdr_name
  | Just n <- isExact_maybe rdr_name	
	-- Special case for (:), which doesn't get into the GlobalRdrEnv
  = return [n]	-- For this we don't need to try the tycon too
  | otherwise
  = do	{ mb_gres <- mapM (lookupBindGroupOcc (Just bound_names) what)
			  (dataTcOccs rdr_name)
	; let (errs, names) = splitEithers mb_gres
	; when (null names) (addErr (head errs))	-- Bleat about one only
	; return names }

dataTcOccs :: RdrName -> [RdrName]
-- If the input is a data constructor, return both it and a type
-- constructor.  This is useful when we aren't sure which we are
-- looking at.
dataTcOccs rdr_name
  | Just n <- isExact_maybe rdr_name		-- Ghastly special case
  , n `hasKey` consDataConKey = [rdr_name]	-- see note below
  | isDataOcc occ 	      = [rdr_name, rdr_name_tc]
  | otherwise 	  	      = [rdr_name]
  where    
    occ 	= rdrNameOcc rdr_name
    rdr_name_tc = setRdrNameSpace rdr_name tcName

-- If the user typed "[]" or "(,,)", we'll generate an Exact RdrName,
-- and setRdrNameSpace generates an Orig, which is fine
-- But it's not fine for (:), because there *is* no corresponding type
-- constructor.  If we generate an Orig tycon for GHC.Base.(:), it'll
-- appear to be in scope (because Orig's simply allocate a new name-cache
-- entry) and then we get an error when we use dataTcOccs in 
-- TcRnDriver.tcRnGetInfo.  Large sigh.
\end{code}


627
628
%*********************************************************
%*							*
629
		Fixities
630
631
632
%*							*
%*********************************************************

633
\begin{code}
634
635
636
637
638
639
640
641
642
643
644
--------------------------------
type FastStringEnv a = UniqFM a		-- Keyed by FastString


emptyFsEnv  :: FastStringEnv a
lookupFsEnv :: FastStringEnv a -> FastString -> Maybe a
extendFsEnv :: FastStringEnv a -> FastString -> a -> FastStringEnv a

emptyFsEnv  = emptyUFM
lookupFsEnv = lookupUFM
extendFsEnv = addToUFM
645

646
--------------------------------
647
type MiniFixityEnv = FastStringEnv (Located Fixity)
648
649
650
	-- Mini fixity env for the names we're about 
	-- to bind, in a single binding group
	--
651
652
653
654
	-- It is keyed by the *FastString*, not the *OccName*, because
	-- the single fixity decl	infix 3 T
	-- affects both the data constructor T and the type constrctor T
	--
655
656
657
	-- We keep the location so that if we find
	-- a duplicate, we can report it sensibly

658
--------------------------------
659
660
-- Used for nested fixity decls to bind names along with their fixities.
-- the fixities are given as a UFM from an OccName's FastString to a fixity decl
661
662
663
664

addLocalFixities :: MiniFixityEnv -> [Name] -> RnM a -> RnM a
addLocalFixities mini_fix_env names thing_inside
  = extendFixityEnv (mapCatMaybes find_fixity names) thing_inside
665
  where
666
667
668
669
670
671
    find_fixity name 
      = case lookupFsEnv mini_fix_env (occNameFS occ) of
          Just (L _ fix) -> Just (name, FixItem occ fix)
          Nothing        -> Nothing
      where
        occ = nameOccName name
672
673
674
\end{code}

--------------------------------
675
676
677
678
679
680
681
682
683
684
685
686
687
688
lookupFixity is a bit strange.  

* Nested local fixity decls are put in the local fixity env, which we
  find with getFixtyEnv

* Imported fixities are found in the HIT or PIT

* Top-level fixity decls in this module may be for Names that are
    either  Global	   (constructors, class operations)
    or 	    Local/Exported (everything else)
  (See notes with RnNames.getLocalDeclBinders for why we have this split.)
  We put them all in the local fixity environment

\begin{code}
689
lookupFixityRn :: Name -> RnM Fixity
690
lookupFixityRn name
691
  = getModule				`thenM` \ this_mod -> 
692
    if nameIsLocalOrFrom this_mod name
693
694
695
696
697
    then do	-- It's defined in this module
      local_fix_env <- getFixityEnv		
      traceRn (text "lookupFixityRn: looking up name in local environment:" <+> 
               vcat [ppr name, ppr local_fix_env])
      return $ lookupFixity local_fix_env name
698
699
    else	-- It's imported
      -- For imported names, we have to get their fixities by doing a
Simon Marlow's avatar
Simon Marlow committed
700
      -- loadInterfaceForName, and consulting the Ifaces that comes back
701
702
703
704
705
706
707
708
709
710
711
      -- from that, because the interface file for the Name might not
      -- have been loaded yet.  Why not?  Suppose you import module A,
      -- which exports a function 'f', thus;
      --        module CurrentModule where
      --	  import A( f )
      -- 	module A( f ) where
      --	  import B( f )
      -- Then B isn't loaded right away (after all, it's possible that
      -- nothing from B will be used).  When we come across a use of
      -- 'f', we need to know its fixity, and it's then, and only
      -- then, that we load B.hi.  That is what's happening here.
712
      --
Simon Marlow's avatar
Simon Marlow committed
713
      -- loadInterfaceForName will find B.hi even if B is a hidden module,
714
      -- and that's what we want.
715
716
717
        loadInterfaceForName doc name	`thenM` \ iface -> do {
          traceRn (text "lookupFixityRn: looking up name in iface cache and found:" <+> 
                   vcat [ppr name, ppr $ mi_fix_fn iface (nameOccName name)]);
718
	   return (mi_fix_fn iface (nameOccName name))
719
                                                           }
720
  where
Ian Lynagh's avatar
Ian Lynagh committed
721
    doc = ptext (sLit "Checking fixity for") <+> ppr name
722

723
724
---------------
lookupTyFixityRn :: Located Name -> RnM Fixity
Ian Lynagh's avatar
Ian Lynagh committed
725
lookupTyFixityRn (L _ n) = lookupFixityRn n
726

727
728
\end{code}

729
730
%************************************************************************
%*									*
731
732
			Rebindable names
	Dealing with rebindable syntax is driven by the 
733
	Opt_RebindableSyntax dynamic flag.
734
735
736
737

	In "deriving" code we don't want to use rebindable syntax
	so we switch off the flag locally

738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
%*									*
%************************************************************************

Haskell 98 says that when you say "3" you get the "fromInteger" from the
Standard Prelude, regardless of what is in scope.   However, to experiment
with having a language that is less coupled to the standard prelude, we're
trying a non-standard extension that instead gives you whatever "Prelude.fromInteger"
happens to be in scope.  Then you can
	import Prelude ()
	import MyPrelude as Prelude
to get the desired effect.

At the moment this just happens for
  * fromInteger, fromRational on literals (in expressions and patterns)
  * negate (in expressions)
  * minus  (arising from n+k patterns)
754
  * "do" notation
755
756

We store the relevant Name in the HsSyn tree, in 
757
  * HsIntegral/HsFractional/HsIsString
758
  * NegApp
759
  * NPlusKPat
760
  * HsDo
761
762
763
respectively.  Initially, we just store the "standard" name (PrelNames.fromIntegralName,
fromRationalName etc), but the renamer changes this to the appropriate user
name if Opt_NoImplicitPrelude is on.  That is what lookupSyntaxName does.
764

765
766
767
We treat the orignal (standard) names as free-vars too, because the type checker
checks the type of the user thing against the type of the standard thing.

768
\begin{code}
769
770
lookupSyntaxName :: Name 				-- The standard name
	         -> RnM (SyntaxExpr Name, FreeVars)	-- Possibly a non-standard name
771
lookupSyntaxName std_name
772
773
  = xoptM Opt_RebindableSyntax		`thenM` \ rebindable_on -> 
    if not rebindable_on then normal_case 
774
    else
775
	-- Get the similarly named thing from the local environment
776
    lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
777
    return (HsVar usr_name, unitFV usr_name)
778
  where
779
    normal_case = return (HsVar std_name, emptyFVs)
780

781
782
783
lookupSyntaxTable :: [Name]				-- Standard names
		  -> RnM (SyntaxTable Name, FreeVars)	-- See comments with HsExpr.ReboundNames
lookupSyntaxTable std_names
784
785
  = xoptM Opt_RebindableSyntax		`thenM` \ rebindable_on -> 
    if not rebindable_on then normal_case 
786
787
    else
    	-- Get the similarly named thing from the local environment
788
    mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names 	`thenM` \ usr_names ->
789

790
    return (std_names `zip` map HsVar usr_names, mkFVs usr_names)
791
  where
792
    normal_case = return (std_names `zip` map HsVar std_names, emptyFVs)
793
794
795
\end{code}


796
797
798
799
800
801
%*********************************************************
%*							*
\subsection{Binding}
%*							*
%*********************************************************

802
\begin{code}
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
newLocalBndrRn :: Located RdrName -> RnM Name
-- Used for non-top-level binders.  These should
-- never be qualified.
newLocalBndrRn (L loc rdr_name)
  | Just name <- isExact_maybe rdr_name 
  = return name	-- This happens in code generated by Template Haskell
		-- although I'm not sure why. Perhpas it's the call
		-- in RnPat.newName LetMk?
  | otherwise
  = do { unless (isUnqual rdr_name)
	        (addErrAt loc (badQualBndrErr rdr_name))
       ; uniq <- newUnique
       ; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) }

newLocalBndrsRn :: [Located RdrName] -> RnM [Name]
newLocalBndrsRn = mapM newLocalBndrRn
819

820
---------------------
821
bindLocatedLocalsRn :: [Located RdrName]
822
823
	    	    -> ([Name] -> RnM a)
	    	    -> RnM a
824
825
bindLocatedLocalsRn rdr_names_w_loc enclosed_scope
  = do { checkDupAndShadowedRdrNames rdr_names_w_loc
826

827
	-- Make fresh Names and extend the environment
828
829
       ; names <- newLocalBndrsRn rdr_names_w_loc
       ; bindLocalNames names (enclosed_scope names) }
830

831
bindLocalNames :: [Name] -> RnM a -> RnM a
832
bindLocalNames names enclosed_scope
833
834
835
836
837
838
839
840
841
  = do { name_env <- getLocalRdrEnv
       ; setLocalRdrEnv (extendLocalRdrEnvList name_env names)
		        enclosed_scope }

bindLocalName :: Name -> RnM a -> RnM a
bindLocalName name enclosed_scope
  = do { name_env <- getLocalRdrEnv
       ; setLocalRdrEnv (extendLocalRdrEnv name_env name)
		        enclosed_scope }
842

843
bindLocalNamesFV :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
844
bindLocalNamesFV names enclosed_scope
845
  = do	{ (result, fvs) <- bindLocalNames names enclosed_scope
846
	; return (result, delFVs names fvs) }
847
848


849
850
851
-------------------------------------
	-- binLocalsFVRn is the same as bindLocalsRn
	-- except that it deals with free vars
852
bindLocatedLocalsFV :: [Located RdrName] 
853
                    -> ([Name] -> RnM (a,FreeVars)) -> RnM (a, FreeVars)
854
855
bindLocatedLocalsFV rdr_names enclosed_scope
  = bindLocatedLocalsRn rdr_names	$ \ names ->
856
    enclosed_scope names		`thenM` \ (thing, fvs) ->
857
    return (thing, delFVs names fvs)
858
859

-------------------------------------
860
861
862
863
864
865
866
867
bindTyVarsFV ::  [LHsTyVarBndr RdrName]
	      -> ([LHsTyVarBndr Name] -> RnM (a, FreeVars))
	      -> RnM (a, FreeVars)
bindTyVarsFV tyvars thing_inside
  = bindTyVarsRn tyvars $ \ tyvars' ->
    do { (res, fvs) <- thing_inside tyvars'
       ; return (res, delFVs (map hsLTyVarName tyvars') fvs) }

868
bindTyVarsRn ::  [LHsTyVarBndr RdrName]
869
	      -> ([LHsTyVarBndr Name] -> RnM a)
870
	      -> RnM a
871
-- Haskell-98 binding of type variables; e.g. within a data type decl
872
873
bindTyVarsRn tyvar_names enclosed_scope
  = bindLocatedLocalsRn located_tyvars	$ \ names ->
874
    do { kind_sigs_ok <- xoptM Opt_KindSignatures
875
       ; unless (null kinded_tyvars || kind_sigs_ok) 
876
877
878
879
880
881
       	 	(mapM_ (addErr . kindSigErr) kinded_tyvars)
       ; enclosed_scope (zipWith replace tyvar_names names) }
  where 
    replace (L loc n1) n2 = L loc (replaceTyVarName n1 n2)
    located_tyvars = hsLTyVarLocNames tyvar_names
    kinded_tyvars  = [n | L _ (KindedTyVar n _) <- tyvar_names]
882

883
bindPatSigTyVars :: [LHsType RdrName] -> ([Name] -> RnM a) -> RnM a
884
885
  -- Find the type variables in the pattern type 
  -- signatures that must be brought into scope
886
bindPatSigTyVars tys thing_inside
887
  = do 	{ scoped_tyvars <- xoptM Opt_ScopedTypeVariables
888
889
890
891
892
893
894
895
	; if not scoped_tyvars then 
		thing_inside []
	  else 
    do 	{ name_env <- getLocalRdrEnv
	; let locd_tvs  = [ tv | ty <- tys
			       , tv <- extractHsTyRdrTyVars ty
			       , not (unLoc tv `elemLocalRdrEnv` name_env) ]
	      nubbed_tvs = nubBy eqLocated locd_tvs
896
897
898
899
		-- The 'nub' is important.  For example:
		--	f (x :: t) (y :: t) = ....
		-- We don't want to complain about binding t twice!

900
	; bindLocatedLocalsRn nubbed_tvs thing_inside }}
901

902
bindPatSigTyVarsFV :: [LHsType RdrName]
903
904
905
906
907
		   -> RnM (a, FreeVars)
	  	   -> RnM (a, FreeVars)
bindPatSigTyVarsFV tys thing_inside
  = bindPatSigTyVars tys	$ \ tvs ->
    thing_inside		`thenM` \ (result,fvs) ->
908
    return (result, fvs `delListFromNameSet` tvs)
909

910
bindSigTyVarsFV :: [Name]
911
912
		-> RnM (a, FreeVars)
	  	-> RnM (a, FreeVars)
913
bindSigTyVarsFV tvs thing_inside
914
  = do	{ scoped_tyvars <- xoptM Opt_ScopedTypeVariables
915
916
917
918
919
920
921
922
923
	; if not scoped_tyvars then 
		thing_inside 
	  else
		bindLocalNamesFV tvs thing_inside }

extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
	-- This function is used only in rnSourceDecl on InstDecl
extendTyVarEnvFVRn tyvars thing_inside = bindLocalNamesFV tyvars thing_inside

924
-------------------------------------
925
926
checkDupRdrNames :: [Located RdrName] -> RnM ()
checkDupRdrNames rdr_names_w_loc
927
  = 	-- Check for duplicated names in a binding group
928
    mapM_ (dupNamesErr getLoc) dups
929
930
931
  where
    (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc

932
933
checkDupNames :: [Name] -> RnM ()
checkDupNames names
sof's avatar
sof committed
934
  = 	-- Check for duplicated names in a binding group
935
    mapM_ (dupNamesErr nameSrcSpan) dups
sof's avatar
sof committed
936
  where
937
    (_, dups) = removeDups (\n1 n2 -> nameOccName n1 `compare` nameOccName n2) names
938

939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
---------------------
checkDupAndShadowedRdrNames :: [Located RdrName] -> RnM ()
checkDupAndShadowedRdrNames loc_rdr_names
  = do	{ checkDupRdrNames loc_rdr_names
	; envs <- getRdrEnvs
	; checkShadowedOccs envs loc_occs }
  where
    loc_occs = [(loc,rdrNameOcc rdr) | L loc rdr <- loc_rdr_names]

checkDupAndShadowedNames :: (GlobalRdrEnv, LocalRdrEnv) -> [Name] -> RnM ()
checkDupAndShadowedNames envs names
  = do { checkDupNames names
       ; checkShadowedOccs envs loc_occs }
  where
    loc_occs = [(nameSrcSpan name, nameOccName name) | name <- names]

955
-------------------------------------
956
957
checkShadowedOccs :: (GlobalRdrEnv, LocalRdrEnv) -> [(SrcSpan,OccName)] -> RnM ()
checkShadowedOccs (global_env,local_env) loc_occs
958
  = ifDOptM Opt_WarnNameShadowing $ 
959
960
    do	{ traceRn (text "shadow" <+> ppr loc_occs)
	; mapM_ check_shadow loc_occs }
961
962
  where
    check_shadow (loc, occ)
963
964
        | startsWithUnderscore occ = return ()	-- Do not report shadowing for "_x"
	  		       	     	    	-- See Trac #3262
Ian Lynagh's avatar
Ian Lynagh committed
965
	| Just n <- mb_local = complain [ptext (sLit "bound at") <+> ppr (nameSrcLoc n)]
966
967
	| otherwise = do { gres' <- filterM is_shadowed_gre gres
			 ; complain (map pprNameProvenance gres') }
968
	where
969
	  complain []      = return ()
970
	  complain pp_locs = addWarnAt loc (shadowedNameWarn occ pp_locs)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
971
972
973
974
	  mb_local = lookupLocalRdrOcc local_env occ
          gres     = lookupGRE_RdrName (mkRdrUnqual occ) global_env
		-- Make an Unqualified RdrName and look that up, so that
		-- we don't find any GREs that are in scope qualified-only
975
976
977
978
979
980

    is_shadowed_gre :: GlobalRdrElt -> RnM Bool	
	-- Returns False for record selectors that are shadowed, when
	-- punning or wild-cards are on (cf Trac #2723)
    is_shadowed_gre gre@(GRE { gre_par = ParentIs _ })
	= do { dflags <- getDOpts
981
	     ; if (xopt Opt_RecordPuns dflags || xopt Opt_RecordWildCards dflags) 
982
983
984
985
986
987
988
989
990
	       then do { is_fld <- is_rec_fld gre; return (not is_fld) }
	       else return True }
    is_shadowed_gre _other = return True

    is_rec_fld gre	-- Return True for record selector ids
	| isLocalGRE gre = do { RecFields _ fld_set <- getRecFieldEnv
			      ; return (gre_name gre `elemNameSet` fld_set) }
	| otherwise	 = do { sel_id <- tcLookupField (gre_name gre)
			      ; return (isRecordSelector sel_id) }
991
\end{code}
992

993
994
995

%************************************************************************
%*									*
996
\subsection{Free variable manipulation}
997
998
999
1000
%*									*
%************************************************************************

\begin{code}
1001
-- A useful utility
1002
1003
1004
1005
addFvRn :: FreeVars -> RnM (thing, FreeVars) -> RnM (thing, FreeVars)
addFvRn fvs1 thing_inside = do { (res, fvs2) <- thing_inside
                               ; return (res, fvs1 `plusFV` fvs2) }

Ian Lynagh's avatar
Ian Lynagh committed
1006
mapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
1007
mapFvRn f xs = do stuff <- mapM f xs
Ian Lynagh's avatar
Ian Lynagh committed
1008
                  case unzip stuff of
1009
                      (ys, fvs_s) -> return (ys, plusFVs fvs_s)
1010

1011
1012
1013
1014
mapMaybeFvRn :: (a -> RnM (b, FreeVars)) -> Maybe a -> RnM (Maybe b, FreeVars)
mapMaybeFvRn _ Nothing = return (Nothing, emptyFVs)
mapMaybeFvRn f (Just x) = do { (y, fvs) <- f x; return (Just y, fvs) }

1015
1016
1017
-- because some of the rename functions are CPSed:
-- maps the function across the list from left to right; 
-- collects all the free vars into one set
1018
1019
mapFvRnCPS :: (a  -> (b   -> RnM c) -> RnM c) 
           -> [a] -> ([b] -> RnM c) -> RnM c
1020

1021
1022
1023
1024
mapFvRnCPS _ []     cont = cont []
mapFvRnCPS f (x:xs) cont = f x 		   $ \ x' -> 
                           mapFvRnCPS f xs $ \ xs' ->
                           cont (x':xs')
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
\end{code}


%************************************************************************
%*									*
\subsection{Envt utility functions}
%*									*
%************************************************************************

\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
1035
warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
1036
warnUnusedTopBinds gres
1037
    = ifDOptM Opt_WarnUnusedBinds
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
    $ do isBoot <- tcIsHsBoot
         let noParent gre = case gre_par gre of
                            NoParent -> True
                            ParentIs _ -> False
             -- Don't warn about unused bindings with parents in
             -- .hs-boot files, as you are sometimes required to give
             -- unused bindings (trac #3449).
             gres' = if isBoot then filter noParent gres
                               else                 gres
         warnUnusedGREs gres'
1048

1049
warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> FreeVars -> RnM ()
1050
1051
1052
warnUnusedLocalBinds = check_unused Opt_WarnUnusedBinds
warnUnusedMatches    = check_unused Opt_WarnUnusedMatches

1053
1054
check_unused :: DynFlag -> [Name] -> FreeVars -> RnM ()
check_unused flag bound_names used_names
1055
 = ifDOptM flag (warnUnusedLocals (filterOut (`elemNameSet` used_names) bound_names))
1056

1057
-------------------------
1058
--	Helpers
Ian Lynagh's avatar
Ian Lynagh committed
1059
warnUnusedGREs :: [GlobalRdrElt] -> RnM ()
1060
warnUnusedGREs gres 
1061
 = warnUnusedBinds [(n,p) | GRE {gre_name = n, gre_prov = p} <- gres]
1062

Ian Lynagh's avatar
Ian Lynagh committed
1063
warnUnusedLocals :: [Name] -> RnM ()
1064
warnUnusedLocals names
1065
 = warnUnusedBinds [(n,LocalDef) | n<-names]
1066

1067
warnUnusedBinds :: [(Name,Provenance)] -> RnM ()
1068
warnUnusedBinds names  = mapM_ warnUnusedName (filter reportable names)
1069
1070
1071
1072
 where reportable (name,_) 
	| isWiredInName name = False	-- Don't report unused wired-in names
					-- Otherwise we get a zillion warnings
					-- from Data.Tuple
1073
	| otherwise = not (startsWithUnderscore (nameOccName name))
1074

1075
1076
-------------------------

1077
1078
warnUnusedName :: (Name, Provenance) -> RnM ()
warnUnusedName (name, LocalDef)
1079
  = addUnusedWarning name (nameSrcSpan name)
Ian Lynagh's avatar
Ian Lynagh committed
1080
		     (ptext (sLit "Defined but not used"))
1081
1082
1083
1084
1085
1086
1087
1088

warnUnusedName (name, Imported is)
  = mapM_ warn is
  where
    warn spec = addUnusedWarning name span msg
	where
	   span = importSpecLoc spec
	   pp_mod = quotes (ppr (importSpecModule spec))
Ian Lynagh's avatar
Ian Lynagh committed
1089
	   msg = ptext (sLit "Imported from") <+> pp_mod <+> ptext (sLit "but not used")
1090

Ian Lynagh's avatar
Ian Lynagh committed
1091
addUnusedWarning :: Name -> SrcSpan -> SDoc -> RnM ()
1092
1093
addUnusedWarning name span msg
  = addWarnAt span $
1094
    sep [msg <> colon, 
1095
1096
	 nest 2 $ pprNonVarNameSpace (occNameSpace (nameOccName name))
			<+> quotes (ppr name)]
1097
\end{code}
1098

1099
\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
1100
addNameClashErrRn :: RdrName -> [GlobalRdrElt] -> RnM ()
1101
addNameClashErrRn rdr_name names
Ian Lynagh's avatar
Ian Lynagh committed
1102
1103
  = addErr (vcat [ptext (sLit "Ambiguous occurrence") <+> quotes (ppr rdr_name),
		  ptext (sLit "It could refer to") <+> vcat (msg1 : msgs)])
1104
  where
1105
    (np1:nps) = names
Ian Lynagh's avatar
Ian Lynagh committed
1106
1107
    msg1 = ptext  (sLit "either") <+> mk_ref np1
    msgs = [ptext (sLit "    or") <+> mk_ref np | np <- nps]
1108
    mk_ref gre = sep [quotes (ppr (gre_name gre)) <> comma, pprNameProvenance gre]
1109

1110
1111
shadowedNameWarn :: OccName -> [SDoc] -> SDoc
shadowedNameWarn occ shadowed_locs
Ian Lynagh's avatar
Ian Lynagh committed
1112
1113
  = sep [ptext (sLit "This binding for") <+> quotes (ppr occ)
	    <+> ptext (sLit "shadows the existing binding") <> plural shadowed_locs,
1114
	 nest 2 (vcat shadowed_locs)]
1115

Ian Lynagh's avatar
Ian Lynagh committed
1116
unknownNameErr :: RdrName -> SDoc
1117
unknownNameErr rdr_name
Ian Lynagh's avatar
Ian Lynagh committed
1118
  = vcat [ hang (ptext (sLit "Not in scope:")) 
1119
1120
1121
1122
	      2 (pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
			  <+> quotes (ppr rdr_name))
	 , extra ]
  where
1123
1124
1125
1126
1127
    extra | rdr_name == forall_tv_RDR = perhapsForallMsg
	  | otherwise 		      = empty

perhapsForallMsg :: SDoc
perhapsForallMsg 
1128
  = vcat [ ptext (sLit "Perhaps you intended to use -XExplicitForAll or similar flag")