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