RnEnv.lhs 28.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
	bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
22
23
24
25
26
27
	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, 
49
			  nameSrcLoc, nameOccName, nameModule, nameParent, isExternalName )
50
import NameSet
51
import OccName		( tcName, isDataOcc, occNameFlavour, reportIfUnused )
52
53
import Module		( Module )
import PrelNames	( mkUnboundName, rOOT_MAIN, 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
  =	-- This is here to catch 
77
78
79
	--   (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
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
83
84
	-- very confused indeed. This test rejects code like
	--	data T = (,) Int Int
	-- unless we are in GHC.Tup
85
    ASSERT2( isExternalName name,  ppr name )
86
87
88
89
    do	checkErr (this_mod == nameModule name)
	         (badOrigBinding rdr_name)
	returnM name

90

91
  | isOrig rdr_name
92
  = do	checkErr (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
93
	         (badOrigBinding rdr_name)
94
95
	-- When reading External Core we get Orig names as binders, 
	-- but they should agree with the module gotten from the monad
96
	--
97
98
99
100
101
102
	-- 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.
103
	--
104
105
106
107
108
109
	-- 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,
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
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
  = do	{ loc <- getSrcSpanM
169
	; newGlobalBinder (rdrNameModule rdr_name)
170
		          (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 = nameModule 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_ImplicitPrelude		`thenM` \ implicit_prelude -> 
    if implicit_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

lookupSyntaxNames :: [Name]				-- Standard names
		  -> RnM (ReboundNames Name, FreeVars)	-- See comments with HsExpr.ReboundNames
lookupSyntaxNames std_names
509
510
  = doptM Opt_ImplicitPrelude		`thenM` \ implicit_prelude -> 
    if implicit_prelude then normal_case 
511
512
513
514
    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 :: [Name] -> RnM a -> RnM a
561
bindLocalNames names enclosed_scope
562
563
  = getLocalRdrEnv 		`thenM` \ name_env ->
    setLocalRdrEnv (extendLocalRdrEnv name_env names)
564
565
		    enclosed_scope

566
bindLocalNamesFV :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
567
bindLocalNamesFV names enclosed_scope
568
569
  = do	{ (result, fvs) <- bindLocalNames names enclosed_scope
	; returnM (result, delListFromNameSet fvs names) }
570
571


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

-------------------------------------
583
584
bindTyVarsRn :: SDoc -> [LHsTyVarBndr RdrName]
	      -> ([LHsTyVarBndr Name] -> RnM a)
585
	      -> RnM a
586
-- Haskell-98 binding of type variables; e.g. within a data type decl
587
bindTyVarsRn doc_str tyvar_names enclosed_scope
588
  = let
589
	located_tyvars = hsLTyVarLocNames tyvar_names
590
591
    in
    bindLocatedLocalsRn doc_str located_tyvars	$ \ names ->
592
593
594
    enclosed_scope (zipWith replace tyvar_names names)
    where 
	replace (L loc n1) n2 = L loc (replaceTyVarName n1 n2)
595

596
bindPatSigTyVars :: [LHsType RdrName] -> ([Name] -> RnM a) -> RnM a
597
598
  -- Find the type variables in the pattern type 
  -- signatures that must be brought into scope
599
bindPatSigTyVars tys thing_inside
600
601
602
603
604
605
606
607
608
  = do 	{ scoped_tyvars <- doptM Opt_ScopedTypeVariables
	; 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
609
610
611
612
		-- The 'nub' is important.  For example:
		--	f (x :: t) (y :: t) = ....
		-- We don't want to complain about binding t twice!

613
614
615
	; bindLocatedLocalsRn doc_sig nubbed_tvs thing_inside }}
  where
    doc_sig = text "In a pattern type-signature"
616

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

625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
bindSigTyVarsFV :: [LSig Name]
		-> RnM (a, FreeVars)
	  	-> RnM (a, FreeVars)
-- Bind the top-level forall'd type variables in the sigs.
-- E.g 	f :: a -> a
--	f = rhs
--	The 'a' scopes over the rhs
--
-- NB: there'll usually be just one (for a function binding)
--     but if there are many, one may shadow the rest; too bad!
--	e.g  x :: [a] -> [a]
--	     y :: [(a,a)] -> a
--	     (x,y) = e
--      In e, 'a' will be in scope, and it'll be the one from 'y'!
bindSigTyVarsFV sigs thing_inside
  = do	{ scoped_tyvars <- doptM Opt_ScopedTypeVariables
	; if not scoped_tyvars then 
		thing_inside 
	  else
		bindLocalNamesFV tvs thing_inside }
  where
    tvs = [ hsLTyVarName ltv 
647
648
649
	  | L _ (Sig _ (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs, ltv <- ltvs ]
	-- Note the pattern-match on "Explicit"; we only bind
	-- type variables from signatures with an explicit top-level for-all
650
651
652
653
654
655
				

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

656
-------------------------------------
657
checkDupNames :: SDoc
658
	      -> [Located RdrName]
659
	      -> RnM ()
sof's avatar
sof committed
660
checkDupNames doc_str rdr_names_w_loc
sof's avatar
sof committed
661
  = 	-- Check for duplicated names in a binding group
662
    mappM_ (dupNamesErr doc_str) dups
sof's avatar
sof committed
663
  where
664
    (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc
665

666
-------------------------------------
667
checkShadowing doc_str loc_rdr_names
668
669
670
  = getLocalRdrEnv		`thenM` \ local_env ->
    getGlobalRdrEnv		`thenM` \ global_env ->
    let
671
      check_shadow (L loc rdr_name)
672
673
	|  rdr_name `elemLocalRdrEnv` local_env 
 	|| not (null (lookupGRE_RdrName rdr_name global_env ))
674
	= setSrcSpan loc $ addWarn (shadowedNameWarn doc_str rdr_name)
675
676
        | otherwise = returnM ()
    in
677
    mappM_ check_shadow loc_rdr_names
678
\end{code}
679

680
681
682

%************************************************************************
%*									*
683
\subsection{Free variable manipulation}
684
685
686
687
%*									*
%************************************************************************

\begin{code}
688
-- A useful utility
689
mapFvRn f xs = mappM f xs	`thenM` \ stuff ->
690
691
692
	       let
		  (ys, fvs_s) = unzip stuff
	       in
693
	       returnM (ys, plusFVs fvs_s)
694
695
696
697
698
699
700
701
702
703
\end{code}


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

\begin{code}
704
warnUnusedModules :: [(Module,SrcSpan)] -> RnM ()
705
warnUnusedModules mods
706
  = ifOptM Opt_WarnUnusedImports (mappM_ bleat mods)
707
  where
708
    bleat (mod,loc) = setSrcSpan loc $ addWarn (mk_warn mod)
709
710
    mk_warn m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+> 
			 text "is imported, but nothing from it is used",
711
			 parens (ptext SLIT("except perhaps instances visible in") <+>
712
				   quotes (ppr m))]
713

714
warnUnusedImports, warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
715
716
warnUnusedImports gres  = ifOptM Opt_WarnUnusedImports (warnUnusedGREs gres)
warnUnusedTopBinds gres = ifOptM Opt_WarnUnusedBinds   (warnUnusedGREs gres)
717

718
warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM ()
719
720
warnUnusedLocalBinds names = ifOptM Opt_WarnUnusedBinds   (warnUnusedLocals names)
warnUnusedMatches    names = ifOptM Opt_WarnUnusedMatches (warnUnusedLocals names)
721

722
-------------------------
723
--	Helpers
724
725
warnUnusedGREs gres 
 = warnUnusedBinds [(n,Just p) | GRE {gre_name = n, gre_prov = p} <- gres]
726

727
728
warnUnusedLocals names
 = warnUnusedBinds [(n,Nothing) | n<-names]
729

730
731
732
warnUnusedBinds :: [(Name,Maybe Provenance)] -> RnM ()
warnUnusedBinds names  = mappM_ warnUnusedName (filter reportable names)
 where reportable (name,_) = reportIfUnused (nameOccName name)
733

734
735
-------------------------

736
737
warnUnusedName :: (Name, Maybe Provenance) -> RnM ()
warnUnusedName (name, prov)
738
739
740
  = addWarnAt loc $
    sep [msg <> colon, 
	 nest 2 $ occNameFlavour (nameOccName name) <+> quotes (ppr name)]
741
	-- TODO should be a proper span
742
  where
743
744
745
746
747
748
749
    (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 )
750
751
752

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

755
\begin{code}
756
addNameClashErrRn rdr_name (np1:nps)
757
  = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
758
		  ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
759
  where
760
761
    msg1 = ptext  SLIT("either") <+> mk_ref np1
    msgs = [ptext SLIT("    or") <+> mk_ref np | np <- nps]
762
    mk_ref gre = quotes (ppr (gre_name gre)) <> comma <+> pprNameProvenance gre
763

764
shadowedNameWarn doc shadow
sof's avatar
sof committed
765
  = hsep [ptext SLIT("This binding for"), 
766
	       quotes (ppr shadow),
sof's avatar
sof committed
767
	       ptext SLIT("shadows an existing binding")]
768
    $$ doc
769

770
unknownNameErr rdr_name
771
  = sep [ptext SLIT("Not in scope:"), 
772
	 nest 2 $ occNameFlavour (rdrNameOcc rdr_name) <+> quotes (ppr rdr_name)]
773

774
775
776
unknownInstBndrErr cls op
  = quotes (ppr op) <+> ptext SLIT("is not a (visible) method of class") <+> quotes (ppr cls)

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

781
782
783
784
785
786
787
788
789
790
791
792
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 
793
794
	      | otherwise = ptext SLIT("Bound at:") <+> 
			    vcat (map ppr (sortLe (<=) locs))
795
\end{code}