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