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

\begin{code}
7
8
module RnEnv ( 
	newTopSrcBinder, 
9
10
11
12
	lookupLocatedBndrRn, lookupBndrRn, 
	lookupLocatedTopBndrRn, lookupTopBndrRn,
	lookupLocatedOccRn, lookupOccRn, 
	lookupLocatedGlobalOccRn, lookupGlobalOccRn,
13
	lookupTopFixSigNames, lookupSrcOcc_maybe,
14
15
	lookupFixityRn, lookupLocatedSigOccRn, 
	lookupLocatedInstDeclBndr,
16
17
18
19
	lookupSyntaxName, lookupSyntaxNames, lookupImportedName,

	newLocalsRn, newIPNameRn,
	bindLocalNames, bindLocalNamesFV,
20
	bindLocatedLocalsFV, bindLocatedLocalsRn,
21
22
23
24
25
26
27
	bindPatSigTyVars, bindPatSigTyVarsFV,
	bindTyVarsRn, extendTyVarEnvFVRn,
	bindLocalFixities,

	checkDupNames, mapFvRn,
	warnUnusedMatches, warnUnusedModules, warnUnusedImports, 
	warnUnusedTopBinds, warnUnusedLocalBinds,
28
	dataTcOccs, unknownNameErr,
29
    ) where
30

31
#include "HsVersions.h"
32

33
34
import LoadIface	( loadSrcInterface )
import IfaceEnv		( lookupOrig, newGlobalBinder, newIPName )
35
import HsSyn
36
import RdrHsSyn		( extractHsTyRdrTyVars )
37
import RdrName		( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
38
39
40
41
42
43
			  mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
			  pprGlobalRdrEnv, lookupGRE_RdrName, 
			  isExact_maybe, isSrcRdrName,
			  GlobalRdrElt(..), GlobalRdrEnv, lookupGlobalRdrEnv, 
			  isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
			  Provenance(..), pprNameProvenance, ImportSpec(..) 
44
			)
45
import HsTypes		( replaceTyVarName )
46
import HscTypes		( availNames, ModIface(..), FixItem(..), lookupFixity )
47
import TcRnMonad
48
import Name		( Name, nameIsLocalOrFrom, mkInternalName, isInternalName,
49
			  nameSrcLoc, nameOccName, nameModuleName, nameParent )
50
import NameSet
51
import OccName		( tcName, isDataOcc, occNameFlavour, reportIfUnused )
52
import Module		( Module, ModuleName, moduleName, mkHomeModule )
53
import PrelNames	( mkUnboundName, rOOT_MAIN_Name, iNTERACTIVE, consDataConKey, hasKey )
54
import UniqSupply
55
import BasicTypes	( IPName, mapIPName )
56
import SrcLoc		( SrcSpan, srcSpanStart, Located(..), eqLocated, unLoc,
57
			  srcLocSpan, getLoc, combineSrcSpans, srcSpanStartLine, srcSpanEndLine )
58
import Outputable
59
import Util		( sortLe )
60
61
import ListSetOps	( removeDups )
import List		( nubBy )
62
import CmdLineOpts
63
import FastString	( FastString )
64
65
66
67
\end{code}

%*********************************************************
%*							*
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
77
78
79
80
81
82
83
84
85
86
87
88
	-- This is here to catch 
	--   (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
	--
  	-- We are at a binding site for the name, so check first that it 
	-- the current module is the correct one; otherwise GHC can get
	-- very confused indeed.  This test rejects code like
	--	data T = (,) Int Int
	-- unless we are in GHC.Tup
  = do	checkErr (isInternalName name || this_mod_name == nameModuleName name)
	         (badOrigBinding rdr_name)
	returnM name
89

90
  | isOrig rdr_name
91
92
  = do	checkErr (rdr_mod_name == this_mod_name || rdr_mod_name == rOOT_MAIN_Name)
	         (badOrigBinding rdr_name)
93
94
	-- When reading External Core we get Orig names as binders, 
	-- but they should agree with the module gotten from the monad
95
	--
96
97
98
99
100
101
	-- 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.
102
	--
103
104
105
106
107
108
	-- 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,
109
	-- (apart from module-initialisation issues, perhaps).
110
111
	newGlobalBinder (mkHomeModule rdr_mod_name) (rdrNameOcc rdr_name) mb_parent 
	    	        (srcSpanStart loc) --TODO, should pass the whole span
112
113

  | otherwise
114
  = newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc)
