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 NameSupply,
 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 = do
 332   himaps    <- mkModuleHiMaps dirs
 333   names_var <- newIORef (prsNS pcs)
 334   errs_var  <- newIORef (emptyBag,emptyBag)
 335   iface_var <- newIORef (initIfaces prs)
 336   let
 337         rn_down = RnDown { rn_mod = mod,
 338                            rn_loc = loc,
 339
 340                            rn_finder = finder,
 341                            rn_dflags = dflags,
 342                            rn_gst    = gst,
 343
 344                            rn_ns     = names_var,
 345                            rn_errs   = errs_var,
 346                            rn_ifaces = iface_var,
 347                   }
 348
 349         -- do the business
 350   res <- do_rn rn_down ()
 351
 352         -- grab errors and return
 353   (warns, errs) <- readIORef errs_var
 354
 355   return (res, errs, warns)
 356
 357
 358 initIfaces :: PersistentRenamerState -> Ifaces
 359 initIfaces prs
 360   = Ifaces { iDecls = prsDecls prs,
 361              iInsts = prsInsts prs,
 362              iRules = prsRules rules,
 363
 364              iFixes   = emptyNameEnv,
 365              iDeprecs = emptyNameEnv,
 366
 367              iImpModInfo = emptyFM,
 368              iDeferred   = emptyNameSet,
 369              iSlurp      = unitNameSet (mkUnboundName dummyRdrVarName),
 370                         -- Pretend that the dummy unbound name has already been
 371                         -- slurped.  This is what's returned for an out-of-scope name,
 372                         -- and we don't want thereby to try to suck it in!
 373              iVSlurp = []
 374       }
 375
 376
 377 initRnMS :: GlobalRdrEnv -> FixityEnv -> RnMode -> RnMS r -> RnM d r
 378 initRnMS rn_env fixity_env mode thing_inside rn_down g_down
 379   = let
 380         s_down = SDown { rn_genv = rn_env, rn_lenv = emptyRdrEnv,
 381                          rn_fixenv = fixity_env, rn_mode = mode }
 382     in
 383     thing_inside rn_down s_down
 384
 385 initIfaceRnMS :: Module -> RnMS r -> RnM d r
 386 initIfaceRnMS mod thing_inside
 387   = initRnMS emptyRdrEnv emptyNameEnv InterfaceMode $
 388     setModuleRn mod thing_inside
 389
 390 builtins :: FiniteMap (ModuleName,OccName) Name
 391 builtins = listToFM wired_in `plusFM` listToFM known_key
 392          where
 393            wired_in = [ ((moduleName (nameModule name), nameOccName name), name)
 394                       | name <- wiredInNames ]
 395
 396            known_key = [ ((rdrNameModule rdr_name, rdrNameOcc rdr_name), mkKnownKeyGlobal rdr_name uniq)
 397                        | (rdr_name, uniq) <- knownKeyRdrNames ]
 398 \end{code}
 399
 400 @renameSourceCode@ is used to rename stuff ``out-of-line'';
 401 that is, not as part of the main renamer.
 402 Sole examples: derived definitions,
 403 which are only generated in the type checker.
 404
 405 The @NameSupply@ includes a @UniqueSupply@, so if you call it more than
 406 once you must either split it, or install a fresh unique supply.
 407
 408 \begin{code}
 409 renameSourceCode :: DynFlags
 410                  -> Module
 411                  -> RnNameSupply
 412                  -> RnMS r
 413                  -> r
 414
 415 renameSourceCode dflags mod name_supply m
 416   = unsafePerformIO (
 417         -- It's not really unsafe!  When renaming source code we
 418         -- only do any I/O if we need to read in a fixity declaration;
 419         -- and that doesn't happen in pragmas etc
 420
 421         newIORef name_supply            >>= \ names_var ->
 422         newIORef (emptyBag,emptyBag)    >>= \ errs_var ->
 423         let
 424             rn_down = RnDown { rn_dflags = dflags,
 425                                rn_loc = mkGeneratedSrcLoc, rn_ns = names_var,
 426                                rn_errs = errs_var,
 427                                rn_mod = mod,
 428                                rn_ifaces = panic "rnameSourceCode: rn_ifaces"  -- Not required
 429                              }
 430             s_down = SDown { rn_mode = InterfaceMode,
 431                                -- So that we can refer to PrelBase.True etc
 432                              rn_genv = emptyRdrEnv, rn_lenv = emptyRdrEnv,
 433                              rn_fixenv = emptyNameEnv }
 434         in
 435         m rn_down s_down                        >>= \ result ->
 436
 437         readIORef errs_var                      >>= \ (warns,errs) ->
 438
 439         (if not (isEmptyBag errs) then
 440                 pprTrace "Urk! renameSourceCode found errors" (display errs)
 441 #ifdef DEBUG
 442          else if not (isEmptyBag warns) then
 443                 pprTrace "Note: renameSourceCode found warnings" (display warns)
 444 #endif
 445          else
 446                 id) $
 447
 448         return result
 449     )
 450   where
 451     display errs = pprBagOfErrors errs
 452
 453 {-# INLINE thenRn #-}
 454 {-# INLINE thenRn_ #-}
 455 {-# INLINE returnRn #-}
 456 {-# INLINE andRn #-}
 457
 458 returnRn :: a -> RnM d a
 459 thenRn   :: RnM d a -> (a -> RnM d b) -> RnM d b
 460 thenRn_  :: RnM d a -> RnM d b -> RnM d b
 461 andRn    :: (a -> a -> a) -> RnM d a -> RnM d a -> RnM d a
 462 mapRn    :: (a -> RnM d b) -> [a] -> RnM d [b]
 463 mapRn_   :: (a -> RnM d b) -> [a] -> RnM d ()
 464 mapMaybeRn :: (a -> RnM d (Maybe b)) -> [a] -> RnM d [b]
 465 flatMapRn  :: (a -> RnM d [b])       -> [a] -> RnM d [b]
 466 sequenceRn :: [RnM d a] -> RnM d [a]
 467 foldlRn :: (b  -> a -> RnM d b) -> b -> [a] -> RnM d b
 468 mapAndUnzipRn :: (a -> RnM d (b,c)) -> [a] -> RnM d ([b],[c])
 469 fixRn    :: (a -> RnM d a) -> RnM d a
 470
 471 returnRn v gdown ldown  = return v
 472 thenRn m k gdown ldown  = m gdown ldown >>= \ r -> k r gdown ldown
 473 thenRn_ m k gdown ldown = m gdown ldown >> k gdown ldown
 474 fixRn m gdown ldown = fixIO (\r -> m r gdown ldown)
 475 andRn combiner m1 m2 gdown ldown
 476   = m1 gdown ldown >>= \ res1 ->
 477     m2 gdown ldown >>= \ res2 ->
 478     return (combiner res1 res2)
 479
 480 sequenceRn []     = returnRn []
 481 sequenceRn (m:ms) =  m                  `thenRn` \ r ->
 482                      sequenceRn ms      `thenRn` \ rs ->
 483                      returnRn (r:rs)
 484
 485 mapRn f []     = returnRn []
 486 mapRn f (x:xs)
 487   = f x         `thenRn` \ r ->
 488     mapRn f xs  `thenRn` \ rs ->
 489     returnRn (r:rs)
 490
 491 mapRn_ f []     = returnRn ()
 492 mapRn_ f (x:xs) =
 493     f x         `thenRn_`
 494     mapRn_ f xs
 495
 496 foldlRn k z [] = returnRn z
 497 foldlRn k z (x:xs) = k z x      `thenRn` \ z' ->
 498                      foldlRn k z' xs
 499
 500 mapAndUnzipRn f [] = returnRn ([],[])
 501 mapAndUnzipRn f (x:xs)
 502   = f x                 `thenRn` \ (r1,  r2)  ->
 503     mapAndUnzipRn f xs  `thenRn` \ (rs1, rs2) ->
 504     returnRn (r1:rs1, r2:rs2)
 505
 506 mapAndUnzip3Rn f [] = returnRn ([],[],[])
 507 mapAndUnzip3Rn f (x:xs)
 508   = f x                 `thenRn` \ (r1,  r2,  r3)  ->
 509     mapAndUnzip3Rn f xs `thenRn` \ (rs1, rs2, rs3) ->
 510     returnRn (r1:rs1, r2:rs2, r3:rs3)
 511
 512 mapMaybeRn f []     = returnRn []
 513 mapMaybeRn f (x:xs) = f x               `thenRn` \ maybe_r ->
 514                       mapMaybeRn f xs   `thenRn` \ rs ->
 515                       case maybe_r of
 516                         Nothing -> returnRn rs
 517                         Just r  -> returnRn (r:rs)
 518
 519 flatMapRn f []     = returnRn []
 520 flatMapRn f (x:xs) = f x                `thenRn` \ r ->
 521                      flatMapRn f xs     `thenRn` \ rs ->
 522                      returnRn (r ++ rs)
 523 \end{code}
 524
 525
 526
 527 %************************************************************************
 528 %*                                                                      *
 529 \subsection{Boring plumbing for common part}
 530 %*                                                                      *
 531 %************************************************************************
 532
 533
 534 %================
 535 \subsubsection{  Errors and warnings}
 536 %=====================
 537
 538 \begin{code}
 539 failWithRn :: a -> Message -> RnM d a
 540 failWithRn res msg (RnDown {rn_errs = errs_var, rn_loc = loc}) l_down
 541   = readIORef  errs_var                                         >>=  \ (warns,errs) ->
 542     writeIORef errs_var (warns, errs `snocBag` err)             >>
 543     return res
 544   where
 545     err = addShortErrLocLine loc msg
 546
 547 warnWithRn :: a -> Message -> RnM d a
 548 warnWithRn res msg (RnDown {rn_errs = errs_var, rn_loc = loc}) l_down
 549   = readIORef  errs_var                                         >>=  \ (warns,errs) ->
 550     writeIORef errs_var (warns `snocBag` warn, errs)    >>
 551     return res
 552   where
 553     warn = addShortWarnLocLine loc msg
 554
 555 addErrRn :: Message -> RnM d ()
 556 addErrRn err = failWithRn () err
 557
 558 checkRn :: Bool -> Message -> RnM d ()  -- Check that a condition is true
 559 checkRn False err = addErrRn err
 560 checkRn True  err = returnRn ()
 561
 562 warnCheckRn :: Bool -> Message -> RnM d ()      -- Check that a condition is true
 563 warnCheckRn False err = addWarnRn err
 564 warnCheckRn True  err = returnRn ()
 565
 566 addWarnRn :: Message -> RnM d ()
 567 addWarnRn warn = warnWithRn () warn
 568
 569 checkErrsRn :: RnM d Bool               -- True <=> no errors so far
 570 checkErrsRn (RnDown {rn_errs = errs_var}) l_down
 571   = readIORef  errs_var                                         >>=  \ (warns,errs) ->
 572     return (isEmptyBag errs)
 573
 574 doptsRn :: (DynFlags -> Bool) -> RnM d Bool
 575 doptsRn dopt (RnDown { rn_dflags = dflags}) l_down
 576    = return (dopt dflags)
 577 \end{code}
 578
 579
 580 %================
 581 \subsubsection{  Source location}
 582 %=====================
 583
 584 \begin{code}
 585 pushSrcLocRn :: SrcLoc -> RnM d a -> RnM d a
 586 pushSrcLocRn loc' m down l_down
 587   = m (down {rn_loc = loc'}) l_down
 588
 589 getSrcLocRn :: RnM d SrcLoc
 590 getSrcLocRn down l_down
 591   = return (rn_loc down)
 592 \end{code}
 593
 594 %================
 595 \subsubsection{  Name supply}
 596 %=====================
 597
 598 \begin{code}
 599 getNameSupplyRn :: RnM d NameSupply
 600 getNameSupplyRn rn_down l_down
 601   = readIORef (rn_ns rn_down)
 602
 603 setNameSupplyRn :: NameSupply -> RnM d ()
 604 setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
 605   = writeIORef names_var names'
 606
 607 getUniqRn :: RnM d Unique
 608 getUniqRn (RnDown {rn_ns = names_var}) l_down
 609  = readIORef names_var >>= \ (us, cache, ipcache) ->
 610    let
 611      (us1,us') = splitUniqSupply us
 612    in
 613    writeIORef names_var (us', cache, ipcache)  >>
 614    return (uniqFromSupply us1)
 615 \end{code}
 616
 617 %================
 618 \subsubsection{  Module}
 619 %=====================
 620
 621 \begin{code}
 622 getModuleRn :: RnM d Module
 623 getModuleRn (RnDown {rn_mod = mod}) l_down
 624   = return mod
 625
 626 setModuleRn :: Module -> RnM d a -> RnM d a
 627 setModuleRn new_mod enclosed_thing rn_down l_down
 628   = enclosed_thing (rn_down {rn_mod = new_mod}) l_down
 629 \end{code}
 630
 631
 632 %************************************************************************
 633 %*                                                                      *
 634 \subsection{Plumbing for rename-source part}
 635 %*                                                                      *
 636 %************************************************************************
 637
 638 %================
 639 \subsubsection{  RnEnv}
 640 %=====================
 641
 642 \begin{code}
 643 getNameEnvs :: RnMS (GlobalRdrEnv, LocalRdrEnv)
 644 getNameEnvs rn_down (SDown {rn_genv = global_env, rn_lenv = local_env})
 645   = return (global_env, local_env)
 646
 647 getLocalNameEnv :: RnMS LocalRdrEnv
 648 getLocalNameEnv rn_down (SDown {rn_lenv = local_env})
 649   = return local_env
 650
 651 getGlobalNameEnv :: RnMS GlobalRdrEnv
 652 getGlobalNameEnv rn_down (SDown {rn_genv = global_env})
 653   = return global_env
 654
 655 setLocalNameEnv :: LocalRdrEnv -> RnMS a -> RnMS a
 656 setLocalNameEnv local_env' m rn_down l_down
 657   = m rn_down (l_down {rn_lenv = local_env'})
 658
 659 getFixityEnv :: RnMS FixityEnv
 660 getFixityEnv rn_down (SDown {rn_fixenv = fixity_env})
 661   = return fixity_env
 662
 663 extendFixityEnv :: [(Name, RenamedFixitySig)] -> RnMS a -> RnMS a
 664 extendFixityEnv fixes enclosed_scope
 665                 rn_down l_down@(SDown {rn_fixenv = fixity_env})
 666   = let
 667         new_fixity_env = extendNameEnvList fixity_env fixes
 668     in
 669     enclosed_scope rn_down (l_down {rn_fixenv = new_fixity_env})
 670 \end{code}
 671
 672 %================
 673 \subsubsection{  Mode}
 674 %=====================
 675
 676 \begin{code}
 677 getModeRn :: RnMS RnMode
 678 getModeRn rn_down (SDown {rn_mode = mode})
 679   = return mode
 680
 681 setModeRn :: RnMode -> RnMS a -> RnMS a
 682 setModeRn new_mode thing_inside rn_down l_down
 683   = thing_inside rn_down (l_down {rn_mode = new_mode})
 684 \end{code}
 685
 686
 687 %************************************************************************
 688 %*                                                                      *
 689 \subsection{Plumbing for rename-globals part}
 690 %*                                                                      *
 691 %************************************************************************
 692
 693 \begin{code}
 694 getIfacesRn :: RnM d Ifaces
 695 getIfacesRn (RnDown {rn_ifaces = iface_var}) _
 696   = readIORef iface_var
 697
 698 setIfacesRn :: Ifaces -> RnM d ()
 699 setIfacesRn ifaces (RnDown {rn_ifaces = iface_var}) _
 700   = writeIORef iface_var ifaces
 701 \end{code}