summaryrefslogtreecommitdiff
path: root/compiler/rename/RnEnv.lhs
blob: 9a61ecc98ab96431401cfe8cf617fb13b827a1b4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
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
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
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
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-2006
%
\section[RnEnv]{Environment manipulation for the renamer monad}

\begin{code}
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
--     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
-- for details

module RnEnv ( 
	newTopSrcBinder, lookupFamInstDeclBndr,
	lookupLocatedBndrRn, lookupBndrRn, 
	lookupLocatedTopBndrRn, lookupTopBndrRn,
	lookupLocatedOccRn, lookupOccRn, 
	lookupLocatedGlobalOccRn, lookupGlobalOccRn,
	lookupLocalDataTcNames, lookupSrcOcc_maybe,
	lookupFixityRn, lookupTyFixityRn, lookupLocatedSigOccRn, 
	lookupInstDeclBndr, lookupRecordBndr, lookupConstructorFields,
	lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
	lookupGreRn, lookupGreRn_maybe,
	getLookupOccRn,

	newLocalsRn, newIPNameRn,
	bindLocalNames, bindLocalNamesFV,
	bindLocatedLocalsFV, bindLocatedLocalsRn,
	bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
	bindTyVarsRn, extendTyVarEnvFVRn,
	bindLocalFixities,

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

#include "HsVersions.h"

import LoadIface	( loadInterfaceForName, loadSrcInterface )
import IfaceEnv		( lookupOrig, newGlobalBinder, newIPName )
import HsSyn		( FixitySig(..), HsExpr(..), SyntaxExpr, SyntaxTable,
			  LHsTyVarBndr, LHsType, 
			  Fixity, hsLTyVarLocNames, replaceTyVarName )
import RdrHsSyn		( extractHsTyRdrTyVars )
import RdrName		( RdrName, isQual, isUnqual, isOrig_maybe,
			  isQual_maybe,
			  mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
			  pprGlobalRdrEnv, lookupGRE_RdrName, 
			  isExact_maybe, isSrcRdrName,
			  Parent(..),
			  GlobalRdrElt(..), GlobalRdrEnv, lookupGlobalRdrEnv, 
			  isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
			  Provenance(..), pprNameProvenance,
			  importSpecLoc, importSpecModule
			)
import HscTypes		( availNames, ModIface(..), FixItem(..), lookupFixity )
import TcEnv		( tcLookupDataCon )
import TcRnMonad
import Name		( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName,
			  nameSrcLoc, nameOccName, nameModule, isExternalName )
import NameSet
import NameEnv
import DataCon		( dataConFieldLabels )
import OccName		( tcName, isDataOcc, pprNonVarNameSpace, occNameSpace,
			  reportIfUnused )
import Module		( Module, ModuleName )
import PrelNames	( mkUnboundName, rOOT_MAIN, iNTERACTIVE, consDataConKey, hasKey )
import UniqSupply
import BasicTypes	( IPName, mapIPName )
import SrcLoc		( SrcSpan, srcSpanStart, Located(..), eqLocated, unLoc,
			  srcLocSpan, getLoc, combineSrcSpans, isOneLineSpan )
import Outputable
import Util		( sortLe )
import Maybes
import ListSetOps	( removeDups )
import List		( nubBy )
import Monad		( when )
import DynFlags
\end{code}

%*********************************************************
%*							*
		Source-code binders
%*							*
%*********************************************************

\begin{code}
newTopSrcBinder :: Module -> Located RdrName -> RnM Name
newTopSrcBinder this_mod (L loc rdr_name)
  | Just name <- isExact_maybe rdr_name
  =	-- 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
    ASSERT2( isExternalName name,  ppr name )
    do	{ checkM (this_mod == nameModule name)
	         (addErrAt loc (badOrigBinding rdr_name))
	; return name }


  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
  = do	{ checkM (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
	         (addErrAt loc (badOrigBinding rdr_name))
	-- When reading External Core we get Orig names as binders, 
	-- but they should agree with the module gotten from the monad
	--
	-- 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.
	--
	-- 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,
	-- (apart from module-initialisation issues, perhaps).
	; newGlobalBinder rdr_mod rdr_occ loc }
		--TODO, should pass the whole span

  | otherwise
  = do	{ checkM (not (isQual rdr_name))
	         (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
	; newGlobalBinder this_mod (rdrNameOcc rdr_name) loc }
\end{code}

%*********************************************************
%*							*
	Source code occurrences
%*							*
%*********************************************************

Looking up a name in the RnEnv.

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

lookupBndrRn :: RdrName -> RnM Name
-- NOTE: assumes that the SrcSpan of the binder has already been setSrcSpan'd
lookupBndrRn rdr_name
  = getLocalRdrEnv		`thenM` \ local_env ->
    case lookupLocalRdrEnv local_env rdr_name of 
	  Just name -> returnM name
	  Nothing   -> lookupTopBndrRn rdr_name

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

lookupTopBndrRn :: RdrName -> RnM Name
-- Look up a top-level source-code binder.   We may be looking up an unqualified 'f',
-- and there may be several imported 'f's too, which must not confuse us.
-- 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
-- So we have to filter out the non-local ones.
--
-- A separate function (importsFromLocalDecls) reports duplicate top level
-- decls, so here it's safe just to choose an arbitrary one.
--
-- 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.

lookupTopBndrRn rdr_name
  | Just name <- isExact_maybe rdr_name
  = returnM name

  | Just (rdr_mod, rdr_occ) <- isOrig_maybe 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
  = do	{ loc <- getSrcSpanM
	; newGlobalBinder rdr_mod rdr_occ loc }

  | otherwise
  = do	{ mb_gre <- lookupGreLocalRn rdr_name
	; case mb_gre of
		Nothing  -> do
			      traceRn $ text "lookupTopBndrRn"
			      unboundName rdr_name
		Just gre -> returnM (gre_name gre) }
	      
-- lookupLocatedSigOccRn 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".
lookupLocatedSigOccRn :: Located RdrName -> RnM (Located Name)
lookupLocatedSigOccRn = wrapLocM $ \ rdr_name -> do
	{ local_env <- getLocalRdrEnv
	; case lookupLocalRdrEnv local_env rdr_name of {
		Just n  -> return n ;
		Nothing -> do
	{ mb_gre <- lookupGreLocalRn rdr_name
	; case mb_gre of 
		Just gre -> return (gre_name gre) 
		Nothing  -> lookupGlobalOccRn rdr_name
	}}}

-----------------------------------------------
lookupInstDeclBndr :: Name -> Located RdrName -> RnM (Located Name)
-- 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.
--
-- 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
lookupInstDeclBndr cls rdr = lookup_located_sub_bndr is_op doc rdr
  where
    doc = ptext SLIT("method of class") <+> quotes (ppr cls)
    is_op gre@(GRE {gre_par = ParentIs n}) = n == cls
    is_op other			           = False

-----------------------------------------------
lookupRecordBndr :: Maybe (Located Name) -> Located RdrName -> RnM (Located Name)
-- Used for record construction and pattern matching
-- When the -fdisambiguate-record-fields flag is on, take account of the
-- constructor name to disambiguate which field to use; it's just the
-- same as for instance decls
lookupRecordBndr Nothing rdr_name
  = lookupLocatedGlobalOccRn rdr_name
lookupRecordBndr (Just (L _ data_con)) rdr_name
  = do 	{ flag_on <- doptM Opt_DisambiguateRecordFields
	; if not flag_on 
          then lookupLocatedGlobalOccRn rdr_name
	  else do {
	  fields <- lookupConstructorFields data_con
	; let is_field gre = gre_name gre `elem` fields
	; lookup_located_sub_bndr is_field doc rdr_name
	}}
   where
     doc = ptext SLIT("field of constructor") <+> quotes (ppr data_con)


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
	  do { field_env <- getRecFieldEnv
	     ; return (lookupNameEnv field_env con_name `orElse` []) }
	  else
	  do { con <- tcLookupDataCon con_name
	     ; return (dataConFieldLabels con) } }

-----------------------------------------------
lookup_located_sub_bndr :: (GlobalRdrElt -> Bool)
			-> SDoc -> Located RdrName
			-> RnM (Located Name)
lookup_located_sub_bndr is_good doc rdr_name
  = wrapLocM (lookup_sub_bndr is_good doc) rdr_name

lookup_sub_bndr is_good doc rdr_name
  | isUnqual rdr_name	-- Find all the things the rdr-name maps to
  = do	{		-- and pick the one with the right parent name
	; env <- getGlobalRdrEnv
	; case filter is_good (lookupGlobalRdrEnv env (rdrNameOcc rdr_name)) of
		-- NB: lookupGlobalRdrEnv, not lookupGRE_RdrName!
		--     The latter does pickGREs, but we want to allow 'x'
		--     even if only 'M.x' is in scope
	    [gre] -> return (gre_name gre)
	    []    -> do { addErr (unknownSubordinateErr doc rdr_name)
			; traceRn (text "RnEnv.lookup_sub_bndr" <+> ppr rdr_name)
			; return (mkUnboundName rdr_name) }
	    gres  -> do { addNameClashErrRn rdr_name gres
			; return (gre_name (head gres)) }
	}

  | otherwise	-- Occurs in derived instances, where we just
		-- refer directly to the right method
  = ASSERT2( not (isQual rdr_name), ppr rdr_name )
	  -- NB: qualified names are rejected by the parser
    lookupImportedName rdr_name

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

-- Looking up family names in type instances is a subtle affair.  The family
-- may be imported, in which case we need to lookup the occurence of a global
-- name.  Alternatively, the family may be in the same binding group (and in
-- fact in a declaration processed later), and we need to create a new top
-- source binder.
--
-- So, also this is strictly speaking an occurence, we cannot raise an error
-- message yet for instances without a family declaration.  This will happen
-- during renaming the type instance declaration in RnSource.rnTyClDecl.
--
lookupFamInstDeclBndr :: Module -> Located RdrName -> RnM Name
lookupFamInstDeclBndr mod lrdr_name@(L _ rdr_name)
  = do { mb_gre <- lookupGreRn_maybe rdr_name
       ; case mb_gre of
           Just gre -> returnM (gre_name gre) ;
	   Nothing  -> newTopSrcBinder mod lrdr_name }

--------------------------------------------------
--		Occurrences
--------------------------------------------------

getLookupOccRn :: RnM (Name -> Maybe Name)
getLookupOccRn
  = getLocalRdrEnv			`thenM` \ local_env ->
    return (lookupLocalRdrEnv local_env . mkRdrUnqual . nameOccName)

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

-- lookupOccRn looks up an occurrence of a RdrName
lookupOccRn :: RdrName -> RnM Name
lookupOccRn rdr_name
  = getLocalRdrEnv			`thenM` \ local_env ->
    case lookupLocalRdrEnv local_env rdr_name of
	  Just name -> returnM name
	  Nothing   -> lookupGlobalOccRn rdr_name

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

lookupGlobalOccRn :: RdrName -> RnM Name
-- 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

lookupGlobalOccRn rdr_name
  | not (isSrcRdrName rdr_name)
  = lookupImportedName rdr_name	

  | otherwise
  =	-- First look up the name in the normal environment.
   lookupGreRn_maybe 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	do
        traceRn $ text "lookupGlobalOccRn"
	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

	-- Always Orig, even when reading a .hi-boot file
  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
  = lookupOrig rdr_mod rdr_occ

  | otherwise
  = pprPanic "RnEnv.lookupImportedName" (ppr 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_maybe rdr_name
	; case mb_gre of
		Nothing  -> returnM Nothing
		Just gre -> returnM (Just (gre_name gre)) }
	
-------------------------
lookupGreRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
-- Just look up the RdrName in the GlobalRdrEnv
lookupGreRn_maybe rdr_name 
  = lookupGreRn_help rdr_name (lookupGRE_RdrName rdr_name)

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
	{ traceRn $ text "lookupGreRn"
	; name <- unboundName rdr_name
	; return (GRE { gre_name = name, gre_par = NoParent,
		        gre_prov = LocalDef }) }}}

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)