115
  where
116
117
    this_mod_name = moduleName this_mod
    rdr_mod_name  = rdrNameModule rdr_name
118
119
120
121
\end{code}

%*********************************************************
%*							*
122
	Source code occurrences
123
124
125
126
127
128
%*							*
%*********************************************************

Looking up a name in the RnEnv.

\begin{code}
129
130
131
132
lookupLocatedBndrRn :: Located RdrName -> RnM (Located Name)
lookupLocatedBndrRn = wrapLocM lookupBndrRn

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
139
	  Nothing   -> lookupTopBndrRn rdr_name

140
141
142
lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn

143
144
lookupTopBndrRn :: RdrName -> RnM Name
-- 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
147
148
149
-- 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
150
-- So we have to filter out the non-local ones.
151
--
152
153
-- A separate function (importsFromLocalDecls) reports duplicate top level
-- decls, so here it's safe just to choose an arbitrary one.
154
--
155
156
157
158
-- 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.
159

160
lookupTopBndrRn rdr_name
161
  | Just name <- isExact_maybe rdr_name
162
  = returnM name
163
164
165
166
167

  | isOrig rdr_name	
	-- This deals with the case of derived bindings, where
	-- we don't bother to call newTopSrcBinder first
	-- We assume there is no "parent" name
168
169
170
  = do	{ loc <- getSrcSpanM
	; newGlobalBinder (mkHomeModule (rdrNameModule rdr_name)) 
		          (rdrNameOcc rdr_name) Nothing (srcSpanStart loc) }
171
172

  | otherwise
173
174
175
176
  = do	{ mb_gre <- lookupGreLocalRn rdr_name
	; case mb_gre of
		Nothing  -> unboundName rdr_name
		Just gre -> returnM (gre_name gre) }
177
	      
178
-- lookupLocatedSigOccRn is used for type signatures and pragmas
179
180
181
182
183
184
185
186
187
-- 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
188
189
lookupLocatedSigOccRn :: Located RdrName -> RnM (Located Name)
lookupLocatedSigOccRn = lookupLocatedBndrRn
190

191
192
193
194
-- lookupInstDeclBndr is used for the binders in an 
-- instance declaration.   Here we use the class name to
-- disambiguate.  

195
196
197
lookupLocatedInstDeclBndr :: Name -> Located RdrName -> RnM (Located Name)
lookupLocatedInstDeclBndr cls = wrapLocM (lookupInstDeclBndr cls)

198
lookupInstDeclBndr :: Name -> RdrName -> RnM Name
199
lookupInstDeclBndr cls_name rdr_name
200
201
202
203
204
205
206
207
208
209
210
211
212
  | isUnqual rdr_name	-- Find all the things the rdr-name maps to
  = do	{		-- and pick the one with the right parent name
	  let { is_op gre     = cls_name == nameParent (gre_name gre)
	      ; occ	      = rdrNameOcc rdr_name
	      ; lookup_fn env = filter is_op (lookupGlobalRdrEnv env occ) }
	; mb_gre <- lookupGreRn_help rdr_name lookup_fn
	; case mb_gre of
	    Just gre -> return (gre_name gre)
	    Nothing  -> do { addErr (unknownInstBndrErr cls_name rdr_name)
			   ; return (mkUnboundName rdr_name) } }

  | otherwise	-- Occurs in derived instances, where we just
		-- 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
218
newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
219

220
221
222
--------------------------------------------------
--		Occurrences
--------------------------------------------------
223

