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