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