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