224
225
226
lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
lookupLocatedOccRn = wrapLocM lookupOccRn

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
234
	  Nothing   -> lookupGlobalOccRn rdr_name

235
236
237
lookupLocatedGlobalOccRn :: Located RdrName -> RnM (Located Name)
lookupLocatedGlobalOccRn = wrapLocM lookupGlobalOccRn

238
lookupGlobalOccRn :: RdrName -> RnM Name
239
240
241
242
-- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global 
-- environment.  It's used only for
--	record field names
--	class op names in class and instance decls
243

244
lookupGlobalOccRn rdr_name
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
  | not (isSrcRdrName rdr_name)
  = lookupImportedName rdr_name	

  | otherwise
  =	-- First look up the name in the normal environment.
   lookupGreRn rdr_name			`thenM` \ mb_gre ->
   case mb_gre of {
	Just gre -> returnM (gre_name gre) ;
	Nothing   -> 

	-- 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.
   getModule 		`thenM` \ mod ->
   if isQual rdr_name && mod == iNTERACTIVE then	
					-- This test is not expensive,
	lookupQualifiedName rdr_name	-- and only happens for failed lookups
   else	
	unboundName rdr_name }

lookupImportedName :: RdrName -> TcRnIf m n Name
-- Lookup the occurrence of an imported name
-- The RdrName is *always* qualified or Exact
-- Treat it as an original name, and conjure up the Name
-- Usually it's Exact or Orig, but it can be Qual if it
--	comes from an hi-boot file.  (This minor infelicity is 
--	just to reduce duplication in the parser.)
lookupImportedName rdr_name
  | Just n <- isExact_maybe rdr_name 
	-- This happens in derived code
  = returnM n

  | otherwise	-- Always Orig, even when reading a .hi-boot file
  = ASSERT( not (isUnqual rdr_name) )
    lookupOrig (rdrNameModule rdr_name) (rdrNameOcc rdr_name)

unboundName :: RdrName -> RnM Name
unboundName rdr_name 
  = do	{ addErr (unknownNameErr rdr_name)
	; env <- getGlobalRdrEnv;
	; traceRn (vcat [unknownNameErr rdr_name, 
			 ptext SLIT("Global envt is:"),
			 nest 3 (pprGlobalRdrEnv env)])
	; returnM (mkUnboundName rdr_name) }

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

lookupSrcOcc_maybe :: RdrName -> RnM (Maybe Name)
-- No filter function; does not report an error on failure
lookupSrcOcc_maybe rdr_name
  = do	{ mb_gre <- lookupGreRn rdr_name
	; case mb_gre of
		Nothing  -> returnM Nothing
		Just gre -> returnM (Just (gre_name gre)) }
	
-------------------------
lookupGreRn :: RdrName -> RnM (Maybe GlobalRdrElt)
-- Just look up the RdrName in the GlobalRdrEnv
lookupGreRn rdr_name 
  = lookupGreRn_help rdr_name (lookupGRE_RdrName rdr_name)

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)

316
lookupGreRn_help :: RdrName			-- Only used in error message
317
318
319
320
321
322
323
324
		 -> (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
	    []	  -> returnM Nothing
325
	    [gre] -> returnM (Just gre)
326
327
328
329
330
331
	    gres  -> do { addNameClashErrRn rdr_name gres
			; returnM (Just (head gres)) } }

------------------------------
--	GHCi support
------------------------------
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
337
338
339
340
lookupQualifiedName rdr_name
 = let 
       mod = rdrNameModule rdr_name
       occ = rdrNameOcc rdr_name
   in
341
342
343
344
345
346
347
348
349
350
351
352
   loadSrcInterface doc mod False	`thenM` \ iface ->

   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
  where
    doc = ptext SLIT("Need to find") <+> ppr rdr_name
353
\end{code}
354

355
356
%*********************************************************
%*							*
357
		Fixities
358
359
360
%*							*
%*********************************************************