lookupGreRn_help :: RdrName			-- Only used in error message
		 -> (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
	    [gre] -> returnM (Just gre)
	    gres  -> do { addNameClashErrRn rdr_name gres
			; returnM (Just (head gres)) } }

------------------------------
--	GHCi support
------------------------------

-- A qualified name on the command line can refer to any module at all: we
-- try to load the interface if we don't already have it.
lookupQualifiedName :: RdrName -> RnM Name
lookupQualifiedName rdr_name
  | Just (mod,occ) <- isQual_maybe rdr_name
   -- Note: we want to behave as we would for a source file import here,
   -- and respect hiddenness of modules/packages, hence loadSrcInterface.
   = 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

  | otherwise
  = pprPanic "RnEnv.lookupQualifiedName" (ppr rdr_name)
  where
    doc = ptext SLIT("Need to find") <+> ppr rdr_name
\end{code}

%*********************************************************
%*							*
		Fixities
%*							*
%*********************************************************

\begin{code}
lookupLocalDataTcNames :: RdrName -> RnM [Name]
-- GHC extension: look up both the tycon and data con 
-- for con-like things
-- Complain if neither is in scope
lookupLocalDataTcNames 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)
	; case [gre_name gre | Just gre <- mb_gres] of
	    [] -> do { addErr (unknownNameErr rdr_name)
		     ; return [] }
	    names -> return names
    }

