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