361
\begin{code}
362
363
364
365
366
367
368
369
370
371
372
lookupTopFixSigNames :: RdrName -> RnM [Name]
-- GHC extension: look up both the tycon and data con 
-- for con-like things
lookupTopFixSigNames 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 lookupGreLocalRn (dataTcOccs rdr_name)
	; return [gre_name gre | Just gre <- mb_gres] }

373
--------------------------------
374
bindLocalFixities :: [FixitySig RdrName] -> RnM a -> RnM a
375
376
377
378
379
-- Used for nested fixity decls
-- No need to worry about type constructors here,
-- Should check for duplicates but we don't
bindLocalFixities fixes thing_inside
  | null fixes = thing_inside
380
381
  | otherwise  = mappM rn_sig fixes	`thenM` \ new_bit ->
		 extendFixityEnv new_bit thing_inside
382
  where
383
384
385
    rn_sig (FixitySig lv@(L loc v) fix)
	= addLocM lookupBndrRn lv	`thenM` \ new_v ->
	  returnM (new_v, (FixItem (rdrNameOcc v) fix loc))
386
387
388
\end{code}

--------------------------------
389
390
391
392
393
394
395
396
397
398
399
400
401
402
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}
403
lookupFixityRn :: Name -> RnM Fixity
404
lookupFixityRn name
405
  = getModule				`thenM` \ this_mod ->
406
407
    if nameIsLocalOrFrom this_mod name
    then	-- It's defined in this module
408
	getFixityEnv		`thenM` \ local_fix_env ->
409
	traceRn (text "lookupFixityRn" <+> (ppr name $$ ppr local_fix_env)) `thenM_`
410
	returnM (lookupFixity local_fix_env name)
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425

    else	-- It's imported
      -- For imported names, we have to get their fixities by doing a
      -- loadHomeInterface, and consulting the Ifaces that comes back
      -- 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.
426
427
        loadSrcInterface doc name_mod False	`thenM` \ iface ->
	returnM (mi_fix_fn iface (nameOccName name))
428
429
  where
    doc      = ptext SLIT("Checking fixity for") <+> ppr name
430
    name_mod = nameModuleName name
431

432
433
434
435
436
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
437
438
439
440
  | Just n <- isExact_maybe rdr_name		-- Ghastly special case
  , n `hasKey` consDataConKey = [rdr_name]	-- see note below
  | isDataOcc occ 	      = [rdr_name_tc, rdr_name]
  | otherwise 	  	      = [rdr_name]
441
442
443
  where    
    occ 	= rdrNameOcc rdr_name
    rdr_name_tc = setRdrNameSpace rdr_name tcName
444
445
446
447
448
449
450
451

-- 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.
452
453
\end{code}

454
455
%************************************************************************
%*									*
456
457
458
459
460
461
462
			Rebindable names
	Dealing with rebindable syntax is driven by the 
	Opt_NoImplicitPrelude dynamic flag.

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

463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
%*									*
%************************************************************************

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)
479
  * "do" notation
480
481
482
483
484

We store the relevant Name in the HsSyn tree, in 
  * HsIntegral/HsFractional	
  * NegApp
  * NPlusKPatIn
485
  * HsDo
486
487
488
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.
489

490
491
492
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.

493
\begin{code}
494
lookupSyntaxName :: Name 			-- The standard name
495
	         -> RnM (Name, FreeVars)	-- Possibly a non-standard name
496
lookupSyntaxName std_name
497
498
  = doptM Opt_NoImplicitPrelude		`thenM` \ no_prelude -> 
    if not no_prelude then normal_case
499
    else
500
	-- Get the similarly named thing from the local environment
501
    lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
502
    returnM (usr_name, unitFV usr_name)
503
  where
504
    normal_case = returnM (std_name, emptyFVs)
505
506
507
508
509
510
511
512
513
514

lookupSyntaxNames :: [Name]				-- Standard names
		  -> RnM (ReboundNames Name, FreeVars)	-- See comments with HsExpr.ReboundNames
