[project @ 2002-09-13 15:02:25 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / RnEnv.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[RnEnv]{Environment manipulation for the renamer monad}
5
6 \begin{code}
7 module RnEnv where              -- Export everything
8
9 #include "HsVersions.h"
10
11 import {-# SOURCE #-} RnHiFiles( loadInterface )
12
13 import FlattenInfo      ( namesNeededForFlattening )
14 import HsSyn
15 import RnHsSyn          ( RenamedFixitySig )
16 import RdrHsSyn         ( RdrNameHsType, extractHsTyRdrTyVars )
17 import RdrName          ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
18                           mkRdrUnqual, mkRdrQual, setRdrNameSpace, rdrNameOcc,
19                           lookupRdrEnv, rdrEnvToList, elemRdrEnv, 
20                           extendRdrEnv, addListToRdrEnv, emptyRdrEnv,
21                           isExact_maybe, unqualifyRdrName
22                         )
23 import HsTypes          ( hsTyVarName, replaceTyVarName )
24 import HscTypes         ( Provenance(..), pprNameProvenance, hasBetterProv,
25                           ImportReason(..), GlobalRdrEnv, GlobalRdrElt(..), 
26                           GenAvailInfo(..), AvailInfo, Avails, 
27                           ModIface(..), NameCache(..),
28                           Deprecations(..), lookupDeprec, isLocalGRE,
29                           extendLocalRdrEnv, availName, availNames,
30                           lookupFixity
31                         )
32 import TcRnMonad
33 import Name             ( Name, getName, getSrcLoc, nameIsLocalOrFrom, isWiredInName,
34                           mkInternalName, mkExternalName, mkIPName, 
35                           nameOccName, setNameModuleAndLoc, nameModule  )
36 import NameSet
37 import OccName          ( OccName, tcName, isDataOcc, occNameUserString, occNameFlavour )
38 import Module           ( Module, ModuleName, moduleName, mkVanillaModule )
39 import PrelNames        ( mkUnboundName, intTyConName, qTyConName,
40                           boolTyConName, funTyConName,
41                           unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
42                           eqStringName, printName, 
43                           bindIOName, returnIOName, failIOName, thenIOName,
44                           templateHaskellNames
45                         )
46 import TysWiredIn       ( unitTyCon )   -- A little odd
47 import FiniteMap
48 import UniqSupply
49 import SrcLoc           ( SrcLoc, noSrcLoc )
50 import Outputable
51 import ListSetOps       ( removeDups, equivClasses )
52 import BasicTypes       ( mapIPName, FixitySig(..) )
53 import List             ( nub )
54 import CmdLineOpts
55 import FastString       ( FastString )
56 \end{code}
57
58 %*********************************************************
59 %*                                                      *
60 \subsection{Making new names}
61 %*                                                      *
62 %*********************************************************
63
64 \begin{code}
65 newTopBinder :: Module -> RdrName -> SrcLoc -> TcRn m Name
66         -- newTopBinder puts into the cache the binder with the
67         -- module information set correctly.  When the decl is later renamed,
68         -- the binding site will thereby get the correct module.
69         -- There maybe occurrences that don't have the correct Module, but
70         -- by the typechecker will propagate the binding definition to all 
71         -- the occurrences, so that doesn't matter
72
73 newTopBinder mod rdr_name loc
74   | Just name <- isExact_maybe rdr_name
75   = returnM name
76
77   | otherwise
78   =     -- First check the cache
79     getNameCache                `thenM` \ name_supply -> 
80     let 
81         occ = rdrNameOcc rdr_name
82         key = (moduleName mod, occ)
83         cache = nsNames name_supply
84     in
85     case lookupFM cache key of
86
87         -- A hit in the cache!  We are at the binding site of the name, and
88         -- this is the moment when we know all about 
89         --      a) the Name's host Module (in particular, which
90         --         package it comes from)
91         --      b) its defining SrcLoc
92         -- So we update this info
93
94         Just name 
95           | isWiredInName name -> returnM name
96                 -- Don't mess with wired-in names.  Apart from anything
97                 -- else, their wired-in-ness is in the SrcLoca
98           | otherwise 
99           -> let 
100                 new_name  = setNameModuleAndLoc name mod loc
101                 new_cache = addToFM cache key new_name
102              in
103              setNameCache (name_supply {nsNames = new_cache})   `thenM_`
104              returnM new_name
105                      
106         -- Miss in the cache!
107         -- Build a completely new Name, and put it in the cache
108         -- Even for locally-defined names we use implicitImportProvenance; 
109         -- updateProvenances will set it to rights
110         Nothing -> addNewName name_supply key mod occ loc
111
112 newGlobalName :: ModuleName -> OccName -> TcRn m Name
113   -- Used for *occurrences*.  We make a place-holder Name, really just
114   -- to agree on its unique, which gets overwritten when we read in
115   -- the binding occurence later (newTopBinder)
116   -- The place-holder Name doesn't have the right SrcLoc, and its
117   -- Module won't have the right Package either.
118   --
119   -- (We have to pass a ModuleName, not a Module, because we may be
120   -- simply looking at an occurrence M.x in an interface file.)
121   --
122   -- This means that a renamed program may have incorrect info
123   -- on implicitly-imported occurrences, but the correct info on the 
124   -- *binding* declaration. It's the type checker that propagates the 
125   -- correct information to all the occurrences.
126   -- Since implicitly-imported names never occur in error messages,
127   -- it doesn't matter that we get the correct info in place till later,
128   -- (but since it affects DLL-ery it does matter that we get it right
129   --  in the end).
130 newGlobalName mod_name occ
131   = getNameCache                `thenM` \ name_supply ->
132     let
133         key = (mod_name, occ)
134         cache = nsNames name_supply
135     in
136     case lookupFM cache key of
137         Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenM_`
138                      returnM name
139
140         Nothing   -> -- traceRn (text "newGlobalName: new" <+> ppr name)  `thenM_`
141                      addNewName name_supply key (mkVanillaModule mod_name) occ noSrcLoc
142
143 -- Look up a "system name" in the name cache.
144 -- This is done by the type checker... 
145 -- For *source* declarations, this will put the thing into the name cache
146 -- For *interface* declarations, RnHiFiles.getSysBinders will already have
147 -- put it into the cache.
148 lookupSysName :: Name                   -- Base name
149               -> (OccName -> OccName)   -- Occurrence name modifier
150               -> TcRn m Name            -- System name
151 lookupSysName base_name mk_sys_occ
152   = getNameCache                `thenM` \ name_supply ->
153     let
154         mod = nameModule base_name
155         occ = mk_sys_occ (nameOccName base_name)
156         key = (moduleName mod, occ)
157     in
158     case lookupFM (nsNames name_supply) key of
159         Just name -> returnM name
160         Nothing   -> addNewName name_supply key mod occ noSrcLoc
161
162 newIPName rdr_name_ip
163   = getNameCache                `thenM` \ name_supply ->
164     let
165         ipcache = nsIPs name_supply
166     in
167     case lookupFM ipcache key of
168         Just name_ip -> returnM name_ip
169         Nothing      -> setNameCache new_ns     `thenM_`
170                         returnM name_ip
171                   where
172                      (us', us1)  = splitUniqSupply (nsUniqs name_supply)
173                      uniq        = uniqFromSupply us1
174                      name_ip     = mapIPName mk_name rdr_name_ip
175                      mk_name rdr_name = mkIPName uniq (rdrNameOcc rdr_name)
176                      new_ipcache = addToFM ipcache key name_ip
177                      new_ns      = name_supply {nsUniqs = us', nsIPs = new_ipcache}
178     where 
179         key = rdr_name_ip       -- Ensures that ?x and %x get distinct Names
180
181 addNewName :: NameCache -> (ModuleName,OccName) 
182            -> Module -> OccName -> SrcLoc -> TcRn m Name
183 -- Internal function: extend the name cache, dump it back into
184 --                    the monad, and return the new name
185 -- (internal, hence the rather redundant interface)
186 addNewName name_supply key mod occ loc
187   = setNameCache new_name_supply        `thenM_`
188     returnM name
189   where
190      (us', us1) = splitUniqSupply (nsUniqs name_supply)
191      uniq       = uniqFromSupply us1
192      name       = mkExternalName uniq mod occ loc
193      new_cache  = addToFM (nsNames name_supply) key name
194      new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
195 \end{code}
196
197 %*********************************************************
198 %*                                                      *
199 \subsection{Looking up names}
200 %*                                                      *
201 %*********************************************************
202
203 Looking up a name in the RnEnv.
204
205 \begin{code}
206 lookupBndrRn rdr_name
207   = getLocalRdrEnv              `thenM` \ local_env ->
208     case lookupRdrEnv local_env rdr_name of 
209           Just name -> returnM name
210           Nothing   -> lookupTopBndrRn rdr_name
211
212 lookupTopBndrRn rdr_name
213 -- Look up a top-level local binder.   We may be looking up an unqualified 'f',
214 -- and there may be several imported 'f's too, which must not confuse us.
215 -- So we have to filter out the non-local ones.
216 -- A separate function (importsFromLocalDecls) reports duplicate top level
217 -- decls, so here it's safe just to choose an arbitrary one.
218
219         -- There should never be a qualified name in a binding position 
220         -- The parser could check this, but doesn't (yet)
221   | isQual rdr_name
222   = getSrcLocM                                                  `thenM` \ loc ->
223     qualNameErr (text "In its declaration") (rdr_name,loc)      `thenM_`
224     returnM (mkUnboundName rdr_name)
225
226   | otherwise
227   = ASSERT( not (isOrig rdr_name) )
228         -- Original names are used only for occurrences, 
229         -- not binding sites
230
231     getModeRn                   `thenM` \ mode ->
232     case mode of
233         InterfaceMode mod -> 
234             getSrcLocM          `thenM` \ loc ->
235             newTopBinder mod rdr_name loc
236
237         other -> lookupTopSrcBndr rdr_name
238
239 lookupTopSrcBndr :: RdrName -> TcRn m Name
240 lookupTopSrcBndr rdr_name
241   = lookupTopSrcBndr_maybe rdr_name     `thenM` \ maybe_name ->
242     case maybe_name of
243         Just name -> returnM name
244         Nothing   -> unboundName rdr_name
245                                 
246
247 lookupTopSrcBndr_maybe :: RdrName -> TcRn m (Maybe Name)
248 -- Look up a source-code binder 
249
250 -- Ignores imported names; for example, this is OK:
251 --      import Foo( f )
252 --      infix 9 f       -- The 'f' here does not need to be qualified
253 --      f x = x         -- Nor here, of course
254
255 lookupTopSrcBndr_maybe rdr_name
256   | Just name <- isExact_maybe rdr_name
257         -- This is here just to catch the PrelBase defn of (say) [] and similar
258         -- The parser reads the special syntax and returns an Exact RdrName
259         -- But the global_env contains only Qual RdrNames, so we won't
260         -- find it there; instead just get the name via the Orig route
261         --
262         -- We are at a binding site for the name, so check first that it 
263         -- the current module is the correct one; otherwise GHC can get
264         -- very confused indeed.  This test rejects code like
265         --      data T = (,) Int Int
266         -- unless we are in GHC.Tup
267   = getModule                           `thenM` \ mod -> 
268     checkErr (moduleName mod == moduleName (nameModule name))
269              (badOrigBinding rdr_name)  `thenM_`
270     returnM (Just name)
271
272   | otherwise
273   = getGlobalRdrEnv                     `thenM` \ global_env ->
274     case lookupRdrEnv global_env rdr_name of
275           Nothing   -> returnM Nothing
276           Just gres -> case [gre_name gre | gre <- gres, isLocalGRE gre] of
277                          []     -> returnM Nothing
278                          (n:ns) -> returnM (Just n)
279               
280
281 -- lookupSigOccRn is used for type signatures and pragmas
282 -- Is this valid?
283 --   module A
284 --      import M( f )
285 --      f :: Int -> Int
286 --      f x = x
287 -- It's clear that the 'f' in the signature must refer to A.f
288 -- The Haskell98 report does not stipulate this, but it will!
289 -- So we must treat the 'f' in the signature in the same way
290 -- as the binding occurrence of 'f', using lookupBndrRn
291 lookupSigOccRn :: RdrName -> RnM Name
292 lookupSigOccRn = lookupBndrRn
293
294 -- lookupInstDeclBndr is used for the binders in an 
295 -- instance declaration.   Here we use the class name to
296 -- disambiguate.  
297
298 lookupInstDeclBndr :: Name -> RdrName -> RnM Name
299         -- We use the selector name as the binder
300 lookupInstDeclBndr cls_name rdr_name
301   | isUnqual rdr_name
302   =     -- Find all the things the class op name maps to
303         -- and pick the one with the right parent name
304     getGblEnv                           `thenM` \ gbl_env ->
305     let
306         avail_env = imp_env (tcg_imports gbl_env)
307     in
308     case lookupAvailEnv avail_env cls_name of
309         Nothing -> 
310             -- If the class itself isn't in scope, then cls_name will
311             -- be unboundName, and there'll already be an error for
312             -- that in the error list.  Example:
313             -- e.g.   import Prelude hiding( Ord )
314             --      instance Ord T where ...
315             -- The program is wrong, but that should not cause a crash.
316                 returnM (mkUnboundName rdr_name)
317
318         Just (AvailTC _ ns) -> case [n | n <- ns, nameOccName n == occ] of
319                                 (n:ns)-> ASSERT( null ns ) returnM n
320                                 []    -> unboundName rdr_name
321
322         other               -> pprPanic "lookupInstDeclBndr" (ppr cls_name)
323
324   | isQual rdr_name     -- Should never have a qualified name in a binding position
325   = getSrcLocM                                                  `thenM` \ loc ->
326     qualNameErr (text "In an instance method") (rdr_name,loc)   `thenM_`
327     returnM (mkUnboundName rdr_name)
328         
329   | otherwise           -- Occurs in derived instances, where we just
330                         -- refer directly to the right method, and avail_env
331                         -- isn't available
332   = ASSERT2( not (isQual rdr_name), ppr rdr_name )
333     lookupOrigName rdr_name
334
335   where
336     occ = rdrNameOcc rdr_name
337
338 lookupSysBndr :: RdrName -> RnM Name
339 -- Used for the 'system binders' in a data type or class declaration
340 -- Do *not* look up in the RdrEnv; these system binders are never in scope
341 -- Instead, get the module from the monad... but remember that
342 -- where the module is depends on whether we are renaming source or 
343 -- interface file stuff
344 lookupSysBndr rdr_name
345   = getSrcLocM          `thenM` \ loc ->
346     getModeRn           `thenM` \ mode ->
347     case mode of
348         InterfaceMode mod -> newTopBinder mod rdr_name loc
349         other             -> getModule  `thenM` \ mod ->
350                              newTopBinder mod rdr_name loc
351
352 -- lookupOccRn looks up an occurrence of a RdrName
353 lookupOccRn :: RdrName -> RnM Name
354 lookupOccRn rdr_name
355   = getLocalRdrEnv                      `thenM` \ local_env ->
356     case lookupRdrEnv local_env rdr_name of
357           Just name -> returnM name
358           Nothing   -> lookupGlobalOccRn rdr_name
359
360 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global 
361 -- environment.  It's used only for
362 --      record field names
363 --      class op names in class and instance decls
364
365 lookupGlobalOccRn rdr_name
366   = getModeRn           `thenM` \ mode ->
367     case mode of
368         InterfaceMode mod -> lookupIfaceName mod rdr_name 
369         SourceMode        -> lookupSrcName       rdr_name 
370
371         CmdLineMode 
372          | not (isQual rdr_name) -> 
373                 lookupSrcName rdr_name
374
375                 -- We allow qualified names on the command line to refer to 
376                 -- *any* name exported by any module in scope, just as if 
377                 -- there was an "import qualified M" declaration for every 
378                 -- module.
379                 --
380                 -- First look up the name in the normal environment.  If
381                 -- it isn't there, we manufacture a new occurrence of an
382                 -- original name.
383          | otherwise -> 
384                 lookupSrcName_maybe rdr_name    `thenM` \ mb_name ->
385                 case mb_name of
386                   Just name -> returnM name
387                   Nothing   -> lookupQualifiedName rdr_name
388
389 -- A qualified name on the command line can refer to any module at all: we
390 -- try to load the interface if we don't already have it.
391 lookupQualifiedName :: RdrName -> TcRn m Name
392 lookupQualifiedName rdr_name
393  = let 
394        mod = rdrNameModule rdr_name
395        occ = rdrNameOcc rdr_name
396    in
397    loadInterface (ppr rdr_name) mod (ImportByUser False) `thenM` \ iface ->
398    case  [ name | (_,avails) <- mi_exports iface,
399            avail             <- avails,
400            name              <- availNames avail,
401            nameOccName name == occ ] of
402       (n:ns) -> ASSERT (null ns) returnM n
403       _      -> unboundName rdr_name
404
405 lookupSrcName :: RdrName -> TcRn m Name
406 lookupSrcName rdr_name
407   = lookupSrcName_maybe rdr_name        `thenM` \ mb_name ->
408     case mb_name of
409         Nothing   -> unboundName rdr_name
410         Just name -> returnM name
411                         
412 lookupSrcName_maybe :: RdrName -> TcRn m (Maybe Name)
413 lookupSrcName_maybe rdr_name
414   | Just name <- isExact_maybe rdr_name -- Can occur in source code too
415   = returnM (Just name)
416
417   | isOrig rdr_name                     -- An original name
418   = newGlobalName (rdrNameModule rdr_name) 
419                   (rdrNameOcc rdr_name) `thenM` \ name ->
420     returnM (Just name)
421
422   | otherwise
423   = lookupGRE rdr_name  `thenM` \ mb_gre ->
424     case mb_gre of
425         Nothing  -> returnM Nothing
426         Just gre -> returnM (Just (gre_name gre))
427
428 lookupGRE :: RdrName -> TcRn m (Maybe GlobalRdrElt)
429 lookupGRE rdr_name
430   = getGlobalRdrEnv                     `thenM` \ global_env ->
431     case lookupRdrEnv global_env rdr_name of
432         Just [gre] -> case gre_deprec gre of
433                         Nothing -> returnM (Just gre)
434                         Just _  -> warnDeprec gre       `thenM_`
435                                    returnM (Just gre)
436         Just stuff@(gre : _) -> addNameClashErrRn rdr_name stuff        `thenM_`
437                                 returnM (Just gre)
438         Nothing              -> return Nothing
439                         
440 lookupIfaceName :: Module -> RdrName -> TcRn m Name
441         -- An Unqual is allowed; interface files contain 
442         -- unqualified names for locally-defined things, such as
443         -- constructors of a data type.
444 lookupIfaceName mod rdr_name
445   | isUnqual rdr_name = newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
446   | otherwise         = lookupOrigName rdr_name
447
448 lookupOrigName :: RdrName -> TcRn m Name
449         -- Just for original or exact names
450 lookupOrigName rdr_name
451   | Just n <- isExact_maybe rdr_name 
452         -- This happens in derived code, which we 
453         -- rename in InterfaceMode
454   = returnM n
455
456   | otherwise   -- Usually Orig, but can be a Qual when 
457                 -- we are reading a .hi-boot file
458   = newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
459
460
461 dataTcOccs :: RdrName -> [RdrName]
462 -- If the input is a data constructor, return both it and a type
463 -- constructor.  This is useful when we aren't sure which we are
464 -- looking at
465 dataTcOccs rdr_name
466   | isDataOcc occ = [rdr_name, rdr_name_tc]
467   | otherwise     = [rdr_name]
468   where    
469     occ         = rdrNameOcc rdr_name
470     rdr_name_tc = setRdrNameSpace rdr_name tcName
471 \end{code}
472
473 \begin{code}
474 unboundName rdr_name = addErr (unknownNameErr rdr_name) `thenM_`
475                        returnM (mkUnboundName rdr_name)
476 \end{code}
477
478 %*********************************************************
479 %*                                                      *
480                 Fixities
481 %*                                                      *
482 %*********************************************************
483
484 \begin{code}
485 --------------------------------
486 bindLocalFixities :: [RenamedFixitySig] -> RnM a -> RnM a
487 -- Used for nested fixity decls
488 -- No need to worry about type constructors here,
489 -- Should check for duplicates but we don't
490 bindLocalFixities fixes thing_inside
491   | null fixes = thing_inside
492   | otherwise  = extendFixityEnv new_bit thing_inside
493   where
494     new_bit = [(n,s) | s@(FixitySig n _ _) <- fixes]
495 \end{code}
496
497 --------------------------------
498 lookupFixity is a bit strange.  
499
500 * Nested local fixity decls are put in the local fixity env, which we
501   find with getFixtyEnv
502
503 * Imported fixities are found in the HIT or PIT
504
505 * Top-level fixity decls in this module may be for Names that are
506     either  Global         (constructors, class operations)
507     or      Local/Exported (everything else)
508   (See notes with RnNames.getLocalDeclBinders for why we have this split.)
509   We put them all in the local fixity environment
510
511 \begin{code}
512 lookupFixityRn :: Name -> RnM Fixity
513 lookupFixityRn name
514   = getModule                           `thenM` \ this_mod ->
515     if nameIsLocalOrFrom this_mod name
516     then        -- It's defined in this module
517         getFixityEnv            `thenM` \ local_fix_env ->
518         returnM (lookupFixity local_fix_env name)
519
520     else        -- It's imported
521       -- For imported names, we have to get their fixities by doing a
522       -- loadHomeInterface, and consulting the Ifaces that comes back
523       -- from that, because the interface file for the Name might not
524       -- have been loaded yet.  Why not?  Suppose you import module A,
525       -- which exports a function 'f', thus;
526       --        module CurrentModule where
527       --          import A( f )
528       --        module A( f ) where
529       --          import B( f )
530       -- Then B isn't loaded right away (after all, it's possible that
531       -- nothing from B will be used).  When we come across a use of
532       -- 'f', we need to know its fixity, and it's then, and only
533       -- then, that we load B.hi.  That is what's happening here.
534         loadInterface doc name_mod ImportBySystem       `thenM` \ iface ->
535         returnM (lookupFixity (mi_fixities iface) name)
536   where
537     doc      = ptext SLIT("Checking fixity for") <+> ppr name
538     name_mod = moduleName (nameModule name)
539 \end{code}
540
541
542 %*********************************************************
543 %*                                                      *
544 \subsection{Implicit free vars and sugar names}
545 %*                                                      *
546 %*********************************************************
547
548 @getXImplicitFVs@ forces the renamer to slurp in some things which aren't
549 mentioned explicitly, but which might be needed by the type checker.
550
551 \begin{code}
552 implicitStmtFVs source_fvs      -- Compiling a statement
553   = stmt_fvs `plusFV` implicitModuleFVs source_fvs
554   where
555     stmt_fvs = mkFVs [printName, bindIOName, thenIOName, returnIOName, failIOName]
556                 -- These are all needed implicitly when compiling a statement
557                 -- See TcModule.tc_stmts
558
559 implicitModuleFVs source_fvs
560   = mkTemplateHaskellFVs source_fvs     `plusFV` 
561     namesNeededForFlattening            `plusFV`
562     ubiquitousNames
563
564         -- This is a bit of a hack.  When we see the Template-Haskell construct
565         --      [| expr |]
566         -- we are going to need lots of the ``smart constructors'' defined in
567         -- the main Template Haskell data type module.  Rather than treat them
568         -- all as free vars at every occurrence site, we just make the Q type
569         -- consructor a free var.... and then use that here to haul in the others
570 mkTemplateHaskellFVs source_fvs
571 #ifdef GHCI
572         -- Only if Template Haskell is enabled
573   | qTyConName `elemNameSet` source_fvs = templateHaskellNames
574 #endif
575   | otherwise                           = emptyFVs
576
577 -- ubiquitous_names are loaded regardless, because 
578 -- they are needed in virtually every program
579 ubiquitousNames 
580   = mkFVs [unpackCStringName, unpackCStringFoldrName, 
581            unpackCStringUtf8Name, eqStringName]
582                 -- Virtually every program has error messages in it somewhere
583           `plusFV`
584     mkFVs [getName unitTyCon, funTyConName, boolTyConName, intTyConName]
585                 -- Add occurrences for very frequently used types.
586                 --       (e.g. we don't want to be bothered with making 
587                 --        funTyCon a free var at every function application!)
588 \end{code}
589
590 %************************************************************************
591 %*                                                                      *
592 \subsection{Re-bindable desugaring names}
593 %*                                                                      *
594 %************************************************************************
595
596 Haskell 98 says that when you say "3" you get the "fromInteger" from the
597 Standard Prelude, regardless of what is in scope.   However, to experiment
598 with having a language that is less coupled to the standard prelude, we're
599 trying a non-standard extension that instead gives you whatever "Prelude.fromInteger"
600 happens to be in scope.  Then you can
601         import Prelude ()
602         import MyPrelude as Prelude
603 to get the desired effect.
604
605 At the moment this just happens for
606   * fromInteger, fromRational on literals (in expressions and patterns)
607   * negate (in expressions)
608   * minus  (arising from n+k patterns)
609   * "do" notation
610
611 We store the relevant Name in the HsSyn tree, in 
612   * HsIntegral/HsFractional     
613   * NegApp
614   * NPlusKPatIn
615   * HsDo
616 respectively.  Initially, we just store the "standard" name (PrelNames.fromIntegralName,
617 fromRationalName etc), but the renamer changes this to the appropriate user
618 name if Opt_NoImplicitPrelude is on.  That is what lookupSyntaxName does.
619
620 We treat the orignal (standard) names as free-vars too, because the type checker
621 checks the type of the user thing against the type of the standard thing.
622
623 \begin{code}
624 lookupSyntaxName :: Name                        -- The standard name
625                  -> RnM (Name, FreeVars)        -- Possibly a non-standard name
626 lookupSyntaxName std_name
627   = getModeRn                           `thenM` \ mode ->
628     if isInterfaceMode mode then
629         returnM (std_name, unitFV std_name)
630                                 -- Happens for 'derived' code
631                                 -- where we don't want to rebind
632     else
633
634     doptM Opt_NoImplicitPrelude         `thenM` \ no_prelude -> 
635     if not no_prelude then
636         returnM (std_name, unitFV std_name)     -- Normal case
637
638     else
639         -- Get the similarly named thing from the local environment
640     lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
641     returnM (usr_name, mkFVs [usr_name, std_name])
642 \end{code}
643
644
645 %*********************************************************
646 %*                                                      *
647 \subsection{Binding}
648 %*                                                      *
649 %*********************************************************
650
651 \begin{code}
652 newLocalsRn :: [(RdrName,SrcLoc)]
653             -> RnM [Name]
654 newLocalsRn rdr_names_w_loc
655  =  newUniqueSupply             `thenM` \ us ->
656     let
657         uniqs      = uniqsFromSupply us
658         names      = [ mkInternalName uniq (rdrNameOcc rdr_name) loc
659                      | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
660                      ]
661     in
662     returnM names
663
664
665 bindLocatedLocalsRn :: SDoc     -- Documentation string for error message
666                     -> [(RdrName,SrcLoc)]
667                     -> ([Name] -> RnM a)
668                     -> RnM a
669 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
670   = getModeRn                   `thenM` \ mode ->
671     getLocalRdrEnv              `thenM` \ local_env ->
672     getGlobalRdrEnv             `thenM` \ global_env ->
673
674         -- Check for duplicate names
675     checkDupOrQualNames doc_str rdr_names_w_loc `thenM_`
676
677         -- Warn about shadowing, but only in source modules
678     let
679       check_shadow (rdr_name,loc)
680         |  rdr_name `elemRdrEnv` local_env 
681         || rdr_name `elemRdrEnv` global_env 
682         = addSrcLoc loc $ addWarn (shadowedNameWarn rdr_name)
683         | otherwise 
684         = returnM ()
685     in
686
687     (case mode of
688         SourceMode -> ifOptM Opt_WarnNameShadowing      $
689                       mappM_ check_shadow rdr_names_w_loc
690         other      -> returnM ()
691     )                                   `thenM_`
692
693     newLocalsRn rdr_names_w_loc         `thenM` \ names ->
694     let
695         new_local_env = addListToRdrEnv local_env (map fst rdr_names_w_loc `zip` names)
696     in
697     setLocalRdrEnv new_local_env (enclosed_scope names)
698
699 bindCoreLocalRn :: RdrName -> (Name -> RnM a) -> RnM a
700   -- A specialised variant when renaming stuff from interface
701   -- files (of which there is a lot)
702   --    * one at a time
703   --    * no checks for shadowing
704   --    * always imported
705   --    * deal with free vars
706 bindCoreLocalRn rdr_name enclosed_scope
707   = getSrcLocM          `thenM` \ loc ->
708     getLocalRdrEnv              `thenM` \ name_env ->
709     newUnique                   `thenM` \ uniq ->
710     let
711         name         = mkInternalName uniq (rdrNameOcc rdr_name) loc
712         new_name_env = extendRdrEnv name_env rdr_name name
713     in
714     setLocalRdrEnv new_name_env (enclosed_scope name)
715
716 bindCoreLocalsRn []     thing_inside = thing_inside []
717 bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b        $ \ name' ->
718                                        bindCoreLocalsRn bs      $ \ names' ->
719                                        thing_inside (name':names')
720
721 bindLocalNames names enclosed_scope
722   = getLocalRdrEnv              `thenM` \ name_env ->
723     setLocalRdrEnv (extendLocalRdrEnv name_env names)
724                     enclosed_scope
725
726 bindLocalNamesFV names enclosed_scope
727   = bindLocalNames names $
728     enclosed_scope `thenM` \ (thing, fvs) ->
729     returnM (thing, delListFromNameSet fvs names)
730
731
732 -------------------------------------
733 bindLocalRn doc rdr_name enclosed_scope
734   = getSrcLocM                          `thenM` \ loc ->
735     bindLocatedLocalsRn doc [(rdr_name,loc)]    $ \ (n:ns) ->
736     ASSERT( null ns )
737     enclosed_scope n
738
739 bindLocalsRn doc rdr_names enclosed_scope
740   = getSrcLocM          `thenM` \ loc ->
741     bindLocatedLocalsRn doc
742                         (rdr_names `zip` repeat loc)
743                         enclosed_scope
744
745         -- binLocalsFVRn is the same as bindLocalsRn
746         -- except that it deals with free vars
747 bindLocalsFVRn doc rdr_names enclosed_scope
748   = bindLocalsRn doc rdr_names          $ \ names ->
749     enclosed_scope names                `thenM` \ (thing, fvs) ->
750     returnM (thing, delListFromNameSet fvs names)
751
752 -------------------------------------
753 extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
754         -- This tiresome function is used only in rnSourceDecl on InstDecl
755 extendTyVarEnvFVRn tyvars enclosed_scope
756   = bindLocalNames tyvars enclosed_scope        `thenM` \ (thing, fvs) -> 
757     returnM (thing, delListFromNameSet fvs tyvars)
758
759 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
760               -> ([HsTyVarBndr Name] -> RnM a)
761               -> RnM a
762 bindTyVarsRn doc_str tyvar_names enclosed_scope
763   = getSrcLocM                                  `thenM` \ loc ->
764     let
765         located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names] 
766     in
767     bindLocatedLocalsRn doc_str located_tyvars  $ \ names ->
768     enclosed_scope (zipWith replaceTyVarName tyvar_names names)
769
770 bindPatSigTyVars :: [RdrNameHsType]
771                  -> RnM (a, FreeVars)
772                  -> RnM (a, FreeVars)
773   -- Find the type variables in the pattern type 
774   -- signatures that must be brought into scope
775
776 bindPatSigTyVars tys enclosed_scope
777   = getLocalRdrEnv              `thenM` \ name_env ->
778     getSrcLocM                  `thenM` \ loc ->
779     let
780         forall_tyvars  = nub [ tv | ty <- tys,
781                                     tv <- extractHsTyRdrTyVars ty, 
782                                     not (tv `elemFM` name_env)
783                          ]
784                 -- The 'nub' is important.  For example:
785                 --      f (x :: t) (y :: t) = ....
786                 -- We don't want to complain about binding t twice!
787
788         located_tyvars = [(tv, loc) | tv <- forall_tyvars] 
789         doc_sig        = text "In a pattern type-signature"
790     in
791     bindLocatedLocalsRn doc_sig located_tyvars  $ \ names ->
792     enclosed_scope                              `thenM` \ (thing, fvs) ->
793     returnM (thing, delListFromNameSet fvs names)
794
795
796 -------------------------------------
797 checkDupOrQualNames, checkDupNames :: SDoc
798                                    -> [(RdrName, SrcLoc)]
799                                    -> TcRn m ()
800         -- Works in any variant of the renamer monad
801
802 checkDupOrQualNames doc_str rdr_names_w_loc
803   =     -- Check for use of qualified names
804     mappM_ (qualNameErr doc_str) quals  `thenM_`
805     checkDupNames doc_str rdr_names_w_loc
806   where
807     quals = filter (isQual . fst) rdr_names_w_loc
808     
809 checkDupNames doc_str rdr_names_w_loc
810   =     -- Check for duplicated names in a binding group
811     mappM_ (dupNamesErr doc_str) dups
812   where
813     (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
814 \end{code}
815
816
817 %************************************************************************
818 %*                                                                      *
819 \subsection{GlobalRdrEnv}
820 %*                                                                      *
821 %************************************************************************
822
823 \begin{code}
824 mkGlobalRdrEnv :: ModuleName            -- Imported module (after doing the "as M" name change)
825                -> Bool                  -- True <=> want unqualified import
826                -> (Name -> Provenance)
827                -> Avails                -- Whats imported
828                -> Deprecations
829                -> GlobalRdrEnv
830
831 mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails deprecs
832   = gbl_env2
833   where
834         -- Make the name environment.  We're talking about a 
835         -- single module here, so there must be no name clashes.
836         -- In practice there only ever will be if it's the module
837         -- being compiled.
838
839         -- Add qualified names for the things that are available
840         -- (Qualified names are always imported)
841     gbl_env1 = foldl add_avail emptyRdrEnv avails
842
843         -- Add unqualified names
844     gbl_env2 | unqual_imp = foldl add_unqual gbl_env1 (rdrEnvToList gbl_env1)
845              | otherwise  = gbl_env1
846
847     add_unqual env (qual_name, elts)
848         = foldl add_one env elts
849         where
850           add_one env elt = addOneToGlobalRdrEnv env unqual_name elt
851           unqual_name     = unqualifyRdrName qual_name
852         -- The qualified import should only have added one 
853         -- binding for each qualified name!  But if there's an error in
854         -- the module (multiple bindings for the same name) we may get
855         -- duplicates.  So the simple thing is to do the fold.
856
857     add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
858     add_avail env avail = foldl (add_name (availName avail)) env (availNames avail)
859
860     add_name parent env name    -- Add qualified name only
861         = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt
862         where
863           occ  = nameOccName name
864           elt  = GRE {gre_name   = name,
865                       gre_parent = parent, 
866                       gre_prov   = mk_provenance name, 
867                       gre_deprec = lookupDeprec deprecs name}
868                       
869 \end{code}
870
871 \begin{code}
872 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
873 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
874
875 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrElt -> GlobalRdrEnv
876 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
877
878 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv 
879 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
880
881 combine_globals :: [GlobalRdrElt]       -- Old
882                 -> [GlobalRdrElt]       -- New
883                 -> [GlobalRdrElt]
884 combine_globals ns_old ns_new   -- ns_new is often short
885   = foldr add ns_old ns_new
886   where
887     add n ns | any (is_duplicate n) ns_old = map (choose n) ns  -- Eliminate duplicates
888              | otherwise                   = n:ns
889
890     choose n m | n `beats` m = n
891                | otherwise   = m
892
893     g1 `beats` g2 = gre_name g1 == gre_name g2 && 
894                     gre_prov g1 `hasBetterProv` gre_prov g2
895
896     is_duplicate :: GlobalRdrElt -> GlobalRdrElt -> Bool
897     is_duplicate g1 g2 | isLocalGRE g1 && isLocalGRE g2 = False
898     is_duplicate g1 g2 = gre_name g1 == gre_name g2
899 \end{code}
900
901 We treat two bindings of a locally-defined name as a duplicate,
902 because they might be two separate, local defns and we want to report
903 and error for that, {\em not} eliminate a duplicate.
904
905 On the other hand, if you import the same name from two different
906 import statements, we {\em do} want to eliminate the duplicate, not report
907 an error.
908
909 If a module imports itself then there might be a local defn and an imported
910 defn of the same name; in this case the names will compare as equal, but
911 will still have different provenances.
912
913
914 %************************************************************************
915 %*                                                                      *
916 \subsection{Free variable manipulation}
917 %*                                                                      *
918 %************************************************************************
919
920 \begin{code}
921 -- A useful utility
922 mapFvRn f xs = mappM f xs       `thenM` \ stuff ->
923                let
924                   (ys, fvs_s) = unzip stuff
925                in
926                returnM (ys, plusFVs fvs_s)
927 \end{code}
928
929
930 %************************************************************************
931 %*                                                                      *
932 \subsection{Envt utility functions}
933 %*                                                                      *
934 %************************************************************************
935
936 \begin{code}
937 warnUnusedModules :: [ModuleName] -> TcRn m ()
938 warnUnusedModules mods
939   = ifOptM Opt_WarnUnusedImports (mappM_ (addWarn . unused_mod) mods)
940   where
941     unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+> 
942                            text "is imported, but nothing from it is used",
943                          parens (ptext SLIT("except perhaps instances visible in") <+>
944                                    quotes (ppr m))]
945
946 warnUnusedImports, warnUnusedTopBinds :: [GlobalRdrElt] -> TcRn m ()
947 warnUnusedImports gres  = ifOptM Opt_WarnUnusedImports (warnUnusedGREs gres)
948 warnUnusedTopBinds gres = ifOptM Opt_WarnUnusedBinds   (warnUnusedGREs gres)
949
950 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> TcRn m ()
951 warnUnusedLocalBinds names = ifOptM Opt_WarnUnusedBinds   (warnUnusedLocals names)
952 warnUnusedMatches    names = ifOptM Opt_WarnUnusedMatches (warnUnusedLocals names)
953
954 -------------------------
955 --      Helpers
956 warnUnusedGREs   gres  = warnUnusedBinds [(n,p) | GRE {gre_name = n, gre_prov = p} <- gres]
957 warnUnusedLocals names = warnUnusedBinds [(n,LocalDef) | n<-names]
958
959 warnUnusedBinds :: [(Name,Provenance)] -> TcRn m ()
960 warnUnusedBinds names
961   = mappM_ warnUnusedGroup  groups
962   where
963         -- Group by provenance
964    groups = equivClasses cmp names
965    (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
966  
967
968 -------------------------
969
970 warnUnusedGroup :: [(Name,Provenance)] -> TcRn m ()
971 warnUnusedGroup names
972   | null filtered_names  = returnM ()
973   | not is_local         = returnM ()
974   | otherwise
975   = addSrcLoc def_loc   $
976     addWarn                     $
977     sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
978   where
979     filtered_names = filter reportable names
980     (name1, prov1) = head filtered_names
981     (is_local, def_loc, msg)
982         = case prov1 of
983                 LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
984
985                 NonLocalDef (UserImport mod loc _)
986                         -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
987
988     reportable (name,_) = case occNameUserString (nameOccName name) of
989                                 ('_' : _) -> False
990                                 zz_other  -> True
991         -- Haskell 98 encourages compilers to suppress warnings about
992         -- unused names in a pattern if they start with "_".
993 \end{code}
994
995 \begin{code}
996 addNameClashErrRn rdr_name (np1:nps)
997   = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
998                     ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
999   where
1000     msg1 = ptext  SLIT("either") <+> mk_ref np1
1001     msgs = [ptext SLIT("    or") <+> mk_ref np | np <- nps]
1002     mk_ref gre = quotes (ppr (gre_name gre)) <> comma <+> pprNameProvenance gre
1003
1004 shadowedNameWarn shadow
1005   = hsep [ptext SLIT("This binding for"), 
1006                quotes (ppr shadow),
1007                ptext SLIT("shadows an existing binding")]
1008
1009 unknownNameErr name
1010   = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
1011   where
1012     flavour = occNameFlavour (rdrNameOcc name)
1013
1014 badOrigBinding name
1015   = ptext SLIT("Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
1016         -- The rdrNameOcc is because we don't want to print Prelude.(,)
1017
1018 qualNameErr descriptor (name,loc)
1019   = addSrcLoc loc $
1020     addErr (vcat [ ptext SLIT("Invalid use of qualified name") <+> quotes (ppr name),
1021                      descriptor])
1022
1023 dupNamesErr descriptor ((name,loc) : dup_things)
1024   = addSrcLoc loc $
1025     addErr ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
1026               $$ 
1027               descriptor)
1028
1029 warnDeprec :: GlobalRdrElt -> TcRn m ()
1030 warnDeprec (GRE {gre_name = name, gre_deprec = Just txt})
1031   = ifOptM Opt_WarnDeprecations $
1032     addWarn (sep [ text (occNameFlavour (nameOccName name)) <+> 
1033                      quotes (ppr name) <+> text "is deprecated:", 
1034                      nest 4 (ppr txt) ])
1035 \end{code}
1036