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