lookupSyntaxNames std_names
  = doptM Opt_NoImplicitPrelude		`thenM` \ no_prelude -> 
    if not no_prelude then normal_case 
    else
    	-- Get the similarly named thing from the local environment
    mappM (lookupOccRn . mkRdrUnqual . nameOccName) std_names 	`thenM` \ usr_names ->

515
    returnM (std_names `zip` map HsVar usr_names, mkFVs usr_names)
516
  where
517
    normal_case = returnM (std_names `zip` map HsVar std_names, emptyFVs)
518
519
520
\end{code}


521
522
523
524
525
526
%*********************************************************
%*							*
\subsection{Binding}
%*							*
%*********************************************************

527
\begin{code}
528
newLocalsRn :: [Located RdrName] -> RnM [Name]
529
newLocalsRn rdr_names_w_loc
530
531
532
  = newUniqueSupply 		`thenM` \ us ->
    returnM (zipWith mk rdr_names_w_loc (uniqsFromSupply us))
  where
533
    mk (L loc rdr_name) uniq
534
535
536
537
538
	| Just name <- isExact_maybe rdr_name = name
		-- This happens in code generated by Template Haskell 
	| otherwise = ASSERT2( isUnqual rdr_name, ppr rdr_name )
			-- We only bind unqualified names here
			-- lookupRdrEnv doesn't even attempt to look up a qualified RdrName
539
		      mkInternalName uniq (rdrNameOcc rdr_name) (srcSpanStart loc)
540

541
bindLocatedLocalsRn :: SDoc	-- Documentation string for error message
542
	   	    -> [Located RdrName]
543
544
	    	    -> ([Name] -> RnM a)
	    	    -> RnM a
545
bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
546
  = 	-- Check for duplicate names
547
    checkDupNames doc_str rdr_names_w_loc	`thenM_`
548
549

    	-- Warn about shadowing, but only in source modules
550
551
    ifOptM Opt_WarnNameShadowing 
      (checkShadowing doc_str rdr_names_w_loc)	`thenM_`
552

553
	-- Make fresh Names and extend the environment
554
    newLocalsRn rdr_names_w_loc		`thenM` \ names ->
555
556
557
    getLocalRdrEnv			`thenM` \ local_env ->
    setLocalRdrEnv (extendLocalRdrEnv local_env names)
		   (enclosed_scope names)
558

559

560
bindLocalNames names enclosed_scope
561
562
  = getLocalRdrEnv 		`thenM` \ name_env ->
    setLocalRdrEnv (extendLocalRdrEnv name_env names)
563
564
		    enclosed_scope

565
566
bindLocalNamesFV names enclosed_scope
  = bindLocalNames names $
567
568
    enclosed_scope `thenM` \ (thing, fvs) ->
    returnM (thing, delListFromNameSet fvs names)
569
570


571
572
573
-------------------------------------
	-- binLocalsFVRn is the same as bindLocalsRn
	-- except that it deals with free vars
574
575
576
577
bindLocatedLocalsFV :: SDoc -> [Located RdrName] -> ([Name] -> RnM (a,FreeVars))
  -> RnM (a, FreeVars)
bindLocatedLocalsFV doc rdr_names enclosed_scope
  = bindLocatedLocalsRn doc rdr_names	$ \ names ->
578
579
    enclosed_scope names		`thenM` \ (thing, fvs) ->
    returnM (thing, delListFromNameSet fvs names)
580
581

-------------------------------------
582
extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
583
	-- This tiresome function is used only in rnSourceDecl on InstDecl
584
extendTyVarEnvFVRn tyvars enclosed_scope
585
586
  = bindLocalNames tyvars enclosed_scope 	`thenM` \ (thing, fvs) -> 
    returnM (thing, delListFromNameSet fvs tyvars)
587

588
589
bindTyVarsRn :: SDoc -> [LHsTyVarBndr RdrName]
	      -> ([LHsTyVarBndr Name] -> RnM a)
