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