--------------------------------
bindLocalFixities :: [FixitySig RdrName] -> RnM a -> RnM a
-- 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
  | otherwise  = mappM rn_sig fixes	`thenM` \ new_bit ->
		 extendFixityEnv new_bit thing_inside
  where
    rn_sig (FixitySig lv@(L loc v) fix)
	= addLocM lookupBndrRn lv	`thenM` \ new_v ->
	  returnM (new_v, (FixItem (rdrNameOcc v) fix loc))
\end{code}

--------------------------------
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}
lookupFixityRn :: Name -> RnM Fixity
lookupFixityRn name
  = getModule				`thenM` \ this_mod ->
    if nameIsLocalOrFrom this_mod name
    then	-- It's defined in this module
	getFixityEnv		`thenM` \ local_fix_env ->
	traceRn (text "lookupFixityRn" <+> (ppr name $$ ppr local_fix_env)) `thenM_`
	returnM (lookupFixity local_fix_env name)

    else	-- It's imported
      -- For imported names, we have to get their fixities by doing a
      -- loadInterfaceForName, 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.
      --
      -- loadInterfaceForName will find B.hi even if B is a hidden module,
      -- and that's what we want.
        loadInterfaceForName doc name	`thenM` \ iface ->
	returnM (mi_fix_fn iface (nameOccName name))
  where
    doc = ptext SLIT("Checking fixity for") <+> ppr name