590
	      -> RnM a
591
bindTyVarsRn doc_str tyvar_names enclosed_scope
592
  = let
593
	located_tyvars = hsLTyVarLocNames tyvar_names
594
595
    in
    bindLocatedLocalsRn doc_str located_tyvars	$ \ names ->
596
597
598
    enclosed_scope (zipWith replace tyvar_names names)
    where 
	replace (L loc n1) n2 = L loc (replaceTyVarName n1 n2)
599

600
bindPatSigTyVars :: [LHsType RdrName] -> ([Name] -> RnM a) -> RnM a
601
602
  -- Find the type variables in the pattern type 
  -- signatures that must be brought into scope
603
bindPatSigTyVars tys thing_inside
604
  = getLocalRdrEnv		`thenM` \ name_env ->
605
    let
606
607
608
	located_tyvars  = nubBy eqLocated [ tv | ty <- tys,
				    tv <- extractHsTyRdrTyVars ty,
				    not (unLoc tv `elemLocalRdrEnv` name_env)
609
610
611
612
613
614
			 ]
		-- The 'nub' is important.  For example:
		--	f (x :: t) (y :: t) = ....
		-- We don't want to complain about binding t twice!

	doc_sig        = text "In a pattern type-signature"
615
    in
616
    bindLocatedLocalsRn doc_sig located_tyvars thing_inside
617

618
bindPatSigTyVarsFV :: [LHsType RdrName]
619
620
621
622
623
624
		   -> RnM (a, FreeVars)
	  	   -> RnM (a, FreeVars)
bindPatSigTyVarsFV tys thing_inside
  = bindPatSigTyVars tys	$ \ tvs ->
    thing_inside		`thenM` \ (result,fvs) ->
    returnM (result, fvs `delListFromNameSet` tvs)
625
626

-------------------------------------
627
checkDupNames :: SDoc
628
	      -> [Located RdrName]
629
	      -> RnM ()
sof's avatar
sof committed
630
checkDupNames doc_str rdr_names_w_loc
sof's avatar
sof committed
631
  = 	-- Check for duplicated names in a binding group
632
    mappM_ (dupNamesErr doc_str) dups
sof's avatar
sof committed
633
  where
634
    (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc
635

636
-------------------------------------
637
checkShadowing doc_str loc_rdr_names
638
639
640
  = getLocalRdrEnv		`thenM` \ local_env ->
    getGlobalRdrEnv		`thenM` \ global_env ->
    let
641
      check_shadow (L loc rdr_name)
642
643
	|  rdr_name `elemLocalRdrEnv` local_env 
 	|| not (null (lookupGRE_RdrName rdr_name global_env ))
644
	= setSrcSpan loc $ addWarn (shadowedNameWarn doc_str rdr_name)
645
646
        | otherwise = returnM ()
    in
647
    mappM_ check_shadow loc_rdr_names
648
\end{code}
649

650
651
652

%************************************************************************
%*									*
653
\subsection{Free variable manipulation}
654
655
656
657
%*									*
%************************************************************************

\begin{code}
658
-- A useful utility
659
mapFvRn f xs = mappM f xs	`thenM` \ stuff ->
660
661
662
	       let
		  (ys, fvs_s) = unzip stuff
	       in
663
	       returnM (ys, plusFVs fvs_s)
664
665
666
667
668
669
670
671
672
673
\end{code}


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

\begin{code}
674
warnUnusedModules :: [(ModuleName,SrcSpan)] -> RnM ()
675
warnUnusedModules mods
676
  = ifOptM Opt_WarnUnusedImports (mappM_ bleat mods)
677
  where
678
    bleat (mod,loc) = setSrcSpan loc $ addWarn (mk_warn mod)
679
680
    mk_warn m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+> 
			 text "is imported, but nothing from it is used",
681
			 parens (ptext SLIT("except perhaps instances visible in") <+>
682
				   quotes (ppr m))]
