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