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