683

684
warnUnusedImports, warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
685
686
warnUnusedImports gres  = ifOptM Opt_WarnUnusedImports (warnUnusedGREs gres)
warnUnusedTopBinds gres = ifOptM Opt_WarnUnusedBinds   (warnUnusedGREs gres)
687

688
warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM ()
689
690
warnUnusedLocalBinds names = ifOptM Opt_WarnUnusedBinds   (warnUnusedLocals names)
warnUnusedMatches    names = ifOptM Opt_WarnUnusedMatches (warnUnusedLocals names)
691

692
-------------------------
693
--	Helpers
694
695
warnUnusedGREs gres 
 = warnUnusedBinds [(n,Just p) | GRE {gre_name = n, gre_prov = p} <- gres]
696

697
698
warnUnusedLocals names
 = warnUnusedBinds [(n,Nothing) | n<-names]
699

700
701
702
warnUnusedBinds :: [(Name,Maybe Provenance)] -> RnM ()
warnUnusedBinds names  = mappM_ warnUnusedName (filter reportable names)
 where reportable (name,_) = reportIfUnused (nameOccName name)
703

704
705
-------------------------

706
707
warnUnusedName :: (Name, Maybe Provenance) -> RnM ()
warnUnusedName (name, prov)
708
709
710
  = addWarnAt loc $
    sep [msg <> colon, 
	 nest 2 $ occNameFlavour (nameOccName name) <+> quotes (ppr name)]
711
	-- TODO should be a proper span
712
  where
713
714
715
716
717
718
719
    (loc,msg) = case prov of
		  Just (Imported is _) -> 
		     ( is_loc (head is), imp_from (is_mod imp_spec) )
		     where
			 imp_spec = head is
		  other -> 
		     ( srcLocSpan (nameSrcLoc name), unused_msg )
720
721
722

    unused_msg   = text "Defined but not used"
    imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"
723
\end{code}
724

725
\begin{code}
726
addNameClashErrRn rdr_name (np1:nps)
727
  = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
728
		  ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
729
  where
730
731
    msg1 = ptext  SLIT("either") <+> mk_ref np1
    msgs = [ptext SLIT("    or") <+> mk_ref np | np <- nps]
732
    mk_ref gre = quotes (ppr (gre_name gre)) <> comma <+> pprNameProvenance gre
733

734
shadowedNameWarn doc shadow
sof's avatar
sof committed
735
  = hsep [ptext SLIT("This binding for"), 
736
	       quotes (ppr shadow),
sof's avatar
sof committed
737
	       ptext SLIT("shadows an existing binding")]
738
    $$ doc
739

740
unknownNameErr rdr_name
741
  = sep [ptext SLIT("Not in scope:"), 
742
	 nest 2 $ occNameFlavour (rdrNameOcc rdr_name) <+> quotes (ppr rdr_name)]
743

744
745
746
unknownInstBndrErr cls op
  = quotes (ppr op) <+> ptext SLIT("is not a (visible) method of class") <+> quotes (ppr cls)

747
748
749
750
badOrigBinding name
  = ptext SLIT("Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
	-- The rdrNameOcc is because we don't want to print Prelude.(,)

751
752
753
754
755
756
757
758
759
760
761
762
dupNamesErr :: SDoc -> [Located RdrName] -> RnM ()
dupNamesErr descriptor located_names
  = setSrcSpan big_loc $
    addErr (vcat [ptext SLIT("Conflicting definitions for") <+> quotes (ppr name1),
		  locations,
		  descriptor])
  where
    L _ name1 = head located_names
    locs      = map getLoc located_names
    big_loc   = foldr1 combineSrcSpans locs
    one_line  = srcSpanStartLine big_loc == srcSpanEndLine big_loc
    locations | one_line  = empty 
763
764
	      | otherwise = ptext SLIT("Bound at:") <+> 
			    vcat (map ppr (sortLe (<=) locs))
765
\end{code}