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 where              -- Export everything
   8
   9 #include "HsVersions.h"
  10
  11 import {-# SOURCE #-} RnHiFiles
  12
  13 import HsSyn
  14 import RdrHsSyn         ( RdrNameIE, RdrNameHsType, extractHsTyRdrTyVars )
  15 import RdrName          ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
  16                           mkRdrUnqual, mkRdrQual,
  17                           lookupRdrEnv, foldRdrEnv, rdrEnvToList, elemRdrEnv,
  18                           unqualifyRdrName
  19                         )
  20 import HsTypes          ( hsTyVarName, replaceTyVarName )
  21 import HscTypes         ( Provenance(..), pprNameProvenance, hasBetterProv,
  22                           ImportReason(..), GlobalRdrEnv, GlobalRdrElt(..), AvailEnv,
  23                           AvailInfo, Avails, GenAvailInfo(..), NameSupply(..),
  24                           ModIface(..),
  25                           Deprecations(..), lookupDeprec,
  26                           extendLocalRdrEnv
  27                         )
  28 import RnMonad
  29 import Name             ( Name,
  30                           getSrcLoc, nameIsLocalOrFrom,
  31                           mkLocalName, mkGlobalName,
  32                           mkIPName, nameOccName, nameModule_maybe,
  33                           setNameModuleAndLoc
  34                         )
  35 import NameEnv
  36 import NameSet
  37 import OccName          ( OccName, occNameUserString, occNameFlavour )
  38 import Module           ( ModuleName, moduleName, mkVanillaModule,
  39                           mkSysModuleNameFS, moduleNameFS, WhereFrom(..) )
  40 import PrelNames        ( mkUnboundName,
  41                           derivingOccurrences,
  42                           mAIN_Name, pREL_MAIN_Name,
  43                           ioTyConName, intTyConName,
  44                           boolTyConName, funTyConName,
  45                           unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
  46                           eqStringName, printName,
  47                           bindIOName, returnIOName, failIOName
  48                         )
  49 import TysWiredIn       ( unitTyCon )   -- A little odd
  50 import FiniteMap
  51 import UniqSupply
  52 import SrcLoc           ( SrcLoc, noSrcLoc )
  53 import Outputable
  54 import ListSetOps       ( removeDups, equivClasses )
  55 import Util             ( sortLt )
  56 import List             ( nub )
  57 import UniqFM           ( lookupWithDefaultUFM )
  58 import CmdLineOpts
  59 import FastString       ( FastString )
  60
  61 import Maybe            ( isJust )
  62 \end{code}
  63
  64 %*********************************************************
  65 %*                                                      *
  66 \subsection{Making new names}
  67 %*                                                      *
  68 %*********************************************************
  69
  70 \begin{code}
  71 newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
  72         -- newTopBinder puts into the cache the binder with the
  73         -- module information set correctly.  When the decl is later renamed,
  74         -- the binding site will thereby get the correct module.
  75         -- There maybe occurrences that don't have the correct Module, but
  76         -- by the typechecker will propagate the binding definition to all
  77         -- the occurrences, so that doesn't matter
  78
  79 newTopBinder mod rdr_name loc
  80   =     -- First check the cache
  81
  82         -- There should never be a qualified name in a binding position (except in instance decls)
  83         -- The parser doesn't check this because the same parser parses instance decls
  84     (if isQual rdr_name then
  85         qualNameErr (text "In its declaration") (rdr_name,loc)
  86      else
  87         returnRn ()
  88     )                           `thenRn_`
  89
  90     getNameSupplyRn             `thenRn` \ name_supply ->
  91     let
  92         occ = rdrNameOcc rdr_name
  93         key = (moduleName mod, occ)
  94         cache = nsNames name_supply
  95     in
  96     case lookupFM cache key of
  97
  98         -- A hit in the cache!  We are at the binding site of the name, and
  99         -- this is the moment when we know all about
 100         --      a) the Name's host Module (in particular, which
 101         --         package it comes from)
 102         --      b) its defining SrcLoc
 103         -- So we update this info
 104
 105         Just name -> let
 106                         new_name  = setNameModuleAndLoc name mod loc
 107                         new_cache = addToFM cache key new_name
 108                      in
 109                      setNameSupplyRn (name_supply {nsNames = new_cache})        `thenRn_`
 110 --                   traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
 111                      returnRn new_name
 112
 113         -- Miss in the cache!
 114         -- Build a completely new Name, and put it in the cache
 115         -- Even for locally-defined names we use implicitImportProvenance;
 116         -- updateProvenances will set it to rights
 117         Nothing -> let
 118                         (us', us1) = splitUniqSupply (nsUniqs name_supply)
 119                         uniq       = uniqFromSupply us1
 120                         new_name   = mkGlobalName uniq mod occ loc
 121                         new_cache  = addToFM cache key new_name
 122                    in
 123                    setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache})   `thenRn_`
 124 --                 traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
 125                    returnRn new_name
 126
 127
 128 newGlobalName :: ModuleName -> OccName -> RnM d Name
 129   -- Used for *occurrences*.  We make a place-holder Name, really just
 130   -- to agree on its unique, which gets overwritten when we read in
 131   -- the binding occurence later (newTopBinder)
 132   -- The place-holder Name doesn't have the right SrcLoc, and its
 133   -- Module won't have the right Package either.
 134   --
 135   -- (We have to pass a ModuleName, not a Module, because we may be
 136   -- simply looking at an occurrence M.x in an interface file.)
 137   --
 138   -- This means that a renamed program may have incorrect info
 139   -- on implicitly-imported occurrences, but the correct info on the
 140   -- *binding* declaration. It's the type checker that propagates the
 141   -- correct information to all the occurrences.
 142   -- Since implicitly-imported names never occur in error messages,
 143   -- it doesn't matter that we get the correct info in place till later,
 144   -- (but since it affects DLL-ery it does matter that we get it right
 145   --  in the end).
 146 newGlobalName mod_name occ
 147   = getNameSupplyRn             `thenRn` \ name_supply ->
 148     let
 149         key = (mod_name, occ)
 150         cache = nsNames name_supply
 151     in
 152     case lookupFM cache key of
 153         Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
 154                      returnRn name
 155
 156         Nothing   -> setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache})  `thenRn_`
 157                      -- traceRn (text "newGlobalName: new" <+> ppr name)                  `thenRn_`
 158                      returnRn name
 159                   where
 160                      (us', us1) = splitUniqSupply (nsUniqs name_supply)
 161                      uniq       = uniqFromSupply us1
 162                      mod        = mkVanillaModule mod_name
 163                      name       = mkGlobalName uniq mod occ noSrcLoc
 164                      new_cache  = addToFM cache key name
 165
 166 newIPName rdr_name
 167   = getNameSupplyRn             `thenRn` \ name_supply ->
 168     let
 169         ipcache = nsIPs name_supply
 170     in
 171     case lookupFM ipcache key of
 172         Just name -> returnRn name
 173         Nothing   -> setNameSupplyRn (name_supply {nsUniqs = us', nsIPs = new_ipcache}) `thenRn_`
 174                      returnRn name
 175                   where
 176                      (us', us1)  = splitUniqSupply (nsUniqs name_supply)
 177                      uniq        = uniqFromSupply us1
 178                      name        = mkIPName uniq key
 179                      new_ipcache = addToFM ipcache key name
 180     where key = (rdrNameOcc rdr_name)
 181 \end{code}
 182
 183 %*********************************************************
 184 %*                                                      *
 185 \subsection{Looking up names}
 186 %*                                                      *
 187 %*********************************************************
 188
 189 Looking up a name in the RnEnv.
 190
 191 \begin{code}
 192 lookupBndrRn rdr_name
 193   = getLocalNameEnv             `thenRn` \ local_env ->
 194     case lookupRdrEnv local_env rdr_name of
 195           Just name -> returnRn name
 196           Nothing   -> lookupTopBndrRn rdr_name
 197
 198 lookupTopBndrRn rdr_name
 199 -- Look up a top-level local binder.   We may be looking up an unqualified 'f',
 200 -- and there may be several imported 'f's too, which must not confuse us.
 201 -- So we have to filter out the non-local ones.
 202 -- A separate function (importsFromLocalDecls) reports duplicate top level
 203 -- decls, so here it's safe just to choose an arbitrary one.
 204
 205   | isOrig rdr_name
 206         -- This is here just to catch the PrelBase defn of (say) [] and similar
 207         -- The parser reads the special syntax and returns an Orig RdrName
 208         -- But the global_env contains only Qual RdrNames, so we won't
 209         -- find it there; instead just get the name via the Orig route
 210   = lookupOrigName rdr_name
 211
 212   | otherwise
 213   = getModeRn   `thenRn` \ mode ->
 214     if isInterfaceMode mode
 215         then lookupIfaceName rdr_name
 216     else
 217     getModuleRn         `thenRn` \ mod ->
 218     getGlobalNameEnv    `thenRn` \ global_env ->
 219     case lookup_local mod global_env rdr_name of
 220         Just name -> returnRn name
 221         Nothing   -> failWithRn (mkUnboundName rdr_name)
 222                                 (unknownNameErr rdr_name)
 223   where
 224     lookup_local mod global_env rdr_name
 225       = case lookupRdrEnv global_env rdr_name of
 226           Nothing   -> Nothing
 227           Just gres -> case [n | GRE n _ _ <- gres, nameIsLocalOrFrom mod n] of
 228                          []     -> Nothing
 229                          (n:ns) -> Just n
 230
 231
 232 -- lookupSigOccRn is used for type signatures and pragmas
 233 -- Is this valid?
 234 --   module A
 235 --      import M( f )
 236 --      f :: Int -> Int
 237 --      f x = x
 238 -- It's clear that the 'f' in the signature must refer to A.f
 239 -- The Haskell98 report does not stipulate this, but it will!
 240 -- So we must treat the 'f' in the signature in the same way
 241 -- as the binding occurrence of 'f', using lookupBndrRn
 242 lookupSigOccRn :: RdrName -> RnMS Name
 243 lookupSigOccRn = lookupBndrRn
 244
 245 -- lookupOccRn looks up an occurrence of a RdrName
 246 lookupOccRn :: RdrName -> RnMS Name
 247 lookupOccRn rdr_name
 248   = getLocalNameEnv                     `thenRn` \ local_env ->
 249     case lookupRdrEnv local_env rdr_name of
 250           Just name -> returnRn name
 251           Nothing   -> lookupGlobalOccRn rdr_name
 252
 253 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
 254 -- environment.  It's used only for
 255 --      record field names
 256 --      class op names in class and instance decls
 257
 258 lookupGlobalOccRn rdr_name
 259   = getModeRn           `thenRn` \ mode ->
 260     if (isInterfaceMode mode)
 261         then lookupIfaceName rdr_name
 262         else
 263
 264     getGlobalNameEnv    `thenRn` \ global_env ->
 265     case mode of
 266         SourceMode -> lookupSrcName global_env rdr_name
 267
 268         CmdLineMode
 269          | not (isQual rdr_name) ->
 270                 lookupSrcName global_env rdr_name
 271
 272                 -- We allow qualified names on the command line to refer to
 273                 -- *any* name exported by any module in scope, just as if
 274                 -- there was an "import qualified M" declaration for every
 275                 -- module.
 276                 --
 277                 -- First look up the name in the normal environment.  If
 278                 -- it isn't there, we manufacture a new occurrence of an
 279                 -- original name.
 280          | otherwise ->
 281                 case lookupRdrEnv global_env rdr_name of
 282                        Just _  -> lookupSrcName global_env rdr_name
 283                        Nothing -> lookupQualifiedName rdr_name
 284
 285 -- a qualified name on the command line can refer to any module at all: we
 286 -- try to load the interface if we don't already have it.
 287 lookupQualifiedName :: RdrName -> RnM d Name
 288 lookupQualifiedName rdr_name
 289  = let
 290        mod = rdrNameModule rdr_name
 291        occ = rdrNameOcc rdr_name
 292    in
 293    loadInterface (ppr rdr_name) mod ImportByUser `thenRn` \ iface ->
 294    case  [ name | (_,avails) <- mi_exports iface,
 295            avail             <- avails,
 296            name              <- availNames avail,
 297            nameOccName name == occ ] of
 298       (n:ns) -> ASSERT (null ns) returnRn n
 299       _      -> failWithRn (mkUnboundName rdr_name) (unknownNameErr rdr_name)
 300
 301 lookupSrcName :: GlobalRdrEnv -> RdrName -> RnM d Name
 302 -- NB: passed GlobalEnv explicitly, not necessarily in RnMS monad
 303 lookupSrcName global_env rdr_name
 304   | isOrig rdr_name     -- Can occur in source code too
 305   = lookupOrigName rdr_name
 306
 307   | otherwise
 308   = case lookupRdrEnv global_env rdr_name of
 309         Just [GRE name _ Nothing]       -> returnRn name
 310         Just [GRE name _ (Just deprec)] -> warnDeprec name deprec       `thenRn_`
 311                                            returnRn name
 312         Just stuff@(GRE name _ _ : _)   -> addNameClashErrRn rdr_name stuff     `thenRn_`
 313                                            returnRn name
 314         Nothing                         -> failWithRn (mkUnboundName rdr_name)
 315                                                       (unknownNameErr rdr_name)
 316
 317 lookupOrigName :: RdrName -> RnM d Name
 318 lookupOrigName rdr_name
 319   = ASSERT( isOrig rdr_name )
 320     newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
 321
 322 lookupIfaceUnqual :: RdrName -> RnM d Name
 323 lookupIfaceUnqual rdr_name
 324   = ASSERT( isUnqual rdr_name )
 325         -- An Unqual is allowed; interface files contain
 326         -- unqualified names for locally-defined things, such as
 327         -- constructors of a data type.
 328     getModuleRn                         `thenRn ` \ mod ->
 329     newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
 330
 331 lookupIfaceName :: RdrName -> RnM d Name
 332 lookupIfaceName rdr_name
 333   | isUnqual rdr_name = lookupIfaceUnqual rdr_name
 334   | otherwise         = lookupOrigName rdr_name
 335 \end{code}
 336
 337 @lookupOrigName@ takes an RdrName representing an {\em original}
 338 name, and adds it to the occurrence pool so that it'll be loaded
 339 later.  This is used when language constructs (such as monad
 340 comprehensions, overloaded literals, or deriving clauses) require some
 341 stuff to be loaded that isn't explicitly mentioned in the code.
 342
 343 This doesn't apply in interface mode, where everything is explicit,
 344 but we don't check for this case: it does no harm to record an
 345 ``extra'' occurrence and @lookupOrigNames@ isn't used much in
 346 interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
 347 calls it at all I think).
 348
 349   \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
 350
 351 \begin{code}
 352 lookupOrigNames :: [RdrName] -> RnM d NameSet
 353 lookupOrigNames rdr_names
 354   = mapRn lookupOrigName rdr_names      `thenRn` \ names ->
 355     returnRn (mkNameSet names)
 356 \end{code}
 357
 358 lookupSysBinder is used for the "system binders" of a type, class, or
 359 instance decl.  It ensures that the module is set correctly in the
 360 name cache, and sets the provenance on the returned name too.  The
 361 returned name will end up actually in the type, class, or instance.
 362
 363 \begin{code}
 364 lookupSysBinder rdr_name
 365   = ASSERT( isUnqual rdr_name )
 366     getModuleRn                         `thenRn` \ mod ->
 367     getSrcLocRn                         `thenRn` \ loc ->
 368     newTopBinder mod rdr_name loc
 369 \end{code}
 370
 371
 372 %*********************************************************
 373 %*                                                      *
 374 \subsection{Implicit free vars and sugar names}
 375 %*                                                      *
 376 %*********************************************************
 377
 378 @getXImplicitFVs@ forces the renamer to slurp in some things which aren't
 379 mentioned explicitly, but which might be needed by the type checker.
 380
 381 \begin{code}
 382 getImplicitStmtFVs      -- Compiling a statement
 383   = returnRn (mkFVs [printName, bindIOName, returnIOName, failIOName]
 384               `plusFV` ubiquitousNames)
 385                 -- These are all needed implicitly when compiling a statement
 386                 -- See TcModule.tc_stmts
 387
 388 getImplicitModuleFVs mod_name decls     -- Compiling a module
 389   = lookupOrigNames deriv_occs          `thenRn` \ deriving_names ->
 390     returnRn (deriving_names `plusFV` implicit_main `plusFV` ubiquitousNames)
 391   where
 392         -- Add occurrences for IO or PrimIO
 393         implicit_main |  mod_name == mAIN_Name
 394                       || mod_name == pREL_MAIN_Name = unitFV ioTyConName
 395                       |  otherwise                  = emptyFVs
 396
 397         deriv_occs = [occ | TyClD (TyData {tcdDerivs = Just deriv_classes}) <- decls,
 398                             cls <- deriv_classes,
 399                             occ <- lookupWithDefaultUFM derivingOccurrences [] cls ]
 400
 401 -- ubiquitous_names are loaded regardless, because
 402 -- they are needed in virtually every program
 403 ubiquitousNames
 404   = mkFVs [unpackCStringName, unpackCStringFoldrName,
 405            unpackCStringUtf8Name, eqStringName]
 406         -- Virtually every program has error messages in it somewhere
 407
 408   `plusFV`
 409     mkFVs [getName unitTyCon, funTyConName, boolTyConName, intTyConName]
 410         -- Add occurrences for very frequently used types.
 411         --       (e.g. we don't want to be bothered with making funTyCon a
 412         --        free var at every function application!)
 413 \end{code}
 414
 415 %************************************************************************
 416 %*                                                                      *
 417 \subsection{Re-bindable desugaring names}
 418 %*                                                                      *
 419 %************************************************************************
 420
 421 Haskell 98 says that when you say "3" you get the "fromInteger" from the
 422 Standard Prelude, regardless of what is in scope.   However, to experiment
 423 with having a language that is less coupled to the standard prelude, we're
 424 trying a non-standard extension that instead gives you whatever "Prelude.fromInteger"
 425 happens to be in scope.  Then you can
 426         import Prelude ()
 427         import MyPrelude as Prelude
 428 to get the desired effect.
 429
 430 At the moment this just happens for
 431   * fromInteger, fromRational on literals (in expressions and patterns)
 432   * negate (in expressions)
 433   * minus  (arising from n+k patterns)
 434
 435 We store the relevant Name in the HsSyn tree, in
 436   * HsIntegral/HsFractional
 437   * NegApp
 438   * NPlusKPatIn
 439 respectively.  Initially, we just store the "standard" name (PrelNames.fromIntegralName,
 440 fromRationalName etc), but the renamer changes this to the appropriate user
 441 name if Opt_NoImplicitPrelude is on.  That is what lookupSyntaxName does.
 442
 443 \begin{code}
 444 lookupSyntaxName :: Name        -- The standard name
 445                  -> RnMS Name   -- Possibly a non-standard name
 446 lookupSyntaxName std_name
 447   = doptRn Opt_NoImplicitPrelude        `thenRn` \ no_prelude ->
 448     if not no_prelude then
 449         returnRn std_name       -- Normal case
 450     else
 451     let
 452         rdr_name = mkRdrUnqual (nameOccName std_name)
 453         -- Get the similarly named thing from the local environment
 454     in
 455     lookupOccRn rdr_name
 456 \end{code}
 457
 458
 459 %*********************************************************
 460 %*                                                      *
 461 \subsection{Binding}
 462 %*                                                      *
 463 %*********************************************************
 464
 465 \begin{code}
 466 newLocalsRn :: [(RdrName,SrcLoc)]
 467             -> RnMS [Name]
 468 newLocalsRn rdr_names_w_loc
 469  =  getNameSupplyRn             `thenRn` \ name_supply ->
 470     let
 471         (us', us1) = splitUniqSupply (nsUniqs name_supply)
 472         uniqs      = uniqsFromSupply us1
 473         names      = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
 474                      | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
 475                      ]
 476     in
 477     setNameSupplyRn (name_supply {nsUniqs = us'})       `thenRn_`
 478     returnRn names
 479
 480
 481 bindLocatedLocalsRn :: SDoc     -- Documentation string for error message
 482                     -> [(RdrName,SrcLoc)]
 483                     -> ([Name] -> RnMS a)
 484                     -> RnMS a
 485 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
 486   = getModeRn                           `thenRn` \ mode ->
 487     getLocalNameEnv                     `thenRn` \ local_env ->
 488     getGlobalNameEnv                    `thenRn` \ global_env ->
 489
 490         -- Check for duplicate names
 491     checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
 492
 493         -- Warn about shadowing, but only in source modules
 494     let
 495       check_shadow (rdr_name,loc)
 496         |  rdr_name `elemRdrEnv` local_env
 497         || rdr_name `elemRdrEnv` global_env
 498         = pushSrcLocRn loc $ addWarnRn (shadowedNameWarn rdr_name)
 499         | otherwise
 500         = returnRn ()
 501     in
 502
 503     (case mode of
 504         SourceMode -> ifOptRn Opt_WarnNameShadowing     $
 505                       mapRn_ check_shadow rdr_names_w_loc
 506         other      -> returnRn ()
 507     )                                   `thenRn_`
 508
 509     newLocalsRn rdr_names_w_loc         `thenRn` \ names ->
 510     let
 511         new_local_env = addListToRdrEnv local_env (map fst rdr_names_w_loc `zip` names)
 512     in
 513     setLocalNameEnv new_local_env (enclosed_scope names)
 514
 515 bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
 516   -- A specialised variant when renaming stuff from interface
 517   -- files (of which there is a lot)
 518   --    * one at a time
 519   --    * no checks for shadowing
 520   --    * always imported
 521   --    * deal with free vars
 522 bindCoreLocalRn rdr_name enclosed_scope
 523   = getSrcLocRn                 `thenRn` \ loc ->
 524     getLocalNameEnv             `thenRn` \ name_env ->
 525     getNameSupplyRn             `thenRn` \ name_supply ->
 526     let
 527         (us', us1) = splitUniqSupply (nsUniqs name_supply)
 528         uniq       = uniqFromSupply us1
 529         name       = mkLocalName uniq (rdrNameOcc rdr_name) loc
 530     in
 531     setNameSupplyRn (name_supply {nsUniqs = us'})       `thenRn_`
 532     let
 533         new_name_env = extendRdrEnv name_env rdr_name name
 534     in
 535     setLocalNameEnv new_name_env (enclosed_scope name)
 536
 537 bindCoreLocalsRn []     thing_inside = thing_inside []
 538 bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b        $ \ name' ->
 539                                        bindCoreLocalsRn bs      $ \ names' ->
 540                                        thing_inside (name':names')
 541
 542 bindLocalNames names enclosed_scope
 543   = getLocalNameEnv             `thenRn` \ name_env ->
 544     setLocalNameEnv (extendLocalRdrEnv name_env names)
 545                     enclosed_scope
 546
 547 bindLocalNamesFV names enclosed_scope
 548   = bindLocalNames names $
 549     enclosed_scope `thenRn` \ (thing, fvs) ->
 550     returnRn (thing, delListFromNameSet fvs names)
 551
 552
 553 -------------------------------------
 554 bindLocalRn doc rdr_name enclosed_scope
 555   = getSrcLocRn                                 `thenRn` \ loc ->
 556     bindLocatedLocalsRn doc [(rdr_name,loc)]    $ \ (n:ns) ->
 557     ASSERT( null ns )
 558     enclosed_scope n
 559
 560 bindLocalsRn doc rdr_names enclosed_scope
 561   = getSrcLocRn         `thenRn` \ loc ->
 562     bindLocatedLocalsRn doc
 563                         (rdr_names `zip` repeat loc)
 564                         enclosed_scope
 565
 566         -- binLocalsFVRn is the same as bindLocalsRn
 567         -- except that it deals with free vars
 568 bindLocalsFVRn doc rdr_names enclosed_scope
 569   = bindLocalsRn doc rdr_names          $ \ names ->
 570     enclosed_scope names                `thenRn` \ (thing, fvs) ->
 571     returnRn (thing, delListFromNameSet fvs names)
 572
 573 -------------------------------------
 574 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
 575         -- This tiresome function is used only in rnSourceDecl on InstDecl
 576 extendTyVarEnvFVRn tyvars enclosed_scope
 577   = bindLocalNames tyvars enclosed_scope        `thenRn` \ (thing, fvs) ->
 578     returnRn (thing, delListFromNameSet fvs tyvars)
 579
 580 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
 581               -> ([HsTyVarBndr Name] -> RnMS a)
 582               -> RnMS a
 583 bindTyVarsRn doc_str tyvar_names enclosed_scope
 584   = bindTyVars2Rn doc_str tyvar_names   $ \ names tyvars ->
 585     enclosed_scope tyvars
 586
 587 -- Gruesome name: return Names as well as HsTyVars
 588 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
 589               -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
 590               -> RnMS a
 591 bindTyVars2Rn doc_str tyvar_names enclosed_scope
 592   = getSrcLocRn                                 `thenRn` \ loc ->
 593     let
 594         located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
 595     in
 596     bindLocatedLocalsRn doc_str located_tyvars  $ \ names ->
 597     enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
 598
 599 bindPatSigTyVars :: [RdrNameHsType]
 600                  -> RnMS (a, FreeVars)
 601                  -> RnMS (a, FreeVars)
 602   -- Find the type variables in the pattern type
 603   -- signatures that must be brought into scope
 604
 605 bindPatSigTyVars tys enclosed_scope
 606   = getLocalNameEnv                     `thenRn` \ name_env ->
 607     getSrcLocRn                         `thenRn` \ loc ->
 608     let
 609         forall_tyvars  = nub [ tv | ty <- tys,
 610                                     tv <- extractHsTyRdrTyVars ty,
 611                                     not (tv `elemFM` name_env)
 612                          ]
 613                 -- The 'nub' is important.  For example:
 614                 --      f (x :: t) (y :: t) = ....
 615                 -- We don't want to complain about binding t twice!
 616
 617         located_tyvars = [(tv, loc) | tv <- forall_tyvars]
 618         doc_sig        = text "In a pattern type-signature"
 619     in
 620     bindLocatedLocalsRn doc_sig located_tyvars  $ \ names ->
 621     enclosed_scope                              `thenRn` \ (thing, fvs) ->
 622     returnRn (thing, delListFromNameSet fvs names)
 623
 624
 625 -------------------------------------
 626 checkDupOrQualNames, checkDupNames :: SDoc
 627                                    -> [(RdrName, SrcLoc)]
 628                                    -> RnM d ()
 629         -- Works in any variant of the renamer monad
 630
 631 checkDupOrQualNames doc_str rdr_names_w_loc
 632   =     -- Check for use of qualified names
 633     mapRn_ (qualNameErr doc_str) quals  `thenRn_`
 634     checkDupNames doc_str rdr_names_w_loc
 635   where
 636     quals = filter (isQual . fst) rdr_names_w_loc
 637
 638 checkDupNames doc_str rdr_names_w_loc
 639   =     -- Check for duplicated names in a binding group
 640     mapRn_ (dupNamesErr doc_str) dups
 641   where
 642     (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
 643 \end{code}
 644
 645
 646 %************************************************************************
 647 %*                                                                      *
 648 \subsection{GlobalRdrEnv}
 649 %*                                                                      *
 650 %************************************************************************
 651
 652 \begin{code}
 653 mkGlobalRdrEnv :: ModuleName            -- Imported module (after doing the "as M" name change)
 654                -> Bool                  -- True <=> want unqualified import
 655                -> (Name -> Provenance)
 656                -> Avails                -- Whats imported
 657                -> Avails                -- What's to be hidden
 658                                         -- I.e. import (imports - hides)
 659                -> Deprecations
 660                -> GlobalRdrEnv
 661
 662 mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails hides deprecs
 663   = gbl_env3
 664   where
 665         -- Make the name environment.  We're talking about a
 666         -- single module here, so there must be no name clashes.
 667         -- In practice there only ever will be if it's the module
 668         -- being compiled.
 669
 670         -- Add qualified names for the things that are available
 671         -- (Qualified names are always imported)
 672     gbl_env1 = foldl add_avail emptyRdrEnv avails
 673
 674         -- Delete (qualified names of) things that are hidden
 675     gbl_env2 = foldl del_avail gbl_env1 hides
 676
 677         -- Add unqualified names
 678     gbl_env3 | unqual_imp = foldl add_unqual gbl_env2 (rdrEnvToList gbl_env2)
 679              | otherwise  = gbl_env2
 680
 681     add_unqual env (qual_name, elts)
 682         = foldl add_one env elts
 683         where
 684           add_one env elt = addOneToGlobalRdrEnv env unqual_name elt
 685           unqual_name     = unqualifyRdrName qual_name
 686         -- The qualified import should only have added one
 687         -- binding for each qualified name!  But if there's an error in
 688         -- the module (multiple bindings for the same name) we may get
 689         -- duplicates.  So the simple thing is to do the fold.
 690
 691     del_avail env avail
 692         = foldl delOneFromGlobalRdrEnv env rdr_names
 693         where
 694           rdr_names = map (mkRdrQual this_mod . nameOccName)
 695                           (availNames avail)
 696
 697
 698     add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
 699     add_avail env avail = foldl add_name env (availNames avail)
 700
 701     add_name env name   -- Add qualified name only
 702         = addOneToGlobalRdrEnv env  (mkRdrQual this_mod occ) elt
 703         where
 704           occ  = nameOccName name
 705           elt  = GRE name (mk_provenance name) (lookupDeprec deprecs name)
 706
 707 mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv
 708 -- Used to construct a GlobalRdrEnv for an interface that we've
 709 -- read from a .hi file.  We can't construct the original top-level
 710 -- environment because we don't have enough info, but we compromise
 711 -- by making an environment from its exports
 712 mkIfaceGlobalRdrEnv m_avails
 713   = foldl add emptyRdrEnv m_avails
 714   where
 715     add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True
 716                                                                 (\n -> LocalDef) avails [] NoDeprecs)
 717                 -- The NoDeprecs is a bit of a hack I suppose
 718 \end{code}
 719
 720 \begin{code}
 721 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
 722 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
 723
 724 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrElt -> GlobalRdrEnv
 725 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
 726
 727 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
 728 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
 729
 730 combine_globals :: [GlobalRdrElt]       -- Old
 731                 -> [GlobalRdrElt]       -- New
 732                 -> [GlobalRdrElt]
 733 combine_globals ns_old ns_new   -- ns_new is often short
 734   = foldr add ns_old ns_new
 735   where
 736     add n ns | any (is_duplicate n) ns_old = map (choose n) ns  -- Eliminate duplicates
 737              | otherwise                   = n:ns
 738
 739     choose n m | n `beats` m = n
 740                | otherwise   = m
 741
 742     (GRE n pn _) `beats` (GRE m pm _) = n==m && pn `hasBetterProv` pm
 743
 744     is_duplicate :: GlobalRdrElt -> GlobalRdrElt -> Bool
 745     is_duplicate (GRE n1 LocalDef _) (GRE n2 LocalDef _) = False
 746     is_duplicate (GRE n1 _        _) (GRE n2 _        _) = n1 == n2
 747 \end{code}
 748
 749 We treat two bindings of a locally-defined name as a duplicate,
 750 because they might be two separate, local defns and we want to report
 751 and error for that, {\em not} eliminate a duplicate.
 752
 753 On the other hand, if you import the same name from two different
 754 import statements, we {\em do} want to eliminate the duplicate, not report
 755 an error.
 756
 757 If a module imports itself then there might be a local defn and an imported
 758 defn of the same name; in this case the names will compare as equal, but
 759 will still have different provenances.
 760
 761
 762 @unQualInScope@ returns a function that takes a @Name@ and tells whether
 763 its unqualified name is in scope.  This is put as a boolean flag in
 764 the @Name@'s provenance to guide whether or not to print the name qualified
 765 in error messages.
 766
 767 \begin{code}
 768 unQualInScope :: GlobalRdrEnv -> Name -> Bool
 769 -- True if 'f' is in scope, and has only one binding
 770 -- (i.e. false if A.f and B.f are both in scope as unqualified 'f')
 771 unQualInScope env
 772   = (`elemNameSet` unqual_names)
 773   where
 774     unqual_names :: NameSet
 775     unqual_names = foldRdrEnv add emptyNameSet env
 776     add rdr_name [GRE name _ _] unquals | isUnqual rdr_name = addOneToNameSet unquals name
 777     add _        _              unquals                     = unquals
 778 \end{code}
 779
 780
 781 %************************************************************************
 782 %*                                                                      *
 783 \subsection{Avails}
 784 %*                                                                      *
 785 %************************************************************************
 786
 787 \begin{code}
 788 plusAvail (Avail n1)       (Avail n2)       = Avail n1
 789 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
 790 -- Added SOF 4/97
 791 #ifdef DEBUG
 792 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
 793 #endif
 794
 795 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
 796 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
 797
 798 emptyAvailEnv = emptyNameEnv
 799 unitAvailEnv :: AvailInfo -> AvailEnv
 800 unitAvailEnv a = unitNameEnv (availName a) a
 801
 802 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
 803 plusAvailEnv = plusNameEnv_C plusAvail
 804
 805 availEnvElts = nameEnvElts
 806
 807 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
 808 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
 809
 810 availsToNameSet :: [AvailInfo] -> NameSet
 811 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
 812
 813 availName :: GenAvailInfo name -> name
 814 availName (Avail n)     = n
 815 availName (AvailTC n _) = n
 816
 817 availNames :: GenAvailInfo name -> [name]
 818 availNames (Avail n)      = [n]
 819 availNames (AvailTC n ns) = ns
 820
 821 -------------------------------------
 822 filterAvail :: RdrNameIE        -- Wanted
 823             -> AvailInfo        -- Available
 824             -> Maybe AvailInfo  -- Resulting available;
 825                                 -- Nothing if (any of the) wanted stuff isn't there
 826
 827 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
 828   | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
 829   | otherwise    = Nothing
 830   where
 831     is_wanted name = nameOccName name `elem` wanted_occs
 832     sub_names_ok   = all (`elem` avail_occs) wanted_occs
 833     avail_occs     = map nameOccName ns
 834     wanted_occs    = map rdrNameOcc (want:wants)
 835
 836 filterAvail (IEThingAbs _) (AvailTC n ns)       = ASSERT( n `elem` ns )
 837                                                   Just (AvailTC n [n])
 838
 839 filterAvail (IEThingAbs _) avail@(Avail n)      = Just avail            -- Type synonyms
 840
 841 filterAvail (IEVar _)      avail@(Avail n)      = Just avail
 842 filterAvail (IEVar v)      avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
 843                                                 where
 844                                                   wanted n = nameOccName n == occ
 845                                                   occ      = rdrNameOcc v
 846         -- The second equation happens if we import a class op, thus
 847         --      import A( op )
 848         -- where op is a class operation
 849
 850 filterAvail (IEThingAll _) avail@(AvailTC _ _)   = Just avail
 851         -- We don't complain even if the IE says T(..), but
 852         -- no constrs/class ops of T are available
 853         -- Instead that's caught with a warning by the caller
 854
 855 filterAvail ie avail = Nothing
 856
 857 -------------------------------------
 858 groupAvails :: Module -> Avails -> [(ModuleName, Avails)]
 859   -- Group by module and sort by occurrence
 860   -- This keeps the list in canonical order
 861 groupAvails this_mod avails
 862   = [ (mkSysModuleNameFS fs, sortLt lt avails)
 863     | (fs,avails) <- fmToList groupFM
 864     ]
 865   where
 866     groupFM :: FiniteMap FastString Avails
 867         -- Deliberately use the FastString so we
 868         -- get a canonical ordering
 869     groupFM = foldl add emptyFM avails
 870
 871     add env avail = addToFM_C combine env mod_fs [avail']
 872                   where
 873                     mod_fs = moduleNameFS (moduleName avail_mod)
 874                     avail_mod = case nameModule_maybe (availName avail) of
 875                                           Just m  -> m
 876                                           Nothing -> this_mod
 877                     combine old _ = avail':old
 878                     avail'        = sortAvail avail
 879
 880     a1 `lt` a2 = occ1 < occ2
 881                where
 882                  occ1  = nameOccName (availName a1)
 883                  occ2  = nameOccName (availName a2)
 884
 885 sortAvail :: AvailInfo -> AvailInfo
 886 -- Sort the sub-names into canonical order.
 887 -- The canonical order has the "main name" at the beginning
 888 -- (if it's there at all)
 889 sortAvail (Avail n) = Avail n
 890 sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) ns))
 891                          | otherwise   = AvailTC n (    sortLt lt ns)
 892                          where
 893                            n1 `lt` n2 = nameOccName n1 < nameOccName n2
 894 \end{code}
 895
 896
 897 %************************************************************************
 898 %*                                                                      *
 899 \subsection{Free variable manipulation}
 900 %*                                                                      *
 901 %************************************************************************
 902
 903 \begin{code}
 904 -- A useful utility
 905 mapFvRn f xs = mapRn f xs       `thenRn` \ stuff ->
 906                let
 907                   (ys, fvs_s) = unzip stuff
 908                in
 909                returnRn (ys, plusFVs fvs_s)
 910 \end{code}
 911
 912
 913 %************************************************************************
 914 %*                                                                      *
 915 \subsection{Envt utility functions}
 916 %*                                                                      *
 917 %************************************************************************
 918
 919 \begin{code}
 920 warnUnusedModules :: [ModuleName] -> RnM d ()
 921 warnUnusedModules mods
 922   = ifOptRn Opt_WarnUnusedImports (mapRn_ (addWarnRn . unused_mod) mods)
 923   where
 924     unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
 925                            text "is imported, but nothing from it is used",
 926                          parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
 927                                    quotes (ppr m))]
 928
 929 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
 930 warnUnusedImports names
 931   = ifOptRn Opt_WarnUnusedImports (warnUnusedBinds names)
 932
 933 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
 934 warnUnusedLocalBinds names
 935   = ifOptRn Opt_WarnUnusedBinds (warnUnusedBinds [(n,LocalDef) | n<-names])
 936
 937 warnUnusedMatches names
 938   = ifOptRn Opt_WarnUnusedMatches (warnUnusedGroup [(n,LocalDef) | n<-names])
 939
 940 -------------------------
 941
 942 warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
 943 warnUnusedBinds names
 944   = mapRn_ warnUnusedGroup  groups
 945   where
 946         -- Group by provenance
 947    groups = equivClasses cmp names
 948    (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
 949
 950
 951 -------------------------
 952
 953 warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
 954 warnUnusedGroup names
 955   | null filtered_names  = returnRn ()
 956   | not is_local         = returnRn ()
 957   | otherwise
 958   = pushSrcLocRn def_loc        $
 959     addWarnRn                   $
 960     sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
 961   where
 962     filtered_names = filter reportable names
 963     (name1, prov1) = head filtered_names
 964     (is_local, def_loc, msg)
 965         = case prov1 of
 966                 LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
 967
 968                 NonLocalDef (UserImport mod loc _)
 969                         -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
 970
 971     reportable (name,_) = case occNameUserString (nameOccName name) of
 972                                 ('_' : _) -> False
 973                                 zz_other  -> True
 974         -- Haskell 98 encourages compilers to suppress warnings about
 975         -- unused names in a pattern if they start with "_".
 976 \end{code}
 977
 978 \begin{code}
 979 addNameClashErrRn rdr_name (np1:nps)
 980   = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
 981                     ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
 982   where
 983     msg1 = ptext  SLIT("either") <+> mk_ref np1
 984     msgs = [ptext SLIT("    or") <+> mk_ref np | np <- nps]
 985     mk_ref (GRE name prov _) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
 986
 987 shadowedNameWarn shadow
 988   = hsep [ptext SLIT("This binding for"),
 989                quotes (ppr shadow),
 990                ptext SLIT("shadows an existing binding")]
 991
 992 unknownNameErr name
 993   = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
 994   where
 995     flavour = occNameFlavour (rdrNameOcc name)
 996
 997 qualNameErr descriptor (name,loc)
 998   = pushSrcLocRn loc $
 999     addErrRn (vcat [ ptext SLIT("Invalid use of qualified name") <+> quotes (ppr name),
1000                      descriptor])
1001
1002 dupNamesErr descriptor ((name,loc) : dup_things)
1003   = pushSrcLocRn loc $
1004     addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
1005               $$
1006               descriptor)
1007
1008 warnDeprec :: Name -> DeprecTxt -> RnM d ()
1009 warnDeprec name txt
1010   = ifOptRn Opt_WarnDeprecations        $
1011     addWarnRn (sep [ text (occNameFlavour (nameOccName name)) <+>
1012                      quotes (ppr name) <+> text "is deprecated:",
1013                      nest 4 (ppr txt) ])
1014 \end{code}
1015