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 (
   8         newTopSrcBinder,
   9         lookupLocatedBndrRn, lookupBndrRn,
  10         lookupLocatedTopBndrRn, lookupTopBndrRn,
  11         lookupLocatedOccRn, lookupOccRn,
  12         lookupLocatedGlobalOccRn, lookupGlobalOccRn,
  13         lookupTopFixSigNames, lookupSrcOcc_maybe,
  14         lookupFixityRn, lookupLocatedSigOccRn,
  15         lookupLocatedInstDeclBndr,
  16         lookupSyntaxName, lookupSyntaxNames, lookupImportedName,
  17
  18         newLocalsRn, newIPNameRn,
  19         bindLocalNames, bindLocalNamesFV,
  20         bindLocatedLocalsFV, bindLocatedLocalsRn,
  21         bindPatSigTyVars, bindPatSigTyVarsFV,
  22         bindTyVarsRn, extendTyVarEnvFVRn,
  23         bindLocalFixities,
  24
  25         checkDupNames, mapFvRn,
  26         warnUnusedMatches, warnUnusedModules, warnUnusedImports,
  27         warnUnusedTopBinds, warnUnusedLocalBinds,
  28         dataTcOccs, unknownNameErr,
  29     ) where
  30
  31 #include "HsVersions.h"
  32
  33 import LoadIface        ( loadSrcInterface )
  34 import IfaceEnv         ( lookupOrig, newGlobalBinder, newIPName )
  35 import HsSyn
  36 import RdrHsSyn         ( extractHsTyRdrTyVars )
  37 import RdrName          ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
  38                           mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
  39                           pprGlobalRdrEnv, lookupGRE_RdrName,
  40                           isExact_maybe, isSrcRdrName,
  41                           GlobalRdrElt(..), GlobalRdrEnv, lookupGlobalRdrEnv,
  42                           isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
  43                           Provenance(..), pprNameProvenance, ImportSpec(..)
  44                         )
  45 import HsTypes          ( replaceTyVarName )
  46 import HscTypes         ( availNames, ModIface(..), FixItem(..), lookupFixity )
  47 import TcRnMonad
  48 import Name             ( Name, nameIsLocalOrFrom, mkInternalName, isInternalName,
  49                           nameSrcLoc, nameOccName, nameModule, nameParent, isExternalName )
  50 import NameSet
  51 import OccName          ( tcName, isDataOcc, occNameFlavour, reportIfUnused )
  52 import Module           ( Module )
  53 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 import ListSetOps       ( removeDups )
  61 import List             ( nubBy )
  62 import CmdLineOpts
  63 import FastString       ( FastString )
  64 \end{code}
  65
  66 %*********************************************************
  67 %*                                                      *
  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         --   (a) Exact-name binders created by Template Haskell
  78         --   (b) The PrelBase defn of (say) [] and similar, for which
  79         --       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         -- very confused indeed.
  83     ASSERT2( isExternalName name,  ppr name )
  84     ASSERT2( this_mod == nameModule name, ppr name )
  85     returnM name
  86
  87   | isOrig rdr_name
  88   = do  checkErr (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
  89                  (badOrigBinding rdr_name)
  90         -- When reading External Core we get Orig names as binders,
  91         -- but they should agree with the module gotten from the monad
  92         --
  93         -- We can get built-in syntax showing up here too, sadly.  If you type
  94         --      data T = (,,,)
  95         -- the constructor is parsed as a type, and then RdrHsSyn.tyConToDataCon
  96         -- uses setRdrNameSpace to make it into a data constructors.  At that point
  97         -- the nice Exact name for the TyCon gets swizzled to an Orig name.
  98         -- Hence the badOrigBinding error message.
  99         --
 100         -- Except for the ":Main.main = ..." definition inserted into
 101         -- the Main module; ugh!
 102
 103         -- Because of this latter case, we call newGlobalBinder with a module from
 104         -- the RdrName, not from the environment.  In principle, it'd be fine to
 105         -- have an arbitrary mixture of external core definitions in a single module,
 106         -- (apart from module-initialisation issues, perhaps).
 107         newGlobalBinder rdr_mod (rdrNameOcc rdr_name) mb_parent
 108                         (srcSpanStart loc) --TODO, should pass the whole span
 109
 110   | otherwise
 111   = newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc)
 112   where
 113     rdr_mod  = rdrNameModule rdr_name
 114 \end{code}
 115
 116 %*********************************************************
 117 %*                                                      *
 118         Source code occurrences
 119 %*                                                      *
 120 %*********************************************************
 121
 122 Looking up a name in the RnEnv.
 123
 124 \begin{code}
 125 lookupLocatedBndrRn :: Located RdrName -> RnM (Located Name)
 126 lookupLocatedBndrRn = wrapLocM lookupBndrRn
 127
 128 lookupBndrRn :: RdrName -> RnM Name
 129 -- NOTE: assumes that the SrcSpan of the binder has already been setSrcSpan'd
 130 lookupBndrRn rdr_name
 131   = getLocalRdrEnv              `thenM` \ local_env ->
 132     case lookupLocalRdrEnv local_env rdr_name of
 133           Just name -> returnM name
 134           Nothing   -> lookupTopBndrRn rdr_name
 135
 136 lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
 137 lookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn
 138
 139 lookupTopBndrRn :: RdrName -> RnM Name
 140 -- Look up a top-level source-code binder.   We may be looking up an unqualified 'f',
 141 -- and there may be several imported 'f's too, which must not confuse us.
 142 -- For example, this is OK:
 143 --      import Foo( f )
 144 --      infix 9 f       -- The 'f' here does not need to be qualified
 145 --      f x = x         -- Nor here, of course
 146 -- So we have to filter out the non-local ones.
 147 --
 148 -- A separate function (importsFromLocalDecls) reports duplicate top level
 149 -- decls, so here it's safe just to choose an arbitrary one.
 150 --
 151 -- There should never be a qualified name in a binding position in Haskell,
 152 -- but there can be if we have read in an external-Core file.
 153 -- The Haskell parser checks for the illegal qualified name in Haskell
 154 -- source files, so we don't need to do so here.
 155
 156 lookupTopBndrRn rdr_name
 157   | Just name <- isExact_maybe rdr_name
 158   = returnM name
 159
 160   | isOrig rdr_name
 161         -- This deals with the case of derived bindings, where
 162         -- we don't bother to call newTopSrcBinder first
 163         -- We assume there is no "parent" name
 164   = do  { loc <- getSrcSpanM
 165         ; newGlobalBinder (rdrNameModule rdr_name)
 166                           (rdrNameOcc rdr_name) Nothing (srcSpanStart loc) }
 167
 168   | otherwise
 169   = do  { mb_gre <- lookupGreLocalRn rdr_name
 170         ; case mb_gre of
 171                 Nothing  -> unboundName rdr_name
 172                 Just gre -> returnM (gre_name gre) }
 173
 174 -- lookupLocatedSigOccRn is used for type signatures and pragmas
 175 -- Is this valid?
 176 --   module A
 177 --      import M( f )
 178 --      f :: Int -> Int
 179 --      f x = x
 180 -- It's clear that the 'f' in the signature must refer to A.f
 181 -- The Haskell98 report does not stipulate this, but it will!
 182 -- So we must treat the 'f' in the signature in the same way
 183 -- as the binding occurrence of 'f', using lookupBndrRn
 184 lookupLocatedSigOccRn :: Located RdrName -> RnM (Located Name)
 185 lookupLocatedSigOccRn = lookupLocatedBndrRn
 186
 187 -- lookupInstDeclBndr is used for the binders in an
 188 -- instance declaration.   Here we use the class name to
 189 -- disambiguate.
 190
 191 lookupLocatedInstDeclBndr :: Name -> Located RdrName -> RnM (Located Name)
 192 lookupLocatedInstDeclBndr cls = wrapLocM (lookupInstDeclBndr cls)
 193
 194 lookupInstDeclBndr :: Name -> RdrName -> RnM Name
 195 lookupInstDeclBndr cls_name rdr_name
 196   | isUnqual rdr_name   -- Find all the things the rdr-name maps to
 197   = do  {               -- and pick the one with the right parent name
 198           let { is_op gre     = cls_name == nameParent (gre_name gre)
 199               ; occ           = rdrNameOcc rdr_name
 200               ; lookup_fn env = filter is_op (lookupGlobalRdrEnv env occ) }
 201         ; mb_gre <- lookupGreRn_help rdr_name lookup_fn
 202         ; case mb_gre of
 203             Just gre -> return (gre_name gre)
 204             Nothing  -> do { addErr (unknownInstBndrErr cls_name rdr_name)
 205                            ; return (mkUnboundName rdr_name) } }
 206
 207   | otherwise   -- Occurs in derived instances, where we just
 208                 -- refer directly to the right method
 209   = ASSERT2( not (isQual rdr_name), ppr rdr_name )
 210           -- NB: qualified names are rejected by the parser
 211     lookupImportedName rdr_name
 212
 213 newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
 214 newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
 215
 216 --------------------------------------------------
 217 --              Occurrences
 218 --------------------------------------------------
 219
 220 lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
 221 lookupLocatedOccRn = wrapLocM lookupOccRn
 222
 223 -- lookupOccRn looks up an occurrence of a RdrName
 224 lookupOccRn :: RdrName -> RnM Name
 225 lookupOccRn rdr_name
 226   = getLocalRdrEnv                      `thenM` \ local_env ->
 227     case lookupLocalRdrEnv local_env rdr_name of
 228           Just name -> returnM name
 229           Nothing   -> lookupGlobalOccRn rdr_name
 230
 231 lookupLocatedGlobalOccRn :: Located RdrName -> RnM (Located Name)
 232 lookupLocatedGlobalOccRn = wrapLocM lookupGlobalOccRn
 233
 234 lookupGlobalOccRn :: RdrName -> RnM Name
 235 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
 236 -- environment.  It's used only for
 237 --      record field names
 238 --      class op names in class and instance decls
 239
 240 lookupGlobalOccRn rdr_name
 241   | not (isSrcRdrName rdr_name)
 242   = lookupImportedName rdr_name
 243
 244   | otherwise
 245   =     -- First look up the name in the normal environment.
 246    lookupGreRn rdr_name                 `thenM` \ mb_gre ->
 247    case mb_gre of {
 248         Just gre -> returnM (gre_name gre) ;
 249         Nothing   ->
 250
 251         -- We allow qualified names on the command line to refer to
 252         -- *any* name exported by any module in scope, just as if
 253         -- there was an "import qualified M" declaration for every
 254         -- module.
 255    getModule            `thenM` \ mod ->
 256    if isQual rdr_name && mod == iNTERACTIVE then
 257                                         -- This test is not expensive,
 258         lookupQualifiedName rdr_name    -- and only happens for failed lookups
 259    else
 260         unboundName rdr_name }
 261
 262 lookupImportedName :: RdrName -> TcRnIf m n Name
 263 -- Lookup the occurrence of an imported name
 264 -- The RdrName is *always* qualified or Exact
 265 -- Treat it as an original name, and conjure up the Name
 266 -- Usually it's Exact or Orig, but it can be Qual if it
 267 --      comes from an hi-boot file.  (This minor infelicity is
 268 --      just to reduce duplication in the parser.)
 269 lookupImportedName rdr_name
 270   | Just n <- isExact_maybe rdr_name
 271         -- This happens in derived code
 272   = returnM n
 273
 274   | otherwise   -- Always Orig, even when reading a .hi-boot file
 275   = ASSERT( not (isUnqual rdr_name) )
 276     lookupOrig (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
 277
 278 unboundName :: RdrName -> RnM Name
 279 unboundName rdr_name
 280   = do  { addErr (unknownNameErr rdr_name)
 281         ; env <- getGlobalRdrEnv;
 282         ; traceRn (vcat [unknownNameErr rdr_name,
 283                          ptext SLIT("Global envt is:"),
 284                          nest 3 (pprGlobalRdrEnv env)])
 285         ; returnM (mkUnboundName rdr_name) }
 286
 287 --------------------------------------------------
 288 --      Lookup in the Global RdrEnv of the module
 289 --------------------------------------------------
 290
 291 lookupSrcOcc_maybe :: RdrName -> RnM (Maybe Name)
 292 -- No filter function; does not report an error on failure
 293 lookupSrcOcc_maybe rdr_name
 294   = do  { mb_gre <- lookupGreRn rdr_name
 295         ; case mb_gre of
 296                 Nothing  -> returnM Nothing
 297                 Just gre -> returnM (Just (gre_name gre)) }
 298
 299 -------------------------
 300 lookupGreRn :: RdrName -> RnM (Maybe GlobalRdrElt)
 301 -- Just look up the RdrName in the GlobalRdrEnv
 302 lookupGreRn rdr_name
 303   = lookupGreRn_help rdr_name (lookupGRE_RdrName rdr_name)
 304
 305 lookupGreLocalRn :: RdrName -> RnM (Maybe GlobalRdrElt)
 306 -- Similar, but restricted to locally-defined things
 307 lookupGreLocalRn rdr_name
 308   = lookupGreRn_help rdr_name lookup_fn
 309   where
 310     lookup_fn env = filter isLocalGRE (lookupGRE_RdrName rdr_name env)
 311
 312 lookupGreRn_help :: RdrName                     -- Only used in error message
 313                  -> (GlobalRdrEnv -> [GlobalRdrElt])    -- Lookup function
 314                  -> RnM (Maybe GlobalRdrElt)
 315 -- Checks for exactly one match; reports deprecations
 316 -- Returns Nothing, without error, if too few
 317 lookupGreRn_help rdr_name lookup
 318   = do  { env <- getGlobalRdrEnv
 319         ; case lookup env of
 320             []    -> returnM Nothing
 321             [gre] -> returnM (Just gre)
 322             gres  -> do { addNameClashErrRn rdr_name gres
 323                         ; returnM (Just (head gres)) } }
 324
 325 ------------------------------
 326 --      GHCi support
 327 ------------------------------
 328
 329 -- A qualified name on the command line can refer to any module at all: we
 330 -- try to load the interface if we don't already have it.
 331 lookupQualifiedName :: RdrName -> RnM Name
 332 lookupQualifiedName rdr_name
 333  = let
 334        mod = rdrNameModule rdr_name
 335        occ = rdrNameOcc rdr_name
 336    in
 337    loadSrcInterface doc mod False       `thenM` \ iface ->
 338
 339    case  [ (mod,occ) |
 340            (mod,avails) <- mi_exports iface,
 341            avail        <- avails,
 342            name         <- availNames avail,
 343            name == occ ] of
 344       ((mod,occ):ns) -> ASSERT (null ns)
 345                         lookupOrig mod occ
 346       _ -> unboundName rdr_name
 347   where
 348     doc = ptext SLIT("Need to find") <+> ppr rdr_name
 349 \end{code}
 350
 351 %*********************************************************
 352 %*                                                      *
 353                 Fixities
 354 %*                                                      *
 355 %*********************************************************
 356
 357 \begin{code}
 358 lookupTopFixSigNames :: RdrName -> RnM [Name]
 359 -- GHC extension: look up both the tycon and data con
 360 -- for con-like things
 361 lookupTopFixSigNames rdr_name
 362   | Just n <- isExact_maybe rdr_name
 363         -- Special case for (:), which doesn't get into the GlobalRdrEnv
 364   = return [n]  -- For this we don't need to try the tycon too
 365   | otherwise
 366   = do  { mb_gres <- mapM lookupGreLocalRn (dataTcOccs rdr_name)
 367         ; return [gre_name gre | Just gre <- mb_gres] }
 368
 369 --------------------------------
 370 bindLocalFixities :: [FixitySig RdrName] -> RnM a -> RnM a
 371 -- Used for nested fixity decls
 372 -- No need to worry about type constructors here,
 373 -- Should check for duplicates but we don't
 374 bindLocalFixities fixes thing_inside
 375   | null fixes = thing_inside
 376   | otherwise  = mappM rn_sig fixes     `thenM` \ new_bit ->
 377                  extendFixityEnv new_bit thing_inside
 378   where
 379     rn_sig (FixitySig lv@(L loc v) fix)
 380         = addLocM lookupBndrRn lv       `thenM` \ new_v ->
 381           returnM (new_v, (FixItem (rdrNameOcc v) fix loc))
 382 \end{code}
 383
 384 --------------------------------
 385 lookupFixity is a bit strange.
 386
 387 * Nested local fixity decls are put in the local fixity env, which we
 388   find with getFixtyEnv
 389
 390 * Imported fixities are found in the HIT or PIT
 391
 392 * Top-level fixity decls in this module may be for Names that are
 393     either  Global         (constructors, class operations)
 394     or      Local/Exported (everything else)
 395   (See notes with RnNames.getLocalDeclBinders for why we have this split.)
 396   We put them all in the local fixity environment
 397
 398 \begin{code}
 399 lookupFixityRn :: Name -> RnM Fixity
 400 lookupFixityRn name
 401   = getModule                           `thenM` \ this_mod ->
 402     if nameIsLocalOrFrom this_mod name
 403     then        -- It's defined in this module
 404         getFixityEnv            `thenM` \ local_fix_env ->
 405         traceRn (text "lookupFixityRn" <+> (ppr name $$ ppr local_fix_env)) `thenM_`
 406         returnM (lookupFixity local_fix_env name)
 407
 408     else        -- It's imported
 409       -- For imported names, we have to get their fixities by doing a
 410       -- loadHomeInterface, and consulting the Ifaces that comes back
 411       -- from that, because the interface file for the Name might not
 412       -- have been loaded yet.  Why not?  Suppose you import module A,
 413       -- which exports a function 'f', thus;
 414       --        module CurrentModule where
 415       --          import A( f )
 416       --        module A( f ) where
 417       --          import B( f )
 418       -- Then B isn't loaded right away (after all, it's possible that
 419       -- nothing from B will be used).  When we come across a use of
 420       -- 'f', we need to know its fixity, and it's then, and only
 421       -- then, that we load B.hi.  That is what's happening here.
 422         loadSrcInterface doc name_mod False     `thenM` \ iface ->
 423         returnM (mi_fix_fn iface (nameOccName name))
 424   where
 425     doc      = ptext SLIT("Checking fixity for") <+> ppr name
 426     name_mod = nameModule name
 427
 428 dataTcOccs :: RdrName -> [RdrName]
 429 -- If the input is a data constructor, return both it and a type
 430 -- constructor.  This is useful when we aren't sure which we are
 431 -- looking at.
 432 dataTcOccs rdr_name
 433   | Just n <- isExact_maybe rdr_name            -- Ghastly special case
 434   , n `hasKey` consDataConKey = [rdr_name]      -- see note below
 435   | isDataOcc occ             = [rdr_name_tc, rdr_name]
 436   | otherwise                 = [rdr_name]
 437   where
 438     occ         = rdrNameOcc rdr_name
 439     rdr_name_tc = setRdrNameSpace rdr_name tcName
 440
 441 -- If the user typed "[]" or "(,,)", we'll generate an Exact RdrName,
 442 -- and setRdrNameSpace generates an Orig, which is fine
 443 -- But it's not fine for (:), because there *is* no corresponding type
 444 -- constructor.  If we generate an Orig tycon for GHC.Base.(:), it'll
 445 -- appear to be in scope (because Orig's simply allocate a new name-cache
 446 -- entry) and then we get an error when we use dataTcOccs in
 447 -- TcRnDriver.tcRnGetInfo.  Large sigh.
 448 \end{code}
 449
 450 %************************************************************************
 451 %*                                                                      *
 452                         Rebindable names
 453         Dealing with rebindable syntax is driven by the
 454         Opt_NoImplicitPrelude dynamic flag.
 455
 456         In "deriving" code we don't want to use rebindable syntax
 457         so we switch off the flag locally
 458
 459 %*                                                                      *
 460 %************************************************************************
 461
 462 Haskell 98 says that when you say "3" you get the "fromInteger" from the
 463 Standard Prelude, regardless of what is in scope.   However, to experiment
 464 with having a language that is less coupled to the standard prelude, we're
 465 trying a non-standard extension that instead gives you whatever "Prelude.fromInteger"
 466 happens to be in scope.  Then you can
 467         import Prelude ()
 468         import MyPrelude as Prelude
 469 to get the desired effect.
 470
 471 At the moment this just happens for
 472   * fromInteger, fromRational on literals (in expressions and patterns)
 473   * negate (in expressions)
 474   * minus  (arising from n+k patterns)
 475   * "do" notation
 476
 477 We store the relevant Name in the HsSyn tree, in
 478   * HsIntegral/HsFractional
 479   * NegApp
 480   * NPlusKPatIn
 481   * HsDo
 482 respectively.  Initially, we just store the "standard" name (PrelNames.fromIntegralName,
 483 fromRationalName etc), but the renamer changes this to the appropriate user
 484 name if Opt_NoImplicitPrelude is on.  That is what lookupSyntaxName does.
 485
 486 We treat the orignal (standard) names as free-vars too, because the type checker
 487 checks the type of the user thing against the type of the standard thing.
 488
 489 \begin{code}
 490 lookupSyntaxName :: Name                        -- The standard name
 491                  -> RnM (Name, FreeVars)        -- Possibly a non-standard name
 492 lookupSyntaxName std_name
 493   = doptM Opt_ImplicitPrelude           `thenM` \ implicit_prelude ->
 494     if implicit_prelude then normal_case
 495     else
 496         -- Get the similarly named thing from the local environment
 497     lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
 498     returnM (usr_name, unitFV usr_name)
 499   where
 500     normal_case = returnM (std_name, emptyFVs)
 501
 502 lookupSyntaxNames :: [Name]                             -- Standard names
 503                   -> RnM (ReboundNames Name, FreeVars)  -- See comments with HsExpr.ReboundNames
 504 lookupSyntaxNames std_names
 505   = doptM Opt_ImplicitPrelude           `thenM` \ implicit_prelude ->
 506     if implicit_prelude then normal_case
 507     else
 508         -- Get the similarly named thing from the local environment
 509     mappM (lookupOccRn . mkRdrUnqual . nameOccName) std_names   `thenM` \ usr_names ->
 510
 511     returnM (std_names `zip` map HsVar usr_names, mkFVs usr_names)
 512   where
 513     normal_case = returnM (std_names `zip` map HsVar std_names, emptyFVs)
 514 \end{code}
 515
 516
 517 %*********************************************************
 518 %*                                                      *
 519 \subsection{Binding}
 520 %*                                                      *
 521 %*********************************************************
 522
 523 \begin{code}
 524 newLocalsRn :: [Located RdrName] -> RnM [Name]
 525 newLocalsRn rdr_names_w_loc
 526   = newUniqueSupply             `thenM` \ us ->
 527     returnM (zipWith mk rdr_names_w_loc (uniqsFromSupply us))
 528   where
 529     mk (L loc rdr_name) uniq
 530         | Just name <- isExact_maybe rdr_name = name
 531                 -- This happens in code generated by Template Haskell
 532         | otherwise = ASSERT2( isUnqual rdr_name, ppr rdr_name )
 533                         -- We only bind unqualified names here
 534                         -- lookupRdrEnv doesn't even attempt to look up a qualified RdrName
 535                       mkInternalName uniq (rdrNameOcc rdr_name) (srcSpanStart loc)
 536
 537 bindLocatedLocalsRn :: SDoc     -- Documentation string for error message
 538                     -> [Located RdrName]
 539                     -> ([Name] -> RnM a)
 540                     -> RnM a
 541 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
 542   =     -- Check for duplicate names
 543     checkDupNames doc_str rdr_names_w_loc       `thenM_`
 544
 545         -- Warn about shadowing, but only in source modules
 546     ifOptM Opt_WarnNameShadowing
 547       (checkShadowing doc_str rdr_names_w_loc)  `thenM_`
 548
 549         -- Make fresh Names and extend the environment
 550     newLocalsRn rdr_names_w_loc         `thenM` \ names ->
 551     getLocalRdrEnv                      `thenM` \ local_env ->
 552     setLocalRdrEnv (extendLocalRdrEnv local_env names)
 553                    (enclosed_scope names)
 554
 555
 556 bindLocalNames names enclosed_scope
 557   = getLocalRdrEnv              `thenM` \ name_env ->
 558     setLocalRdrEnv (extendLocalRdrEnv name_env names)
 559                     enclosed_scope
 560
 561 bindLocalNamesFV names enclosed_scope
 562   = bindLocalNames names $
 563     enclosed_scope `thenM` \ (thing, fvs) ->
 564     returnM (thing, delListFromNameSet fvs names)
 565
 566
 567 -------------------------------------
 568         -- binLocalsFVRn is the same as bindLocalsRn
 569         -- except that it deals with free vars
 570 bindLocatedLocalsFV :: SDoc -> [Located RdrName] -> ([Name] -> RnM (a,FreeVars))
 571   -> RnM (a, FreeVars)
 572 bindLocatedLocalsFV doc rdr_names enclosed_scope
 573   = bindLocatedLocalsRn doc rdr_names   $ \ names ->
 574     enclosed_scope names                `thenM` \ (thing, fvs) ->
 575     returnM (thing, delListFromNameSet fvs names)
 576
 577 -------------------------------------
 578 extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
 579         -- This tiresome function is used only in rnSourceDecl on InstDecl
 580 extendTyVarEnvFVRn tyvars enclosed_scope
 581   = bindLocalNames tyvars enclosed_scope        `thenM` \ (thing, fvs) ->
 582     returnM (thing, delListFromNameSet fvs tyvars)
 583
 584 bindTyVarsRn :: SDoc -> [LHsTyVarBndr RdrName]
 585               -> ([LHsTyVarBndr Name] -> RnM a)
 586               -> RnM a
 587 bindTyVarsRn doc_str tyvar_names enclosed_scope
 588   = let
 589         located_tyvars = hsLTyVarLocNames tyvar_names
 590     in
 591     bindLocatedLocalsRn doc_str located_tyvars  $ \ names ->
 592     enclosed_scope (zipWith replace tyvar_names names)
 593     where
 594         replace (L loc n1) n2 = L loc (replaceTyVarName n1 n2)
 595
 596 bindPatSigTyVars :: [LHsType RdrName] -> ([Name] -> RnM a) -> RnM a
 597   -- Find the type variables in the pattern type
 598   -- signatures that must be brought into scope
 599 bindPatSigTyVars tys thing_inside
 600   = getLocalRdrEnv              `thenM` \ name_env ->
 601     let
 602         located_tyvars  = nubBy eqLocated [ tv | ty <- tys,
 603                                     tv <- extractHsTyRdrTyVars ty,
 604                                     not (unLoc tv `elemLocalRdrEnv` name_env)
 605                          ]
 606                 -- The 'nub' is important.  For example:
 607                 --      f (x :: t) (y :: t) = ....
 608                 -- We don't want to complain about binding t twice!
 609
 610         doc_sig        = text "In a pattern type-signature"
 611     in
 612     bindLocatedLocalsRn doc_sig located_tyvars thing_inside
 613
 614 bindPatSigTyVarsFV :: [LHsType RdrName]
 615                    -> RnM (a, FreeVars)
 616                    -> RnM (a, FreeVars)
 617 bindPatSigTyVarsFV tys thing_inside
 618   = bindPatSigTyVars tys        $ \ tvs ->
 619     thing_inside                `thenM` \ (result,fvs) ->
 620     returnM (result, fvs `delListFromNameSet` tvs)
 621
 622 -------------------------------------
 623 checkDupNames :: SDoc
 624               -> [Located RdrName]
 625               -> RnM ()
 626 checkDupNames doc_str rdr_names_w_loc
 627   =     -- Check for duplicated names in a binding group
 628     mappM_ (dupNamesErr doc_str) dups
 629   where
 630     (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc
 631
 632 -------------------------------------
 633 checkShadowing doc_str loc_rdr_names
 634   = getLocalRdrEnv              `thenM` \ local_env ->
 635     getGlobalRdrEnv             `thenM` \ global_env ->
 636     let
 637       check_shadow (L loc rdr_name)
 638         |  rdr_name `elemLocalRdrEnv` local_env
 639         || not (null (lookupGRE_RdrName rdr_name global_env ))
 640         = setSrcSpan loc $ addWarn (shadowedNameWarn doc_str rdr_name)
 641         | otherwise = returnM ()
 642     in
 643     mappM_ check_shadow loc_rdr_names
 644 \end{code}
 645
 646
 647 %************************************************************************
 648 %*                                                                      *
 649 \subsection{Free variable manipulation}
 650 %*                                                                      *
 651 %************************************************************************
 652
 653 \begin{code}
 654 -- A useful utility
 655 mapFvRn f xs = mappM f xs       `thenM` \ stuff ->
 656                let
 657                   (ys, fvs_s) = unzip stuff
 658                in
 659                returnM (ys, plusFVs fvs_s)
 660 \end{code}
 661
 662
 663 %************************************************************************
 664 %*                                                                      *
 665 \subsection{Envt utility functions}
 666 %*                                                                      *
 667 %************************************************************************
 668
 669 \begin{code}
 670 warnUnusedModules :: [(Module,SrcSpan)] -> RnM ()
 671 warnUnusedModules mods
 672   = ifOptM Opt_WarnUnusedImports (mappM_ bleat mods)
 673   where
 674     bleat (mod,loc) = setSrcSpan loc $ addWarn (mk_warn mod)
 675     mk_warn m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
 676                          text "is imported, but nothing from it is used",
 677                          parens (ptext SLIT("except perhaps instances visible in") <+>
 678                                    quotes (ppr m))]
 679
 680 warnUnusedImports, warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
 681 warnUnusedImports gres  = ifOptM Opt_WarnUnusedImports (warnUnusedGREs gres)
 682 warnUnusedTopBinds gres = ifOptM Opt_WarnUnusedBinds   (warnUnusedGREs gres)
 683
 684 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM ()
 685 warnUnusedLocalBinds names = ifOptM Opt_WarnUnusedBinds   (warnUnusedLocals names)
 686 warnUnusedMatches    names = ifOptM Opt_WarnUnusedMatches (warnUnusedLocals names)
 687
 688 -------------------------
 689 --      Helpers
 690 warnUnusedGREs gres
 691  = warnUnusedBinds [(n,Just p) | GRE {gre_name = n, gre_prov = p} <- gres]
 692
 693 warnUnusedLocals names
 694  = warnUnusedBinds [(n,Nothing) | n<-names]
 695
 696 warnUnusedBinds :: [(Name,Maybe Provenance)] -> RnM ()
 697 warnUnusedBinds names  = mappM_ warnUnusedName (filter reportable names)
 698  where reportable (name,_) = reportIfUnused (nameOccName name)
 699
 700 -------------------------
 701
 702 warnUnusedName :: (Name, Maybe Provenance) -> RnM ()
 703 warnUnusedName (name, prov)
 704   = addWarnAt loc $
 705     sep [msg <> colon,
 706          nest 2 $ occNameFlavour (nameOccName name) <+> quotes (ppr name)]
 707         -- TODO should be a proper span
 708   where
 709     (loc,msg) = case prov of
 710                   Just (Imported is _) ->
 711                      ( is_loc (head is), imp_from (is_mod imp_spec) )
 712                      where
 713                          imp_spec = head is
 714                   other ->
 715                      ( srcLocSpan (nameSrcLoc name), unused_msg )
 716
 717     unused_msg   = text "Defined but not used"
 718     imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"
 719 \end{code}
 720
 721 \begin{code}
 722 addNameClashErrRn rdr_name (np1:nps)
 723   = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
 724                   ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
 725   where
 726     msg1 = ptext  SLIT("either") <+> mk_ref np1
 727     msgs = [ptext SLIT("    or") <+> mk_ref np | np <- nps]
 728     mk_ref gre = quotes (ppr (gre_name gre)) <> comma <+> pprNameProvenance gre
 729
 730 shadowedNameWarn doc shadow
 731   = hsep [ptext SLIT("This binding for"),
 732                quotes (ppr shadow),
 733                ptext SLIT("shadows an existing binding")]
 734     $$ doc
 735
 736 unknownNameErr rdr_name
 737   = sep [ptext SLIT("Not in scope:"),
 738          nest 2 $ occNameFlavour (rdrNameOcc rdr_name) <+> quotes (ppr rdr_name)]
 739
 740 unknownInstBndrErr cls op
 741   = quotes (ppr op) <+> ptext SLIT("is not a (visible) method of class") <+> quotes (ppr cls)
 742
 743 badOrigBinding name
 744   = ptext SLIT("Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
 745         -- The rdrNameOcc is because we don't want to print Prelude.(,)
 746
 747 dupNamesErr :: SDoc -> [Located RdrName] -> RnM ()
 748 dupNamesErr descriptor located_names
 749   = setSrcSpan big_loc $
 750     addErr (vcat [ptext SLIT("Conflicting definitions for") <+> quotes (ppr name1),
 751                   locations,
 752                   descriptor])
 753   where
 754     L _ name1 = head located_names
 755     locs      = map getLoc located_names
 756     big_loc   = foldr1 combineSrcSpans locs
 757     one_line  = srcSpanStartLine big_loc == srcSpanEndLine big_loc
 758     locations | one_line  = empty
 759               | otherwise = ptext SLIT("Bound at:") <+>
 760                             vcat (map ppr (sortLe (<=) locs))
 761 \end{code}