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] -> returnM (Just gre)
 318             gres  -> do { addNameClashErrRn rdr_name gres
 319                         ; returnM (Just (head gres)) } }
 320
 321 ------------------------------
 322 --      GHCi support
 323 ------------------------------
 324
 325 -- A qualified name on the command line can refer to any module at all: we
 326 -- try to load the interface if we don't already have it.
 327 lookupQualifiedName :: RdrName -> RnM Name
 328 lookupQualifiedName rdr_name
 329  = let
 330        mod = rdrNameModule rdr_name
 331        occ = rdrNameOcc rdr_name
 332    in
 333    loadSrcInterface doc mod False       `thenM` \ iface ->
 334
 335    case  [ (mod,occ) |
 336            (mod,avails) <- mi_exports iface,
 337            avail        <- avails,
 338            name         <- availNames avail,
 339            name == occ ] of
 340       ((mod,occ):ns) -> ASSERT (null ns)
 341                         lookupOrig mod occ
 342       _ -> unboundName rdr_name
 343   where
 344     doc = ptext SLIT("Need to find") <+> ppr rdr_name
 345 \end{code}
 346
 347 %*********************************************************
 348 %*                                                      *
 349                 Fixities
 350 %*                                                      *
 351 %*********************************************************
 352
 353 \begin{code}
 354 lookupTopFixSigNames :: RdrName -> RnM [Name]
 355 -- GHC extension: look up both the tycon and data con
 356 -- for con-like things
 357 lookupTopFixSigNames rdr_name
 358   | Just n <- isExact_maybe rdr_name
 359         -- Special case for (:), which doesn't get into the GlobalRdrEnv
 360   = return [n]  -- For this we don't need to try the tycon too
 361   | otherwise
 362   = do  { mb_gres <- mapM lookupGreLocalRn (dataTcOccs rdr_name)
 363         ; return [gre_name gre | Just gre <- mb_gres] }
 364
 365 --------------------------------
 366 bindLocalFixities :: [FixitySig RdrName] -> RnM a -> RnM a
 367 -- Used for nested fixity decls
 368 -- No need to worry about type constructors here,
 369 -- Should check for duplicates but we don't
 370 bindLocalFixities fixes thing_inside
 371   | null fixes = thing_inside
 372   | otherwise  = mappM rn_sig fixes     `thenM` \ new_bit ->
 373                  extendFixityEnv new_bit thing_inside
 374   where
 375     rn_sig (FixitySig lv@(L loc v) fix)
 376         = addLocM lookupBndrRn lv       `thenM` \ new_v ->
 377           returnM (new_v, (FixItem (rdrNameOcc v) fix loc))
 378 \end{code}
 379
 380 --------------------------------
 381 lookupFixity is a bit strange.
 382
 383 * Nested local fixity decls are put in the local fixity env, which we
 384   find with getFixtyEnv
 385
 386 * Imported fixities are found in the HIT or PIT
 387
 388 * Top-level fixity decls in this module may be for Names that are
 389     either  Global         (constructors, class operations)
 390     or      Local/Exported (everything else)
 391   (See notes with RnNames.getLocalDeclBinders for why we have this split.)
 392   We put them all in the local fixity environment
 393
 394 \begin{code}
 395 lookupFixityRn :: Name -> RnM Fixity
 396 lookupFixityRn name
 397   = getModule                           `thenM` \ this_mod ->
 398     if nameIsLocalOrFrom this_mod name
 399     then        -- It's defined in this module
 400         getFixityEnv            `thenM` \ local_fix_env ->
 401         traceRn (text "lookupFixityRn" <+> (ppr name $$ ppr local_fix_env)) `thenM_`
 402         returnM (lookupFixity local_fix_env name)
 403
 404     else        -- It's imported
 405       -- For imported names, we have to get their fixities by doing a
 406       -- loadHomeInterface, and consulting the Ifaces that comes back
 407       -- from that, because the interface file for the Name might not
 408       -- have been loaded yet.  Why not?  Suppose you import module A,
 409       -- which exports a function 'f', thus;
 410       --        module CurrentModule where
 411       --          import A( f )
 412       --        module A( f ) where
 413       --          import B( f )
 414       -- Then B isn't loaded right away (after all, it's possible that
 415       -- nothing from B will be used).  When we come across a use of
 416       -- 'f', we need to know its fixity, and it's then, and only
 417       -- then, that we load B.hi.  That is what's happening here.
 418         loadSrcInterface doc name_mod False     `thenM` \ iface ->
 419         returnM (mi_fix_fn iface (nameOccName name))
 420   where
 421     doc      = ptext SLIT("Checking fixity for") <+> ppr name
 422     name_mod = nameModuleName name
 423
 424 dataTcOccs :: RdrName -> [RdrName]
 425 -- If the input is a data constructor, return both it and a type
 426 -- constructor.  This is useful when we aren't sure which we are
 427 -- looking at.
 428 --
 429 -- ToDo: If the user typed "[]" or "(,,)", we'll generate an Exact RdrName,
 430 --       and we don't have a systematic way to find the TyCon's Name from
 431 --       the DataCon's name.  Sigh
 432 dataTcOccs rdr_name
 433   | isDataOcc occ = [rdr_name_tc, rdr_name]
 434   | otherwise     = [rdr_name]
 435   where
 436     occ         = rdrNameOcc rdr_name
 437     rdr_name_tc = setRdrNameSpace rdr_name tcName
 438 \end{code}
 439
 440 %************************************************************************
 441 %*                                                                      *
 442                         Rebindable names
 443         Dealing with rebindable syntax is driven by the
 444         Opt_NoImplicitPrelude dynamic flag.
 445
 446         In "deriving" code we don't want to use rebindable syntax
 447         so we switch off the flag locally
 448
 449 %*                                                                      *
 450 %************************************************************************
 451
 452 Haskell 98 says that when you say "3" you get the "fromInteger" from the
 453 Standard Prelude, regardless of what is in scope.   However, to experiment
 454 with having a language that is less coupled to the standard prelude, we're
 455 trying a non-standard extension that instead gives you whatever "Prelude.fromInteger"
 456 happens to be in scope.  Then you can
 457         import Prelude ()
 458         import MyPrelude as Prelude
 459 to get the desired effect.
 460
 461 At the moment this just happens for
 462   * fromInteger, fromRational on literals (in expressions and patterns)
 463   * negate (in expressions)
 464   * minus  (arising from n+k patterns)
 465   * "do" notation
 466
 467 We store the relevant Name in the HsSyn tree, in
 468   * HsIntegral/HsFractional
 469   * NegApp
 470   * NPlusKPatIn
 471   * HsDo
 472 respectively.  Initially, we just store the "standard" name (PrelNames.fromIntegralName,
 473 fromRationalName etc), but the renamer changes this to the appropriate user
 474 name if Opt_NoImplicitPrelude is on.  That is what lookupSyntaxName does.
 475
 476 We treat the orignal (standard) names as free-vars too, because the type checker
 477 checks the type of the user thing against the type of the standard thing.
 478
 479 \begin{code}
 480 lookupSyntaxName :: Name                        -- The standard name
 481                  -> RnM (Name, FreeVars)        -- Possibly a non-standard name
 482 lookupSyntaxName std_name
 483   = doptM Opt_NoImplicitPrelude         `thenM` \ no_prelude ->
 484     if not no_prelude then normal_case
 485     else
 486         -- Get the similarly named thing from the local environment
 487     lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
 488     returnM (usr_name, unitFV usr_name)
 489   where
 490     normal_case = returnM (std_name, emptyFVs)
 491
 492 lookupSyntaxNames :: [Name]                             -- Standard names
 493                   -> RnM (ReboundNames Name, FreeVars)  -- See comments with HsExpr.ReboundNames
 494 lookupSyntaxNames std_names
 495   = doptM Opt_NoImplicitPrelude         `thenM` \ no_prelude ->
 496     if not no_prelude then normal_case
 497     else
 498         -- Get the similarly named thing from the local environment
 499     mappM (lookupOccRn . mkRdrUnqual . nameOccName) std_names   `thenM` \ usr_names ->
 500
 501     returnM (std_names `zip` map nlHsVar usr_names, mkFVs usr_names)
 502   where
 503     normal_case = returnM (std_names `zip` map nlHsVar std_names, emptyFVs)
 504 \end{code}
 505
 506
 507 %*********************************************************
 508 %*                                                      *
 509 \subsection{Binding}
 510 %*                                                      *
 511 %*********************************************************
 512
 513 \begin{code}
 514 newLocalsRn :: [Located RdrName] -> RnM [Name]
 515 newLocalsRn rdr_names_w_loc
 516   = newUniqueSupply             `thenM` \ us ->
 517     returnM (zipWith mk rdr_names_w_loc (uniqsFromSupply us))
 518   where
 519     mk (L loc rdr_name) uniq
 520         | Just name <- isExact_maybe rdr_name = name
 521                 -- This happens in code generated by Template Haskell
 522         | otherwise = ASSERT2( isUnqual rdr_name, ppr rdr_name )
 523                         -- We only bind unqualified names here
 524                         -- lookupRdrEnv doesn't even attempt to look up a qualified RdrName
 525                       mkInternalName uniq (rdrNameOcc rdr_name) (srcSpanStart loc)
 526
 527 bindLocatedLocalsRn :: SDoc     -- Documentation string for error message
 528                     -> [Located RdrName]
 529                     -> ([Name] -> RnM a)
 530                     -> RnM a
 531 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
 532   =     -- Check for duplicate names
 533     checkDupNames doc_str rdr_names_w_loc       `thenM_`
 534
 535         -- Warn about shadowing, but only in source modules
 536     ifOptM Opt_WarnNameShadowing
 537       (checkShadowing doc_str rdr_names_w_loc)  `thenM_`
 538
 539         -- Make fresh Names and extend the environment
 540     newLocalsRn rdr_names_w_loc         `thenM` \ names ->
 541     getLocalRdrEnv                      `thenM` \ local_env ->
 542     setLocalRdrEnv (extendLocalRdrEnv local_env names)
 543                    (enclosed_scope names)
 544
 545
 546 bindLocalNames names enclosed_scope
 547   = getLocalRdrEnv              `thenM` \ name_env ->
 548     setLocalRdrEnv (extendLocalRdrEnv name_env names)
 549                     enclosed_scope
 550
 551 bindLocalNamesFV names enclosed_scope
 552   = bindLocalNames names $
 553     enclosed_scope `thenM` \ (thing, fvs) ->
 554     returnM (thing, delListFromNameSet fvs names)
 555
 556
 557 -------------------------------------
 558         -- binLocalsFVRn is the same as bindLocalsRn
 559         -- except that it deals with free vars
 560 bindLocatedLocalsFV :: SDoc -> [Located RdrName] -> ([Name] -> RnM (a,FreeVars))
 561   -> RnM (a, FreeVars)
 562 bindLocatedLocalsFV doc rdr_names enclosed_scope
 563   = bindLocatedLocalsRn doc rdr_names   $ \ names ->
 564     enclosed_scope names                `thenM` \ (thing, fvs) ->
 565     returnM (thing, delListFromNameSet fvs names)
 566
 567 -------------------------------------
 568 extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
 569         -- This tiresome function is used only in rnSourceDecl on InstDecl
 570 extendTyVarEnvFVRn tyvars enclosed_scope
 571   = bindLocalNames tyvars enclosed_scope        `thenM` \ (thing, fvs) ->
 572     returnM (thing, delListFromNameSet fvs tyvars)
 573
 574 bindTyVarsRn :: SDoc -> [LHsTyVarBndr RdrName]
 575               -> ([LHsTyVarBndr Name] -> RnM a)
 576               -> RnM a
 577 bindTyVarsRn doc_str tyvar_names enclosed_scope
 578   = let
 579         located_tyvars = [L loc (hsTyVarName tv) | L loc tv <- tyvar_names]
 580     in
 581     bindLocatedLocalsRn doc_str located_tyvars  $ \ names ->
 582     enclosed_scope (zipWith replace tyvar_names names)
 583     where
 584         replace (L loc n1) n2 = L loc (replaceTyVarName n1 n2)
 585
 586 bindPatSigTyVars :: [LHsType RdrName] -> ([Name] -> RnM a) -> RnM a
 587   -- Find the type variables in the pattern type
 588   -- signatures that must be brought into scope
 589 bindPatSigTyVars tys thing_inside
 590   = getLocalRdrEnv              `thenM` \ name_env ->
 591     let
 592         located_tyvars  = nubBy eqLocated [ tv | ty <- tys,
 593                                     tv <- extractHsTyRdrTyVars ty,
 594                                     not (unLoc tv `elemLocalRdrEnv` name_env)
 595                          ]
 596                 -- The 'nub' is important.  For example:
 597                 --      f (x :: t) (y :: t) = ....
 598                 -- We don't want to complain about binding t twice!
 599
 600         doc_sig        = text "In a pattern type-signature"
 601     in
 602     bindLocatedLocalsRn doc_sig located_tyvars thing_inside
 603
 604 bindPatSigTyVarsFV :: [LHsType RdrName]
 605                    -> RnM (a, FreeVars)
 606                    -> RnM (a, FreeVars)
 607 bindPatSigTyVarsFV tys thing_inside
 608   = bindPatSigTyVars tys        $ \ tvs ->
 609     thing_inside                `thenM` \ (result,fvs) ->
 610     returnM (result, fvs `delListFromNameSet` tvs)
 611
 612 -------------------------------------
 613 checkDupNames :: SDoc
 614               -> [Located RdrName]
 615               -> RnM ()
 616 checkDupNames doc_str rdr_names_w_loc
 617   =     -- Check for duplicated names in a binding group
 618     mappM_ (dupNamesErr doc_str) dups
 619   where
 620     (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc
 621
 622 -------------------------------------
 623 checkShadowing doc_str loc_rdr_names
 624   = getLocalRdrEnv              `thenM` \ local_env ->
 625     getGlobalRdrEnv             `thenM` \ global_env ->
 626     let
 627       check_shadow (L loc rdr_name)
 628         |  rdr_name `elemLocalRdrEnv` local_env
 629         || not (null (lookupGRE_RdrName rdr_name global_env ))
 630         = addSrcSpan loc $ addWarn (shadowedNameWarn doc_str rdr_name)
 631         | otherwise = returnM ()
 632     in
 633     mappM_ check_shadow loc_rdr_names
 634 \end{code}
 635
 636
 637 %************************************************************************
 638 %*                                                                      *
 639 \subsection{Free variable manipulation}
 640 %*                                                                      *
 641 %************************************************************************
 642
 643 \begin{code}
 644 -- A useful utility
 645 mapFvRn f xs = mappM f xs       `thenM` \ stuff ->
 646                let
 647                   (ys, fvs_s) = unzip stuff
 648                in
 649                returnM (ys, plusFVs fvs_s)
 650 \end{code}
 651
 652
 653 %************************************************************************
 654 %*                                                                      *
 655 \subsection{Envt utility functions}
 656 %*                                                                      *
 657 %************************************************************************
 658
 659 \begin{code}
 660 warnUnusedModules :: [ModuleName] -> RnM ()
 661 warnUnusedModules mods
 662   = ifOptM Opt_WarnUnusedImports (mappM_ (addWarn . unused_mod) mods)
 663   where
 664     unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
 665                            text "is imported, but nothing from it is used",
 666                          parens (ptext SLIT("except perhaps instances visible in") <+>
 667                                    quotes (ppr m))]
 668
 669 warnUnusedImports, warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
 670 warnUnusedImports gres  = ifOptM Opt_WarnUnusedImports (warnUnusedGREs gres)
 671 warnUnusedTopBinds gres = ifOptM Opt_WarnUnusedBinds   (warnUnusedGREs gres)
 672
 673 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM ()
 674 warnUnusedLocalBinds names = ifOptM Opt_WarnUnusedBinds   (warnUnusedLocals names)
 675 warnUnusedMatches    names = ifOptM Opt_WarnUnusedMatches (warnUnusedLocals names)
 676
 677 -------------------------
 678 --      Helpers
 679 warnUnusedGREs gres
 680  = warnUnusedBinds [(n,Just p) | GRE {gre_name = n, gre_prov = p} <- gres]
 681
 682 warnUnusedLocals names
 683  = warnUnusedBinds [(n,Nothing) | n<-names]
 684
 685 warnUnusedBinds :: [(Name,Maybe Provenance)] -> RnM ()
 686 warnUnusedBinds names  = mappM_ warnUnusedName (filter reportable names)
 687  where reportable (name,_) = reportIfUnused (nameOccName name)
 688
 689 -------------------------
 690
 691 warnUnusedName :: (Name, Maybe Provenance) -> RnM ()
 692 warnUnusedName (name, prov)
 693   = addWarnAt loc (sep [msg <> colon, nest 4 (ppr name)])
 694         -- TODO should be a proper span
 695   where
 696     (loc,msg) = case prov of
 697                   Just (Imported is _) ->
 698                      ( is_loc (head is), imp_from (is_mod imp_spec) )
 699                      where
 700                          imp_spec = head is
 701                   other ->
 702                      ( srcLocSpan (nameSrcLoc name), unused_msg )
 703
 704     unused_msg   = text "Defined but not used"
 705     imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"
 706 \end{code}
 707
 708 \begin{code}
 709 addNameClashErrRn rdr_name (np1:nps)
 710   = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
 711                   ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
 712   where
 713     msg1 = ptext  SLIT("either") <+> mk_ref np1
 714     msgs = [ptext SLIT("    or") <+> mk_ref np | np <- nps]
 715     mk_ref gre = quotes (ppr (gre_name gre)) <> comma <+> pprNameProvenance gre
 716
 717 shadowedNameWarn doc shadow
 718   = hsep [ptext SLIT("This binding for"),
 719                quotes (ppr shadow),
 720                ptext SLIT("shadows an existing binding")]
 721     $$ doc
 722
 723 unknownNameErr name
 724   = sep [ptext SLIT("Not in scope:"), text flavour <+> quotes (ppr name)]
 725   where
 726     flavour = occNameFlavour (rdrNameOcc name)
 727
 728 unknownInstBndrErr cls op
 729   = quotes (ppr op) <+> ptext SLIT("is not a (visible) method of class") <+> quotes (ppr cls)
 730
 731 badOrigBinding name
 732   = ptext SLIT("Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
 733         -- The rdrNameOcc is because we don't want to print Prelude.(,)
 734
 735 dupNamesErr descriptor (L loc name : dup_things)
 736   = addSrcSpan loc $
 737     addErr ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
 738               $$
 739               descriptor)
 740 \end{code}