---------------
lookupTyFixityRn :: Located Name -> RnM Fixity
lookupTyFixityRn (L loc n) = lookupFixityRn n

---------------
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_tc, rdr_name]
  | 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}

%************************************************************************
%*									*
			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

%*									*
%************************************************************************

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)
  * "do" notation

We store the relevant Name in the HsSyn tree, in 
  * HsIntegral/HsFractional/HsIsString
  * NegApp
  * NPlusKPat
  * HsDo
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.

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.

\begin{code}
lookupSyntaxName :: Name 				-- The standard name
	         -> RnM (SyntaxExpr Name, FreeVars)	-- Possibly a non-standard name
lookupSyntaxName std_name
  = doptM Opt_ImplicitPrelude		`thenM` \ implicit_prelude -> 
    if implicit_prelude then normal_case
    else
	-- Get the similarly named thing from the local environment
    lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
    returnM (HsVar usr_name, unitFV usr_name)
  where
    normal_case = returnM (HsVar std_name, emptyFVs)

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

    returnM (std_names `zip` map HsVar usr_names, mkFVs usr_names)
  where
    normal_case = returnM (std_names `zip` map HsVar std_names, emptyFVs)
\end{code}


%*********************************************************
%*							*
\subsection{Binding}
%*							*
%*********************************************************

