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