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