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,
  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 just to catch the PrelBase defn of (say) [] and similar
 128         -- The parser reads the special syntax and returns an Exact RdrName
 129         -- But the global_env contains only Qual RdrNames, so we won't
 130         -- find it there; instead just get the name via the Orig route
 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 (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)]
 496             -> RnM [Name]
 497 newLocalsRn rdr_names_w_loc
 498  =  newUniqueSupply             `thenM` \ us ->
 499     let
 500         uniqs      = uniqsFromSupply us
 501         names      = [ mkInternalName uniq (rdrNameOcc rdr_name) loc
 502                      | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
 503                      ]
 504     in
 505     returnM names
 506
 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   = ASSERT2( all (isUnqual . fst) rdr_names_w_loc, ppr rdr_names_w_loc )
 514         -- We only bind unqualified names here
 515         -- lookupRdrEnv doesn't even attempt to look up a qualified RdrName
 516
 517         -- Check for duplicate names
 518     checkDupNames doc_str rdr_names_w_loc       `thenM_`
 519
 520         -- Warn about shadowing, but only in source modules
 521     ifOptM Opt_WarnNameShadowing
 522       (checkShadowing doc_str rdr_names_w_loc)  `thenM_`
 523
 524         -- Make fresh Names and extend the environment
 525     newLocalsRn rdr_names_w_loc         `thenM` \ names ->
 526     getLocalRdrEnv                      `thenM` \ local_env ->
 527     setLocalRdrEnv (extendLocalRdrEnv local_env names)
 528                    (enclosed_scope names)
 529
 530
 531 bindLocalNames names enclosed_scope
 532   = getLocalRdrEnv              `thenM` \ name_env ->
 533     setLocalRdrEnv (extendLocalRdrEnv name_env names)
 534                     enclosed_scope
 535
 536 bindLocalNamesFV names enclosed_scope
 537   = bindLocalNames names $
 538     enclosed_scope `thenM` \ (thing, fvs) ->
 539     returnM (thing, delListFromNameSet fvs names)
 540
 541
 542 -------------------------------------
 543 bindLocalsRn doc rdr_names enclosed_scope
 544   = getSrcLocM          `thenM` \ loc ->
 545     bindLocatedLocalsRn doc
 546                         (rdr_names `zip` repeat loc)
 547                         enclosed_scope
 548
 549         -- binLocalsFVRn is the same as bindLocalsRn
 550         -- except that it deals with free vars
 551 bindLocalsFV doc rdr_names enclosed_scope
 552   = bindLocalsRn doc rdr_names          $ \ names ->
 553     enclosed_scope names                `thenM` \ (thing, fvs) ->
 554     returnM (thing, delListFromNameSet fvs names)
 555
 556 -------------------------------------
 557 extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
 558         -- This tiresome function is used only in rnSourceDecl on InstDecl
 559 extendTyVarEnvFVRn tyvars enclosed_scope
 560   = bindLocalNames tyvars enclosed_scope        `thenM` \ (thing, fvs) ->
 561     returnM (thing, delListFromNameSet fvs tyvars)
 562
 563 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
 564               -> ([HsTyVarBndr Name] -> RnM a)
 565               -> RnM a
 566 bindTyVarsRn doc_str tyvar_names enclosed_scope
 567   = getSrcLocM                                  `thenM` \ loc ->
 568     let
 569         located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
 570     in
 571     bindLocatedLocalsRn doc_str located_tyvars  $ \ names ->
 572     enclosed_scope (zipWith replaceTyVarName tyvar_names names)
 573
 574 bindPatSigTyVars :: [RdrNameHsType] -> ([Name] -> RnM a) -> RnM a
 575   -- Find the type variables in the pattern type
 576   -- signatures that must be brought into scope
 577
 578 bindPatSigTyVars tys thing_inside
 579   = getLocalRdrEnv              `thenM` \ name_env ->
 580     getSrcLocM                  `thenM` \ loc ->
 581     let
 582         forall_tyvars  = nub [ tv | ty <- tys,
 583                                     tv <- extractHsTyRdrTyVars ty,
 584                                     not (tv `elemLocalRdrEnv` name_env)
 585                          ]
 586                 -- The 'nub' is important.  For example:
 587                 --      f (x :: t) (y :: t) = ....
 588                 -- We don't want to complain about binding t twice!
 589
 590         located_tyvars = [(tv, loc) | tv <- forall_tyvars]
 591         doc_sig        = text "In a pattern type-signature"
 592     in
 593     bindLocatedLocalsRn doc_sig located_tyvars thing_inside
 594
 595 bindPatSigTyVarsFV :: [RdrNameHsType]
 596                    -> RnM (a, FreeVars)
 597                    -> RnM (a, FreeVars)
 598 bindPatSigTyVarsFV tys thing_inside
 599   = bindPatSigTyVars tys        $ \ tvs ->
 600     thing_inside                `thenM` \ (result,fvs) ->
 601     returnM (result, fvs `delListFromNameSet` tvs)
 602
 603 -------------------------------------
 604 checkDupNames :: SDoc
 605               -> [(RdrName, SrcLoc)]
 606               -> RnM ()
 607 checkDupNames doc_str rdr_names_w_loc
 608   =     -- Check for duplicated names in a binding group
 609     mappM_ (dupNamesErr doc_str) dups
 610   where
 611     (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
 612
 613 -------------------------------------
 614 checkShadowing doc_str rdr_names_w_loc
 615   = getLocalRdrEnv              `thenM` \ local_env ->
 616     getGlobalRdrEnv             `thenM` \ global_env ->
 617     let
 618       check_shadow (rdr_name,loc)
 619         |  rdr_name `elemLocalRdrEnv` local_env
 620         || not (null (lookupGRE_RdrName rdr_name global_env ))
 621         = addSrcLoc loc $ addWarn (shadowedNameWarn doc_str rdr_name)
 622         | otherwise = returnM ()
 623     in
 624     mappM_ check_shadow rdr_names_w_loc
 625 \end{code}
 626
 627
 628 %************************************************************************
 629 %*                                                                      *
 630 \subsection{Free variable manipulation}
 631 %*                                                                      *
 632 %************************************************************************
 633
 634 \begin{code}
 635 -- A useful utility
 636 mapFvRn f xs = mappM f xs       `thenM` \ stuff ->
 637                let
 638                   (ys, fvs_s) = unzip stuff
 639                in
 640                returnM (ys, plusFVs fvs_s)
 641 \end{code}
 642
 643
 644 %************************************************************************
 645 %*                                                                      *
 646 \subsection{Envt utility functions}
 647 %*                                                                      *
 648 %************************************************************************
 649
 650 \begin{code}
 651 warnUnusedModules :: [ModuleName] -> RnM ()
 652 warnUnusedModules mods
 653   = ifOptM Opt_WarnUnusedImports (mappM_ (addWarn . unused_mod) mods)
 654   where
 655     unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
 656                            text "is imported, but nothing from it is used",
 657                          parens (ptext SLIT("except perhaps instances visible in") <+>
 658                                    quotes (ppr m))]
 659
 660 warnUnusedImports, warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
 661 warnUnusedImports gres  = ifOptM Opt_WarnUnusedImports (warnUnusedGREs gres)
 662 warnUnusedTopBinds gres = ifOptM Opt_WarnUnusedBinds   (warnUnusedGREs gres)
 663
 664 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM ()
 665 warnUnusedLocalBinds names = ifOptM Opt_WarnUnusedBinds   (warnUnusedLocals names)
 666 warnUnusedMatches    names = ifOptM Opt_WarnUnusedMatches (warnUnusedLocals names)
 667
 668 -------------------------
 669 --      Helpers
 670 warnUnusedGREs   gres  = warnUnusedBinds [(n,Just p) | GRE {gre_name = n, gre_prov = p} <- gres]
 671 warnUnusedLocals names = warnUnusedBinds [(n,Nothing) | n<-names]
 672
 673 warnUnusedBinds :: [(Name,Maybe Provenance)] -> RnM ()
 674 warnUnusedBinds names
 675   = mappM_ warnUnusedGroup groups
 676   where
 677         -- Group by provenance
 678    groups = equivClasses cmp (filter reportable names)
 679    (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
 680
 681    reportable (name,_) = reportIfUnused (nameOccName name)
 682
 683
 684 -------------------------
 685
 686 warnUnusedGroup :: [(Name,Maybe Provenance)] -> RnM ()
 687 warnUnusedGroup names
 688   = addSrcLoc def_loc   $
 689     addWarn             $
 690     sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) names)))]
 691   where
 692     (name1, prov1) = head names
 693     loc1           = nameSrcLoc name1
 694     (def_loc, msg) = case prov1 of
 695                         Just (Imported is _) -> (is_loc imp_spec, imp_from (is_mod imp_spec))
 696                                       where
 697                                          imp_spec = head is
 698                         other -> (loc1, unused_msg)
 699
 700     unused_msg   = text "Defined but not used"
 701     imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"
 702 \end{code}
 703
 704 \begin{code}
 705 addNameClashErrRn rdr_name (np1:nps)
 706   = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
 707                   ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
 708   where
 709     msg1 = ptext  SLIT("either") <+> mk_ref np1
 710     msgs = [ptext SLIT("    or") <+> mk_ref np | np <- nps]
 711     mk_ref gre = quotes (ppr (gre_name gre)) <> comma <+> pprNameProvenance gre
 712
 713 shadowedNameWarn doc shadow
 714   = hsep [ptext SLIT("This binding for"),
 715                quotes (ppr shadow),
 716                ptext SLIT("shadows an existing binding")]
 717     $$ doc
 718
 719 unknownNameErr name
 720   = sep [text flavour <+> ptext SLIT("not in scope:"), quotes (ppr name)]
 721   where
 722     flavour = occNameFlavour (rdrNameOcc name)
 723
 724 unknownInstBndrErr cls op
 725   = quotes (ppr op) <+> ptext SLIT("is not a (visible) method of class") <+> quotes (ppr cls)
 726
 727 badOrigBinding name
 728   = ptext SLIT("Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
 729         -- The rdrNameOcc is because we don't want to print Prelude.(,)
 730
 731 dupNamesErr descriptor ((name,loc) : dup_things)
 732   = addSrcLoc loc $
 733     addErr ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
 734               $$
 735               descriptor)
 736 warnDeprec :: GlobalRdrElt -> RnM ()
 737 warnDeprec (GRE {gre_name = name, gre_deprec = Just txt})
 738   = ifOptM Opt_WarnDeprecations $
 739     addWarn (sep [ text (occNameFlavour (nameOccName name)) <+>
 740                      quotes (ppr name) <+> text "is deprecated:",
 741                      nest 4 (ppr txt) ])
 742 \end{code}