\begin{code}
newLocalsRn :: [Located RdrName] -> RnM [Name]
newLocalsRn rdr_names_w_loc
  = newUniqueSupply 		`thenM` \ us ->
    returnM (zipWith mk rdr_names_w_loc (uniqsFromSupply us))
  where
    mk (L loc rdr_name) uniq
	| 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
		      mkInternalName uniq (rdrNameOcc rdr_name) loc

bindLocatedLocalsRn :: SDoc	-- Documentation string for error message
	   	    -> [Located RdrName]
	    	    -> ([Name] -> RnM a)
	    	    -> RnM a
bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
  = 	-- Check for duplicate names
    checkDupNames doc_str rdr_names_w_loc	`thenM_`

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

	-- Make fresh Names and extend the environment
    newLocalsRn rdr_names_w_loc		`thenM` \ names ->
    getLocalRdrEnv			`thenM` \ local_env ->
    setLocalRdrEnv (extendLocalRdrEnv local_env names)
		   (enclosed_scope names)


bindLocalNames :: [Name] -> RnM a -> RnM a
bindLocalNames names enclosed_scope
  = getLocalRdrEnv 		`thenM` \ name_env ->
    setLocalRdrEnv (extendLocalRdrEnv name_env names)
		    enclosed_scope

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


-------------------------------------
	-- binLocalsFVRn is the same as bindLocalsRn
	-- except that it deals with free vars
bindLocatedLocalsFV :: SDoc -> [Located RdrName] -> ([Name] -> RnM (a,FreeVars))
  -> RnM (a, FreeVars)
bindLocatedLocalsFV doc rdr_names enclosed_scope
  = bindLocatedLocalsRn doc rdr_names	$ \ names ->
    enclosed_scope names		`thenM` \ (thing, fvs) ->
    returnM (thing, delListFromNameSet fvs names)

-------------------------------------
bindTyVarsRn :: SDoc -> [LHsTyVarBndr RdrName]
	      -> ([LHsTyVarBndr Name] -> RnM a)
	      -> RnM a
-- Haskell-98 binding of type variables; e.g. within a data type decl
bindTyVarsRn doc_str tyvar_names enclosed_scope
  = let
	located_tyvars = hsLTyVarLocNames tyvar_names
    in
    bindLocatedLocalsRn doc_str located_tyvars	$ \ names ->
    enclosed_scope (zipWith replace tyvar_names names)
    where 
	replace (L loc n1) n2 = L loc (replaceTyVarName n1 n2)

bindPatSigTyVars :: [LHsType RdrName] -> ([Name] -> RnM a) -> RnM a
  -- Find the type variables in the pattern type 
  -- signatures that must be brought into scope
bindPatSigTyVars tys thing_inside
  = 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
		-- The 'nub' is important.  For example:
		--	f (x :: t) (y :: t) = ....
		-- We don't want to complain about binding t twice!

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

bindPatSigTyVarsFV :: [LHsType RdrName]
		   -> RnM (a, FreeVars)
	  	   -> RnM (a, FreeVars)
bindPatSigTyVarsFV tys thing_inside
  = bindPatSigTyVars tys	$ \ tvs ->
    thing_inside		`thenM` \ (result,fvs) ->
    returnM (result, fvs `delListFromNameSet` tvs)

bindSigTyVarsFV :: [Name]
		-> RnM (a, FreeVars)
	  	-> RnM (a, FreeVars)
