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