ghc/compiler/rename/RnMonad.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnMonad]{The monad used by the renamer}
   5
   6 \begin{code}
   7 module RnMonad(
   8         module RnMonad,
   9
  10         module RdrName,         -- Re-exports
  11         module Name,            -- from these two
  12
  13         Module,
  14         FiniteMap,
  15         Bag,
  16         RdrNameHsDecl,
  17         RdrNameInstDecl,
  18         Version,
  19         NameSet,
  20         OccName,
  21         Fixity
  22     ) where
  23
  24 #include "HsVersions.h"
  25
  26 #if   defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 405
  27 import IOExts           ( fixIO )
  28 #elif defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 302
  29 import PrelIOBase       ( fixIO )       -- Should be in GlaExts
  30 #else
  31 import IOBase           ( fixIO )
  32 #endif
  33 import IOExts           ( IORef, newIORef, readIORef, writeIORef, unsafePerformIO )
  34
  35 import HsSyn
  36 import RdrHsSyn
  37 import RnHsSyn          ( RenamedFixitySig )
  38 import BasicTypes       ( Version, defaultFixity )
  39 import ErrUtils         ( addShortErrLocLine, addShortWarnLocLine,
  40                           pprBagOfErrors, ErrMsg, WarnMsg, Message
  41                         )
  42 import RdrName          ( RdrName, dummyRdrVarName, rdrNameModule, rdrNameOcc,
  43                           RdrNameEnv, emptyRdrEnv, extendRdrEnv,
  44                           lookupRdrEnv, addListToRdrEnv, rdrEnvToList, rdrEnvElts
  45                         )
  46 import Name             ( Name, OccName, NamedThing(..), getSrcLoc,
  47                           isLocallyDefinedName, nameModule, nameOccName,
  48                           decode, mkLocalName, mkKnownKeyGlobal,
  49                           NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv,
  50                           extendNameEnvList
  51                         )
  52 import Module           ( Module, ModuleName, WhereFrom, moduleName )
  53 import NameSet
  54 import CmdLineOpts      ( DynFlags, DynFlag(..), dopt )
  55 import SrcLoc           ( SrcLoc, generatedSrcLoc )
  56 import Unique           ( Unique )
  57 import FiniteMap        ( FiniteMap, emptyFM, listToFM, plusFM )
  58 import Bag              ( Bag, mapBag, emptyBag, isEmptyBag, snocBag )
  59 import UniqSupply
  60 import Outputable
  61 import Finder           ( Finder )
  62 import PrelNames        ( mkUnboundName )
  63 import HscTypes         ( GlobalSymbolTable, AvailEnv,
  64                           OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
  65                           WhetherHasOrphans, ImportVersion, ExportItem,
  66                           PersistentRenamerState(..), IsBootInterface, Avails,
  67                           DeclsMap, IfaceInsts, IfaceRules, DeprecationEnv,
  68                           HomeSymbolTable, PackageSymbolTable,
  69                           PersistentCompilerState(..), GlobalRdrEnv )
  70
  71 infixr 9 `thenRn`, `thenRn_`
  72 \end{code}
  73
  74
  75 %************************************************************************
  76 %*                                                                      *
  77 \subsection{Somewhat magical interface to other monads}
  78 %*                                                                      *
  79 %************************************************************************
  80
  81 \begin{code}
  82 ioToRnM :: IO r -> RnM d (Either IOError r)
  83 ioToRnM io rn_down g_down = (io >>= \ ok -> return (Right ok))
  84                             `catch`
  85                             (\ err -> return (Left err))
  86
  87 traceRn :: SDoc -> RnM d ()
  88 traceRn msg
  89    = doptRn Opt_D_dump_rn_trace `thenRn` \b ->
  90      if b then putDocRn msg else returnRn ()
  91
  92 putDocRn :: SDoc -> RnM d ()
  93 putDocRn msg = ioToRnM (printErrs msg)  `thenRn_`
  94                returnRn ()
  95 \end{code}
  96
  97
  98 %************************************************************************
  99 %*                                                                      *
 100 \subsection{Data types}
 101 %*                                                                      *
 102 %************************************************************************
 103
 104 %===================================================
 105 \subsubsection{         MONAD TYPES}
 106 %===================================================
 107
 108 \begin{code}
 109 type RnM d r = RnDown -> d -> IO r
 110 type RnMS r  = RnM SDown r              -- Renaming source
 111 type RnMG r  = RnM ()    r              -- Getting global names etc
 112
 113         -- Common part
 114 data RnDown
 115   = RnDown {
 116         rn_mod     :: Module,           -- This module
 117         rn_loc     :: SrcLoc,           -- Current locn
 118
 119         rn_finder  :: Finder,
 120         rn_dflags  :: DynFlags,
 121         rn_hst     :: HomeSymbolTable,
 122
 123         rn_errs    :: IORef (Bag WarnMsg, Bag ErrMsg),
 124
 125         -- The second and third components are a flattened-out OrigNameEnv
 126         rn_ns      :: IORef (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv),
 127         rn_ifaces  :: IORef Ifaces
 128     }
 129
 130         -- For renaming source code
 131 data SDown = SDown {
 132                   rn_mode :: RnMode,
 133
 134                   rn_genv :: GlobalRdrEnv,      -- Global envt
 135
 136                   rn_lenv :: LocalRdrEnv,       -- Local name envt
 137                         --   Does *not* include global name envt; may shadow it
 138                         --   Includes both ordinary variables and type variables;
 139                         --   they are kept distinct because tyvar have a different
 140                         --   occurrence contructor (Name.TvOcc)
 141                         -- We still need the unsullied global name env so that
 142                         --   we can look up record field names
 143
 144                   rn_fixenv :: LocalFixityEnv   -- Local fixities
 145                         -- The global fixities are held in the
 146                         -- rn_ifaces field.  Why?  See the comments
 147                         -- with RnIfaces.lookupLocalFixity
 148                 }
 149
 150 data RnMode     = SourceMode                    -- Renaming source code
 151                 | InterfaceMode                 -- Renaming interface declarations.
 152 \end{code}
 153
 154 %===================================================
 155 \subsubsection{         ENVIRONMENTS}
 156 %===================================================
 157
 158 \begin{code}
 159 --------------------------------
 160 type LocalRdrEnv    = RdrNameEnv Name
 161 type LocalFixityEnv = NameEnv RenamedFixitySig
 162         -- We keep the whole fixity sig so that we
 163         -- can report line-number info when there is a duplicate
 164         -- fixity declaration
 165
 166 lookupLocalFixity :: LocalFixityEnv -> Name -> Fixity
 167 lookupLocalFixity env name
 168   = case lookupNameEnv env name of
 169         Just (FixitySig _ fix _) -> fix
 170         Nothing                  -> defaultFixity
 171 \end{code}
 172
 173 \begin{code}
 174 type ExportAvails = (FiniteMap ModuleName Avails,
 175         -- Used to figure out "module M" export specifiers
 176         -- Includes avails only from *unqualified* imports
 177         -- (see 1.4 Report Section 5.1.1)
 178
 179                      AvailEnv)  -- Used to figure out all other export specifiers.
 180 \end{code}
 181
 182 %===================================================
 183 \subsubsection{         INTERFACE FILE STUFF}
 184 %===================================================
 185
 186 \begin{code}
 187
 188 data ParsedIface
 189   = ParsedIface {
 190       pi_mod       :: Module,                           -- Complete with package info
 191       pi_vers      :: Version,                          -- Module version number
 192       pi_orphan    :: WhetherHasOrphans,                -- Whether this module has orphans
 193       pi_usages    :: [ImportVersion OccName],          -- Usages
 194       pi_exports   :: [ExportItem],                     -- Exports
 195       pi_insts     :: [RdrNameInstDecl],                -- Local instance declarations
 196       pi_decls     :: [(Version, RdrNameHsDecl)],       -- Local definitions
 197       pi_fixity    :: (Version, [RdrNameFixitySig]),    -- Local fixity declarations, with their version
 198       pi_rules     :: (Version, [RdrNameRuleDecl]),     -- Rules, with their version
 199       pi_deprecs   :: [RdrNameDeprecation]              -- Deprecations
 200     }
 201 \end{code}
 202
 203 %************************************************************************
 204 %*                                                                      *
 205 \subsection{The renamer state}
 206 %*                                                                      *
 207 %************************************************************************
 208
 209 \begin{code}
 210 data Ifaces = Ifaces {
 211     -- PERSISTENT FIELDS
 212         iPST :: PackageSymbolTable,
 213                 -- The ModuleDetails for modules in other packages
 214                 -- whose interfaces we have opened
 215                 -- The contents of those interface files may be mostly
 216                 -- in the iDecls, iInsts, iRules (below), but what *will*
 217                 -- be in the PackageSymbolTable is:
 218                 --      * The Module
 219                 --      * Version info
 220                 --      * Its exports
 221                 --      * Fixities
 222                 --      * Deprecations
 223                 -- This field is initialised from the compiler's persistent
 224                 -- package symbol table, and the renamer incrementally adds
 225                 -- to it.
 226
 227         iDecls :: DeclsMap,
 228                 -- A single, global map of Names to unslurped decls
 229
 230         iInsts :: IfaceInsts,
 231                 -- The as-yet un-slurped instance decls; this bag is depleted when we
 232                 -- slurp an instance decl so that we don't slurp the same one twice.
 233                 -- Each is 'gated' by the names that must be available before
 234                 -- this instance decl is needed.
 235
 236         iRules :: IfaceRules,
 237                 -- Similar to instance decls, only for rules
 238
 239     -- EPHEMERAL FIELDS
 240     -- These fields persist during the compilation of a single module only
 241         iImpModInfo :: ImportedModuleInfo,
 242                         -- Modules this one depends on: that is, the union
 243                         -- of the modules its *direct* imports depend on.
 244                         -- NB: The direct imports have .hi files that enumerate *all* the
 245                         -- dependencies (direct or not) of the imported module.
 246
 247         iSlurp :: NameSet,
 248                 -- All the names (whether "big" or "small", whether wired-in or not,
 249                 -- whether locally defined or not) that have been slurped in so far.
 250
 251         iVSlurp :: [(Name,Version)]
 252                 -- All the (a) non-wired-in (b) "big" (c) non-locally-defined
 253                 -- names that have been slurped in so far, with their versions.
 254                 -- This is used to generate the "usage" information for this module.
 255                 -- Subset of the previous field.
 256     }
 257
 258 type ImportedModuleInfo = FiniteMap ModuleName
 259                                     (WhetherHasOrphans, IsBootInterface, IsLoaded)
 260 type IsLoaded = Bool
 261 \end{code}
 262
 263
 264 %************************************************************************
 265 %*                                                                      *
 266 \subsection{Main monad code}
 267 %*                                                                      *
 268 %************************************************************************
 269
 270 \begin{code}
 271 initRn :: DynFlags -> Finder -> HomeSymbolTable
 272        -> PersistentCompilerState
 273        -> Module -> SrcLoc
 274        -> RnMG t
 275        -> IO (t, PersistentCompilerState, (Bag WarnMsg, Bag ErrMsg))
 276
 277 initRn dflags finder hst pcs mod loc do_rn
 278   = do
 279         let prs = pcs_PRS pcs
 280         uniqs     <- mkSplitUniqSupply 'r'
 281         names_var <- newIORef (uniqs, origNames (prsOrig prs),
 282                                       origIParam (prsOrig prs))
 283         errs_var  <- newIORef (emptyBag,emptyBag)
 284         iface_var <- newIORef (initIfaces pcs)
 285         let rn_down = RnDown { rn_mod = mod,
 286                                rn_loc = loc,
 287
 288                                rn_finder = finder,
 289                                rn_dflags = dflags,
 290                                rn_hst    = hst,
 291
 292                                rn_ns     = names_var,
 293                                rn_errs   = errs_var,
 294                                rn_ifaces = iface_var,
 295                              }
 296
 297         -- do the business
 298         res <- do_rn rn_down ()
 299
 300         -- Grab state and record it
 301         (warns, errs)              <- readIORef errs_var
 302         new_ifaces                 <- readIORef iface_var
 303         (_, new_origN, new_origIP) <- readIORef names_var
 304         let new_orig = Orig { origNames = new_origN, origIParam = new_origIP }
 305         let new_prs = prs { prsOrig = new_orig,
 306                             prsDecls = iDecls new_ifaces,
 307                             prsInsts = iInsts new_ifaces,
 308                             prsRules = iRules new_ifaces }
 309         let new_pcs = pcs { pcs_PST = iPST new_ifaces,
 310                             pcs_PRS = new_prs }
 311
 312         return (res, new_pcs, (warns, errs))
 313
 314
 315 initIfaces :: PersistentCompilerState -> Ifaces
 316 initIfaces (PCS { pcs_PST = pst, pcs_PRS = prs })
 317   = Ifaces { iPST   = pst,
 318              iDecls = prsDecls prs,
 319              iInsts = prsInsts prs,
 320              iRules = prsRules prs,
 321
 322              iImpModInfo = emptyFM,
 323              iSlurp      = unitNameSet (mkUnboundName dummyRdrVarName),
 324                         -- Pretend that the dummy unbound name has already been
 325                         -- slurped.  This is what's returned for an out-of-scope name,
 326                         -- and we don't want thereby to try to suck it in!
 327              iVSlurp = []
 328       }
 329
 330
 331 initRnMS :: GlobalRdrEnv -> LocalFixityEnv -> RnMode -> RnMS r -> RnM d r
 332 initRnMS rn_env fixity_env mode thing_inside rn_down g_down
 333   = let
 334         s_down = SDown { rn_genv = rn_env, rn_lenv = emptyRdrEnv,
 335                          rn_fixenv = fixity_env, rn_mode = mode }
 336     in
 337     thing_inside rn_down s_down
 338
 339 initIfaceRnMS :: Module -> RnMS r -> RnM d r
 340 initIfaceRnMS mod thing_inside
 341   = initRnMS emptyRdrEnv emptyNameEnv InterfaceMode $
 342     setModuleRn mod thing_inside
 343
 344 \end{code}
 345
 346 @renameSourceCode@ is used to rename stuff ``out-of-line'';
 347 that is, not as part of the main renamer.
 348 Sole examples: derived definitions,
 349 which are only generated in the type checker.
 350
 351 The @NameSupply@ includes a @UniqueSupply@, so if you call it more than
 352 once you must either split it, or install a fresh unique supply.
 353
 354 \begin{code}
 355 renameSourceCode :: DynFlags
 356                  -> Module
 357                  -> PersistentRenamerState
 358                  -> RnMS r
 359                  -> r
 360
 361 renameSourceCode dflags mod prs m
 362   = unsafePerformIO (
 363         -- It's not really unsafe!  When renaming source code we
 364         -- only do any I/O if we need to read in a fixity declaration;
 365         -- and that doesn't happen in pragmas etc
 366
 367         mkSplitUniqSupply 'r'                           >>= \ new_us ->
 368         newIORef (new_us, origNames (prsOrig prs),
 369                           origIParam (prsOrig prs))     >>= \ names_var ->
 370         newIORef (emptyBag,emptyBag)                    >>= \ errs_var ->
 371         let
 372             rn_down = RnDown { rn_dflags = dflags,
 373                                rn_loc = generatedSrcLoc, rn_ns = names_var,
 374                                rn_errs = errs_var,
 375                                rn_mod = mod,
 376                                rn_ifaces = panic "rnameSourceCode: rn_ifaces"  -- Not required
 377                              }
 378             s_down = SDown { rn_mode = InterfaceMode,
 379                                -- So that we can refer to PrelBase.True etc
 380                              rn_genv = emptyRdrEnv, rn_lenv = emptyRdrEnv,
 381                              rn_fixenv = emptyNameEnv }
 382         in
 383         m rn_down s_down                        >>= \ result ->
 384
 385         readIORef errs_var                      >>= \ (warns,errs) ->
 386
 387         (if not (isEmptyBag errs) then
 388                 pprTrace "Urk! renameSourceCode found errors" (display errs)
 389 #ifdef DEBUG
 390          else if not (isEmptyBag warns) then
 391                 pprTrace "Note: renameSourceCode found warnings" (display warns)
 392 #endif
 393          else
 394                 id) $
 395
 396         return result
 397     )
 398   where
 399     display errs = pprBagOfErrors errs
 400
 401 {-# INLINE thenRn #-}
 402 {-# INLINE thenRn_ #-}
 403 {-# INLINE returnRn #-}
 404 {-# INLINE andRn #-}
 405
 406 returnRn :: a -> RnM d a
 407 thenRn   :: RnM d a -> (a -> RnM d b) -> RnM d b
 408 thenRn_  :: RnM d a -> RnM d b -> RnM d b
 409 andRn    :: (a -> a -> a) -> RnM d a -> RnM d a -> RnM d a
 410 mapRn    :: (a -> RnM d b) -> [a] -> RnM d [b]
 411 mapRn_   :: (a -> RnM d b) -> [a] -> RnM d ()
 412 mapMaybeRn :: (a -> RnM d (Maybe b)) -> [a] -> RnM d [b]
 413 flatMapRn  :: (a -> RnM d [b])       -> [a] -> RnM d [b]
 414 sequenceRn :: [RnM d a] -> RnM d [a]
 415 foldlRn :: (b  -> a -> RnM d b) -> b -> [a] -> RnM d b
 416 mapAndUnzipRn :: (a -> RnM d (b,c)) -> [a] -> RnM d ([b],[c])
 417 fixRn    :: (a -> RnM d a) -> RnM d a
 418
 419 returnRn v gdown ldown  = return v
 420 thenRn m k gdown ldown  = m gdown ldown >>= \ r -> k r gdown ldown
 421 thenRn_ m k gdown ldown = m gdown ldown >> k gdown ldown
 422 fixRn m gdown ldown = fixIO (\r -> m r gdown ldown)
 423 andRn combiner m1 m2 gdown ldown
 424   = m1 gdown ldown >>= \ res1 ->
 425     m2 gdown ldown >>= \ res2 ->
 426     return (combiner res1 res2)
 427
 428 sequenceRn []     = returnRn []
 429 sequenceRn (m:ms) =  m                  `thenRn` \ r ->
 430                      sequenceRn ms      `thenRn` \ rs ->
 431                      returnRn (r:rs)
 432
 433 mapRn f []     = returnRn []
 434 mapRn f (x:xs)
 435   = f x         `thenRn` \ r ->
 436     mapRn f xs  `thenRn` \ rs ->
 437     returnRn (r:rs)
 438
 439 mapRn_ f []     = returnRn ()
 440 mapRn_ f (x:xs) =
 441     f x         `thenRn_`
 442     mapRn_ f xs
 443
 444 foldlRn k z [] = returnRn z
 445 foldlRn k z (x:xs) = k z x      `thenRn` \ z' ->
 446                      foldlRn k z' xs
 447
 448 mapAndUnzipRn f [] = returnRn ([],[])
 449 mapAndUnzipRn f (x:xs)
 450   = f x                 `thenRn` \ (r1,  r2)  ->
 451     mapAndUnzipRn f xs  `thenRn` \ (rs1, rs2) ->
 452     returnRn (r1:rs1, r2:rs2)
 453
 454 mapAndUnzip3Rn f [] = returnRn ([],[],[])
 455 mapAndUnzip3Rn f (x:xs)
 456   = f x                 `thenRn` \ (r1,  r2,  r3)  ->
 457     mapAndUnzip3Rn f xs `thenRn` \ (rs1, rs2, rs3) ->
 458     returnRn (r1:rs1, r2:rs2, r3:rs3)
 459
 460 mapMaybeRn f []     = returnRn []
 461 mapMaybeRn f (x:xs) = f x               `thenRn` \ maybe_r ->
 462                       mapMaybeRn f xs   `thenRn` \ rs ->
 463                       case maybe_r of
 464                         Nothing -> returnRn rs
 465                         Just r  -> returnRn (r:rs)
 466
 467 flatMapRn f []     = returnRn []
 468 flatMapRn f (x:xs) = f x                `thenRn` \ r ->
 469                      flatMapRn f xs     `thenRn` \ rs ->
 470                      returnRn (r ++ rs)
 471 \end{code}
 472
 473
 474
 475 %************************************************************************
 476 %*                                                                      *
 477 \subsection{Boring plumbing for common part}
 478 %*                                                                      *
 479 %************************************************************************
 480
 481
 482 %================
 483 \subsubsection{  Errors and warnings}
 484 %=====================
 485
 486 \begin{code}
 487 failWithRn :: a -> Message -> RnM d a
 488 failWithRn res msg (RnDown {rn_errs = errs_var, rn_loc = loc}) l_down
 489   = readIORef  errs_var                                         >>=  \ (warns,errs) ->
 490     writeIORef errs_var (warns, errs `snocBag` err)             >>
 491     return res
 492   where
 493     err = addShortErrLocLine loc msg
 494
 495 warnWithRn :: a -> Message -> RnM d a
 496 warnWithRn res msg (RnDown {rn_errs = errs_var, rn_loc = loc}) l_down
 497   = readIORef  errs_var                                         >>=  \ (warns,errs) ->
 498     writeIORef errs_var (warns `snocBag` warn, errs)    >>
 499     return res
 500   where
 501     warn = addShortWarnLocLine loc msg
 502
 503 addErrRn :: Message -> RnM d ()
 504 addErrRn err = failWithRn () err
 505
 506 checkRn :: Bool -> Message -> RnM d ()  -- Check that a condition is true
 507 checkRn False err = addErrRn err
 508 checkRn True  err = returnRn ()
 509
 510 warnCheckRn :: Bool -> Message -> RnM d ()      -- Check that a condition is true
 511 warnCheckRn False err = addWarnRn err
 512 warnCheckRn True  err = returnRn ()
 513
 514 addWarnRn :: Message -> RnM d ()
 515 addWarnRn warn = warnWithRn () warn
 516
 517 checkErrsRn :: RnM d Bool               -- True <=> no errors so far
 518 checkErrsRn (RnDown {rn_errs = errs_var}) l_down
 519   = readIORef  errs_var                                         >>=  \ (warns,errs) ->
 520     return (isEmptyBag errs)
 521
 522 doptRn :: DynFlag -> RnM d Bool
 523 doptRn dflag (RnDown { rn_dflags = dflags}) l_down
 524    = return (dopt dflag dflags)
 525
 526 getDOptsRn :: RnM d DynFlags
 527 getDOptsRn (RnDown { rn_dflags = dflags}) l_down
 528    = return dflags
 529 \end{code}
 530
 531
 532 %================
 533 \subsubsection{  Source location}
 534 %=====================
 535
 536 \begin{code}
 537 pushSrcLocRn :: SrcLoc -> RnM d a -> RnM d a
 538 pushSrcLocRn loc' m down l_down
 539   = m (down {rn_loc = loc'}) l_down
 540
 541 getSrcLocRn :: RnM d SrcLoc
 542 getSrcLocRn down l_down
 543   = return (rn_loc down)
 544 \end{code}
 545
 546 %================
 547 \subsubsection{The finder and home symbol table}
 548 %=====================
 549
 550 \begin{code}
 551 getFinderRn :: RnM d Finder
 552 getFinderRn down l_down = return (rn_finder down)
 553
 554 getHomeSymbolTableRn :: RnM d HomeSymbolTable
 555 getHomeSymbolTableRn down l_down = return (rn_hst down)
 556 \end{code}
 557
 558 %================
 559 \subsubsection{Name supply}
 560 %=====================
 561
 562 \begin{code}
 563 getNameSupplyRn :: RnM d (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv)
 564 getNameSupplyRn rn_down l_down
 565   = readIORef (rn_ns rn_down)
 566
 567 setNameSupplyRn :: (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv) -> RnM d ()
 568 setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
 569   = writeIORef names_var names'
 570
 571 getUniqRn :: RnM d Unique
 572 getUniqRn (RnDown {rn_ns = names_var}) l_down
 573  = readIORef names_var >>= \ (us, cache, ipcache) ->
 574    let
 575      (us1,us') = splitUniqSupply us
 576    in
 577    writeIORef names_var (us', cache, ipcache)  >>
 578    return (uniqFromSupply us1)
 579 \end{code}
 580
 581 %================
 582 \subsubsection{  Module}
 583 %=====================
 584
 585 \begin{code}
 586 getModuleRn :: RnM d Module
 587 getModuleRn (RnDown {rn_mod = mod}) l_down
 588   = return mod
 589
 590 setModuleRn :: Module -> RnM d a -> RnM d a
 591 setModuleRn new_mod enclosed_thing rn_down l_down
 592   = enclosed_thing (rn_down {rn_mod = new_mod}) l_down
 593 \end{code}
 594
 595
 596 %************************************************************************
 597 %*                                                                      *
 598 \subsection{Plumbing for rename-source part}
 599 %*                                                                      *
 600 %************************************************************************
 601
 602 %================
 603 \subsubsection{  RnEnv}
 604 %=====================
 605
 606 \begin{code}
 607 getLocalNameEnv :: RnMS LocalRdrEnv
 608 getLocalNameEnv rn_down (SDown {rn_lenv = local_env})
 609   = return local_env
 610
 611 getGlobalNameEnv :: RnMS GlobalRdrEnv
 612 getGlobalNameEnv rn_down (SDown {rn_genv = global_env})
 613   = return global_env
 614
 615 setLocalNameEnv :: LocalRdrEnv -> RnMS a -> RnMS a
 616 setLocalNameEnv local_env' m rn_down l_down
 617   = m rn_down (l_down {rn_lenv = local_env'})
 618
 619 getFixityEnv :: RnMS LocalFixityEnv
 620 getFixityEnv rn_down (SDown {rn_fixenv = fixity_env})
 621   = return fixity_env
 622
 623 extendFixityEnv :: [(Name, RenamedFixitySig)] -> RnMS a -> RnMS a
 624 extendFixityEnv fixes enclosed_scope
 625                 rn_down l_down@(SDown {rn_fixenv = fixity_env})
 626   = let
 627         new_fixity_env = extendNameEnvList fixity_env fixes
 628     in
 629     enclosed_scope rn_down (l_down {rn_fixenv = new_fixity_env})
 630 \end{code}
 631
 632 %================
 633 \subsubsection{  Mode}
 634 %=====================
 635
 636 \begin{code}
 637 getModeRn :: RnMS RnMode
 638 getModeRn rn_down (SDown {rn_mode = mode})
 639   = return mode
 640
 641 setModeRn :: RnMode -> RnMS a -> RnMS a
 642 setModeRn new_mode thing_inside rn_down l_down
 643   = thing_inside rn_down (l_down {rn_mode = new_mode})
 644 \end{code}
 645
 646
 647 %************************************************************************
 648 %*                                                                      *
 649 \subsection{Plumbing for rename-globals part}
 650 %*                                                                      *
 651 %************************************************************************
 652
 653 \begin{code}
 654 getIfacesRn :: RnM d Ifaces
 655 getIfacesRn (RnDown {rn_ifaces = iface_var}) _
 656   = readIORef iface_var
 657
 658 setIfacesRn :: Ifaces -> RnM d ()
 659 setIfacesRn ifaces (RnDown {rn_ifaces = iface_var}) _
 660   = writeIORef iface_var ifaces
 661 \end{code}