bindSigTyVarsFV tvs thing_inside
  = do	{ scoped_tyvars <- doptM Opt_ScopedTypeVariables
	; 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

-------------------------------------
checkDupNames :: SDoc
	      -> [Located RdrName]
	      -> RnM ()
checkDupNames doc_str rdr_names_w_loc
  = 	-- Check for duplicated names in a binding group
    mappM_ (dupNamesErr doc_str) dups
  where
    (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc

-------------------------------------
checkShadowing doc_str loc_rdr_names
  = getLocalRdrEnv		`thenM` \ local_env ->
    getGlobalRdrEnv		`thenM` \ global_env ->
    let
      check_shadow (L loc rdr_name)
	|  rdr_name `elemLocalRdrEnv` local_env 
 	|| not (null (lookupGRE_RdrName rdr_name global_env ))
	= addWarnAt loc (shadowedNameWarn doc_str rdr_name)
        | otherwise = returnM ()
    in
    mappM_ check_shadow loc_rdr_names
\end{code}


%************************************************************************
%*									*
\subsection{Free variable manipulation}
%*									*
%************************************************************************

\begin{code}
-- A useful utility
mapFvRn f xs = mappM f xs	`thenM` \ stuff ->
	       let
		  (ys, fvs_s) = unzip stuff
	       in
	       returnM (ys, plusFVs fvs_s)
\end{code}


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

\begin{code}
warnUnusedModules :: [(ModuleName,SrcSpan)] -> RnM ()
warnUnusedModules mods
  = ifOptM Opt_WarnUnusedImports (mappM_ bleat mods)
  where
    bleat (mod,loc) = addWarnAt loc (mk_warn mod)
    mk_warn m = vcat [ptext SLIT("Module") <+> quotes (ppr m)
			<+> text "is imported, but nothing from it is used,",
		      nest 2 (ptext SLIT("except perhaps instances visible in") 
			<+> quotes (ppr m)),
		      ptext SLIT("To suppress this warning, use:") 
			<+> ptext SLIT("import") <+> ppr m <> parens empty ]


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

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

-------------------------
--	Helpers
warnUnusedGREs gres 
 = warnUnusedBinds [(n,p) | GRE {gre_name = n, gre_prov = p} <- gres]

warnUnusedLocals names
 = warnUnusedBinds [(n,LocalDef) | n<-names]

warnUnusedBinds :: [(Name,Provenance)] -> RnM ()
warnUnusedBinds names  = mappM_ warnUnusedName (filter reportable names)
 where reportable (name,_) 
	| isWiredInName name = False	-- Don't report unused wired-in names
					-- Otherwise we get a zillion warnings
					-- from Data.Tuple
	| otherwise = reportIfUnused (nameOccName name)

-------------------------

warnUnusedName :: (Name, Provenance) -> RnM ()
warnUnusedName (name, LocalDef)
  = addUnusedWarning name (srcLocSpan (nameSrcLoc name)) 
		     (ptext SLIT("Defined but not used"))

warnUnusedName (name, Imported is)
  = mapM_ warn is
  where
    warn spec = addUnusedWarning name span msg
	where
	   span = importSpecLoc spec
	   pp_mod = quotes (ppr (importSpecModule spec))
	   msg = ptext SLIT("Imported from") <+> pp_mod <+> ptext SLIT("but not used")

addUnusedWarning name span msg
  = addWarnAt span $
    sep [msg <> colon, 
	 nest 2 $ pprNonVarNameSpace (occNameSpace (nameOccName name))
			<+> quotes (ppr name)]
\end{code}

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

shadowedNameWarn doc shadow
  = hsep [ptext SLIT("This binding for"), 
	       quotes (ppr shadow),
	       ptext SLIT("shadows an existing binding")]
    $$ doc

unknownNameErr rdr_name
  = sep [ptext SLIT("Not in scope:"), 
	 nest 2 $ pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
		  <+> quotes (ppr rdr_name)]

unknownSubordinateErr doc op	-- Doc is "method of class" or 
				-- "field of constructor"
  = quotes (ppr op) <+> ptext SLIT("is not a (visible)") <+> doc

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

dupNamesErr :: SDoc -> [Located RdrName] -> RnM ()
dupNamesErr descriptor located_names
  = addErrAt big_loc $
    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  = isOneLineSpan big_loc
    locations | one_line  = empty 
	      | otherwise = ptext SLIT("Bound at:") <+> 
			    vcat (map ppr (sortLe (<=) locs))

badQualBndrErr rdr_name
  = ptext SLIT("Qualified name in binding position:") <+> ppr rdr_name
\end{code}