ghc/compiler/rename/RnMonad.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1997
   3 %
   4 \section[RnMonad]{The monad used by the renamer}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module RnMonad(
  10         EXP_MODULE(RnMonad),
  11          -- close it up (partly done to allow unfoldings)
  12         EXP_MODULE(SST),
  13         SYN_IE(Module),
  14         FiniteMap,
  15         Bag,
  16         Name,
  17         SYN_IE(RdrNameHsDecl),
  18         SYN_IE(RdrNameInstDecl),
  19         SYN_IE(Version),
  20         SYN_IE(NameSet),
  21         OccName,
  22         Fixity
  23     ) where
  24
  25 IMP_Ubiq(){-uitous-}
  26
  27 import SST
  28 #if __GLASGOW_HASKELL__ <= 201
  29 import PreludeGlaST     ( SYN_IE(ST), thenStrictlyST, returnStrictlyST )
  30 #define MkIO
  31 #else
  32 import GlaExts
  33 import IO
  34 import ST
  35 import IOBase
  36 #define IOError13 IOError
  37 #define MkIO IO
  38 #endif
  39
  40 import HsSyn
  41 import RdrHsSyn
  42 import BasicTypes       ( SYN_IE(Version), NewOrData )
  43 import ErrUtils         ( addErrLoc, addShortErrLocLine, addShortWarnLocLine,
  44                           pprBagOfErrors, SYN_IE(Error), SYN_IE(Warning)
  45                         )
  46 import Name             ( SYN_IE(Module), Name, OccName, Provenance, SYN_IE(NameSet), emptyNameSet,
  47                           isLocallyDefinedName,
  48                           modAndOcc, NamedThing(..)
  49                         )
  50 import CmdLineOpts      ( opt_D_show_rn_trace, opt_IgnoreIfacePragmas )
  51 import PrelInfo         ( builtinNames )
  52 import TyCon            ( TyCon {- instance NamedThing -} )
  53 import TysWiredIn       ( boolTyCon )
  54 import Pretty
  55 import Outputable       ( PprStyle(..) )
  56 import SrcLoc           ( SrcLoc, mkGeneratedSrcLoc )
  57 import Unique           ( Unique )
  58 import UniqFM           ( UniqFM )
  59 import FiniteMap        ( FiniteMap, emptyFM, bagToFM )
  60 import Bag              ( Bag, mapBag, emptyBag, isEmptyBag, snocBag )
  61 import UniqSet
  62 import Util
  63 #if __GLASGOW_HASKELL__ >= 202
  64 import UniqSupply
  65 #endif
  66
  67 infixr 9 `thenRn`, `thenRn_`
  68 \end{code}
  69
  70
  71 %************************************************************************
  72 %*                                                                      *
  73 \subsection{Somewhat magical interface to other monads}
  74 %*                                                                      *
  75 %************************************************************************
  76
  77 \begin{code}
  78 #if __GLASGOW_HASKELL__ >= 200
  79 # define REAL_WORLD RealWorld
  80 #else
  81 # define REAL_WORLD _RealWorld
  82 #endif
  83 \end{code}
  84
  85 \begin{code}
  86 sstToIO :: SST REAL_WORLD r -> IO r
  87 sstToIO sst =
  88     MkIO (
  89     sstToST sst         `thenStrictlyST` \ r ->
  90     returnStrictlyST (Right r))
  91
  92 ioToRnMG :: IO r -> RnMG (Either IOError13 r)
  93 ioToRnMG (MkIO io) rn_down g_down = stToSST io
  94
  95 traceRn :: Doc -> RnMG ()
  96 traceRn msg | opt_D_show_rn_trace = ioToRnMG (hPutStr stderr (show msg) >>
  97                                               hPutStr stderr "\n")      `thenRn_`
  98                                     returnRn ()
  99             | otherwise           = returnRn ()
 100 \end{code}
 101
 102
 103 %************************************************************************
 104 %*                                                                      *
 105 \subsection{Data types}
 106 %*                                                                      *
 107 %************************************************************************
 108
 109 ===================================================
 110                 MONAD TYPES
 111 ===================================================
 112
 113 \begin{code}
 114 type RnM s d r = RnDown s -> d -> SST s r
 115 type RnMS s r   = RnM s          (SDown s) r            -- Renaming source
 116 type RnMG r     = RnM REAL_WORLD GDown     r            -- Getting global names etc
 117 type MutVar a  = MutableVar REAL_WORLD a                -- ToDo: there ought to be a standard defn of this
 118
 119         -- Common part
 120 data RnDown s = RnDown
 121                   SrcLoc
 122                   (MutableVar s RnNameSupply)
 123                   (MutableVar s (Bag Warning, Bag Error))
 124                   (MutableVar s ([Name],[Name]))        -- Occurrences: compulsory and optional resp
 125
 126 data Necessity = Compulsory | Optional          -- We *must* find definitions for
 127                                                 -- compulsory occurrences; we *may* find them
 128                                                 -- for optional ones.
 129
 130         -- For getting global names
 131 data GDown = GDown
 132                 SearchPath
 133                 (MutVar Ifaces)
 134
 135         -- For renaming source code
 136 data SDown s = SDown
 137                   RnEnv                 -- Global envt
 138                   NameEnv               -- Local name envt (includes global name envt,
 139                                         -- but may shadow it)
 140                   Module
 141                   RnSMode
 142
 143
 144 data RnSMode    = SourceMode                    -- Renaming source code
 145                 | InterfaceMode Necessity       -- Renaming interface declarations.  The "necessity"
 146                                                 -- flag says free variables *must* be found and slurped
 147                                                 -- or whether they need not be.  For value signatures of
 148                                                 -- things that are themselves compulsorily imported
 149                                                 -- we arrange that the type signature is read in compulsory mode,
 150                                                 -- but the pragmas in optional mode.
 151
 152 type SearchPath = [(String,String)]     -- List of (directory,suffix) pairs to search
 153                                         -- for interface files.
 154 type FreeVars   = NameSet
 155 \end{code}
 156
 157 ===================================================
 158                 ENVIRONMENTS
 159 ===================================================
 160
 161 \begin{code}
 162 type RnNameSupply = (UniqSupply, Int, FiniteMap (Module,OccName) Name)
 163         -- Ensures that one (m,n) pair gets one unique
 164         -- The Int is used to give a number to each instance declaration;
 165         -- it's really a separate name supply.
 166
 167 data RnEnv      = RnEnv NameEnv FixityEnv
 168 emptyRnEnv      = RnEnv emptyNameEnv emptyFixityEnv
 169
 170 type NameEnv    = FiniteMap RdrName Name
 171 emptyNameEnv    = emptyFM
 172
 173 type FixityEnv          = FiniteMap RdrName (Fixity, Provenance)
 174 emptyFixityEnv          = emptyFM
 175         -- It's possible to have a different fixity for B.op than for op:
 176         --
 177         --      module A( op ) where            module B where
 178         --      import qualified B( op )        infixr 2 op
 179         --      infixl 9 `op`                   op = ...
 180         --      op a b = a `B.op` b
 181
 182 data ExportEnv          = ExportEnv Avails Fixities
 183 type Avails             = [AvailInfo]
 184 type Fixities           = [(OccName, (Fixity, Provenance))]
 185         -- Can contain duplicates, if one module defines the same fixity,
 186         -- or the same type/class/id, more than once.   Hence a boring old list.
 187         -- This allows us to report duplicates in just one place, namely plusRnEnv.
 188
 189 type ExportAvails       = (FiniteMap Module Avails,     -- Used to figure out "module M" export specifiers
 190                                                         -- Includes avails only from *unqualified* imports
 191                                                         -- (see 1.4 Report Section 5.1.1)
 192
 193                            UniqFM AvailInfo)            -- Used to figure out all other export specifiers.
 194                                                         -- Maps a Name to the AvailInfo that contains it
 195                                                         -- NB: Contain bindings for class ops but
 196                                                         -- not constructors (see defn of availEntityNames)
 197
 198
 199 data AvailInfo          = NotAvailable
 200                         | Avail Name            -- An ordinary identifier
 201                         | AvailTC Name          -- The name of the type or class
 202                                   [Name]        -- The available pieces of type/class. NB: If the type or
 203                                                 -- class is itself to be in scope, it must be in this list.
 204                                                 -- Thus, typically: AvailTC Eq [Eq, ==, /=]
 205 \end{code}
 206
 207 ===================================================
 208                 INTERFACE FILE STUFF
 209 ===================================================
 210
 211 \begin{code}
 212 type ExportItem          = (Module, [(OccName, [OccName])])
 213 type VersionInfo name    = [ImportVersion name]
 214 type ImportVersion name  = (Module, Version, [LocalVersion name])
 215 type LocalVersion name   = (name, Version)
 216
 217 data ParsedIface
 218   = ParsedIface
 219       Module                    -- Module name
 220       Version                   -- Module version number
 221       [ImportVersion OccName]           -- Usages
 222       [ExportItem]                      -- Exports
 223       [Module]                          -- Special instance modules
 224       [(OccName,Fixity)]                -- Fixities
 225       [(Version, RdrNameHsDecl)]        -- Local definitions
 226       [RdrNameInstDecl]                 -- Local instance declarations
 227
 228 type InterfaceDetails = (VersionInfo Name,      -- Version information
 229                          ExportEnv,             -- What this module exports
 230                          [Module])              -- Instance modules
 231
 232 type RdrNamePragma = ()                         -- Fudge for now
 233 -------------------
 234
 235 data Ifaces = Ifaces
 236                 Module                                                  -- Name of this module
 237                 (FiniteMap Module Version)
 238                 (FiniteMap Module (Avails, [(OccName,Fixity)]))         -- Exports
 239                 DeclsMap
 240
 241                 NameSet                 -- All the names (whether "big" or "small", whether wired-in or not,
 242                                         -- whether locally defined or not) that have been slurped in so far.
 243
 244                 [(Name,Version)]        -- All the (a) non-wired-in (b) "big" (c) non-locally-defined names that
 245                                         -- have been slurped in so far, with their versions.
 246                                         -- This is used to generate the "usage" information for this module.
 247                                         -- Subset of the previous field.
 248
 249                 (Bag IfaceInst, NameSet) -- The as-yet un-slurped instance decls; this bag is depleted when we
 250                                          -- slurp an instance decl so that we don't slurp the same one twice.
 251                                          -- Together with them is the set of tycons/classes that may allow
 252                                          -- the instance decls in.
 253
 254                 (FiniteMap Name RdrNameTyDecl)
 255                                         -- Deferred data type declarations; each has the following properties
 256                                         --      * it's a data type decl
 257                                         --      * its TyCon is needed
 258                                         --      * the decl may or may not have been slurped, depending on whether any
 259                                         --        of the constrs are needed.
 260
 261                 [Module]                -- Set of modules with "special" instance declarations
 262                                         -- Excludes this module
 263
 264
 265 type DeclsMap    = FiniteMap Name (Version, AvailInfo, RdrNameHsDecl)
 266 type IfaceInst   = ((Module, RdrNameInstDecl),  -- Instance decl
 267                     [Name])                     -- "Gate" names.  Slurp this instance decl when this
 268                                                 -- list becomes empty.  It's depleted whenever we
 269                                                 -- slurp another type or class decl.
 270 \end{code}
 271
 272
 273 %************************************************************************
 274 %*                                                                      *
 275 \subsection{Main monad code}
 276 %*                                                                      *
 277 %************************************************************************
 278
 279 \begin{code}
 280 initRn :: Module -> UniqSupply -> SearchPath -> SrcLoc
 281        -> RnMG r
 282        -> IO (r, Bag Error, Bag Warning)
 283
 284 initRn mod us dirs loc do_rn
 285   = sstToIO $
 286     newMutVarSST (us, 1, builtins)      `thenSST` \ names_var ->
 287     newMutVarSST (emptyBag,emptyBag)    `thenSST` \ errs_var ->
 288     newMutVarSST (emptyIfaces mod)      `thenSST` \ iface_var ->
 289     newMutVarSST initOccs               `thenSST` \ occs_var ->
 290     let
 291         rn_down = RnDown loc names_var errs_var occs_var
 292         g_down  = GDown dirs iface_var
 293     in
 294         -- do the buisness
 295     do_rn rn_down g_down                `thenSST` \ res ->
 296
 297         -- grab errors and return
 298     readMutVarSST errs_var                      `thenSST` \ (warns,errs) ->
 299     returnSST (res, errs, warns)
 300
 301
 302 initRnMS :: RnEnv -> Module -> RnSMode -> RnMS REAL_WORLD r -> RnMG r
 303 initRnMS rn_env@(RnEnv name_env _) mod_name mode m rn_down g_down
 304   = let
 305         s_down = SDown rn_env name_env mod_name mode
 306     in
 307     m rn_down s_down
 308
 309
 310 emptyIfaces :: Module -> Ifaces
 311 emptyIfaces mod = Ifaces mod emptyFM emptyFM emptyFM emptyNameSet [] (emptyBag, emptyNameSet) emptyFM []
 312
 313 builtins :: FiniteMap (Module,OccName) Name
 314 builtins = bagToFM (mapBag (\ name -> (modAndOcc name, name)) builtinNames)
 315
 316         -- Initial value for the occurrence pool.
 317 initOccs :: ([Name],[Name])     -- Compulsory and optional respectively
 318 initOccs = ([getName boolTyCon], [])
 319         -- Booleans occur implicitly a lot, so it's tiresome to keep recording the fact, and
 320         -- rather implausible that not one will be used in the module.
 321         -- We could add some other common types, notably lists, but the general idea is
 322         -- to do as much as possible explicitly.
 323 \end{code}
 324
 325 \end{code}
 326
 327
 328 @renameSourceCode@ is used to rename stuff "out-of-line"; that is, not as part of
 329 the main renamer.  Examples: pragmas (which we don't want to rename unless
 330 we actually explore them); and derived definitions, which are only generated
 331 in the type checker.
 332
 333 The @RnNameSupply@ includes a @UniqueSupply@, so if you call it more than
 334 once you must either split it, or install a fresh unique supply.
 335
 336 \begin{code}
 337 renameSourceCode :: Module
 338                  -> RnNameSupply
 339                  -> RnMS REAL_WORLD r
 340                  -> r
 341
 342 -- Alas, we can't use the real runST, with the desired signature:
 343 --      renameSourceCode :: RnNameSupply -> RnMS s r -> r
 344 -- because we can't manufacture "new versions of runST".
 345
 346 renameSourceCode mod_name name_supply m
 347   = runSST (
 348         newMutVarSST name_supply                `thenSST` \ names_var ->
 349         newMutVarSST (emptyBag,emptyBag)        `thenSST` \ errs_var ->
 350         newMutVarSST ([],[])                    `thenSST` \ occs_var ->
 351         let
 352             rn_down = RnDown mkGeneratedSrcLoc names_var errs_var occs_var
 353             s_down = SDown emptyRnEnv emptyNameEnv mod_name (InterfaceMode Compulsory)
 354         in
 355         m rn_down s_down                        `thenSST` \ result ->
 356
 357         readMutVarSST errs_var                  `thenSST` \ (warns,errs) ->
 358
 359         (if not (isEmptyBag errs) then
 360                 trace ("Urk! renameSourceCode found errors" ++ display errs)
 361          else if not (isEmptyBag warns) then
 362                 trace ("Urk! renameSourceCode found warnings" ++ display warns)
 363          else
 364                 id) $
 365
 366         returnSST result
 367     )
 368   where
 369     display errs = show (pprBagOfErrors PprDebug errs)
 370
 371 {-# INLINE thenRn #-}
 372 {-# INLINE thenRn_ #-}
 373 {-# INLINE returnRn #-}
 374 {-# INLINE andRn #-}
 375
 376 returnRn :: a -> RnM s d a
 377 thenRn   :: RnM s d a -> (a -> RnM s d b) -> RnM s d b
 378 thenRn_  :: RnM s d a -> RnM s d b -> RnM s d b
 379 andRn    :: (a -> a -> a) -> RnM s d a -> RnM s d a -> RnM s d a
 380 mapRn    :: (a -> RnM s d b) -> [a] -> RnM s d [b]
 381 sequenceRn :: [RnM s d a] -> RnM s d [a]
 382 foldlRn :: (b  -> a -> RnM s d b) -> b -> [a] -> RnM s d b
 383 mapAndUnzipRn :: (a -> RnM s d (b,c)) -> [a] -> RnM s d ([b],[c])
 384 fixRn    :: (a -> RnM s d a) -> RnM s d a
 385
 386 returnRn v gdown ldown  = returnSST v
 387 thenRn m k gdown ldown  = m gdown ldown `thenSST` \ r -> k r gdown ldown
 388 thenRn_ m k gdown ldown = m gdown ldown `thenSST_` k gdown ldown
 389 fixRn m gdown ldown = fixSST (\r -> m r gdown ldown)
 390 andRn combiner m1 m2 gdown ldown
 391   = m1 gdown ldown `thenSST` \ res1 ->
 392     m2 gdown ldown `thenSST` \ res2 ->
 393     returnSST (combiner res1 res2)
 394
 395 sequenceRn []     = returnRn []
 396 sequenceRn (m:ms) =  m                  `thenRn` \ r ->
 397                      sequenceRn ms      `thenRn` \ rs ->
 398                      returnRn (r:rs)
 399
 400 mapRn f []     = returnRn []
 401 mapRn f (x:xs)
 402   = f x         `thenRn` \ r ->
 403     mapRn f xs  `thenRn` \ rs ->
 404     returnRn (r:rs)
 405
 406 foldlRn k z [] = returnRn z
 407 foldlRn k z (x:xs) = k z x      `thenRn` \ z' ->
 408                      foldlRn k z' xs
 409
 410 mapAndUnzipRn f [] = returnRn ([],[])
 411 mapAndUnzipRn f (x:xs)
 412   = f x                 `thenRn` \ (r1,  r2)  ->
 413     mapAndUnzipRn f xs  `thenRn` \ (rs1, rs2) ->
 414     returnRn (r1:rs1, r2:rs2)
 415
 416 mapAndUnzip3Rn f [] = returnRn ([],[],[])
 417 mapAndUnzip3Rn f (x:xs)
 418   = f x                 `thenRn` \ (r1,  r2,  r3)  ->
 419     mapAndUnzip3Rn f xs `thenRn` \ (rs1, rs2, rs3) ->
 420     returnRn (r1:rs1, r2:rs2, r3:rs3)
 421 \end{code}
 422
 423
 424
 425 %************************************************************************
 426 %*                                                                      *
 427 \subsection{Boring plumbing for common part}
 428 %*                                                                      *
 429 %************************************************************************
 430
 431
 432 ================  Errors and warnings =====================
 433
 434 \begin{code}
 435 failWithRn :: a -> Error -> RnM s d a
 436 failWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
 437   = readMutVarSST  errs_var                                     `thenSST`  \ (warns,errs) ->
 438     writeMutVarSST errs_var (warns, errs `snocBag` err)         `thenSST_`
 439     returnSST res
 440   where
 441     err = addShortErrLocLine loc msg
 442
 443 warnWithRn :: a -> Warning -> RnM s d a
 444 warnWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
 445   = readMutVarSST  errs_var                                     `thenSST`  \ (warns,errs) ->
 446     writeMutVarSST errs_var (warns `snocBag` warn, errs)        `thenSST_`
 447     returnSST res
 448   where
 449     warn = addShortWarnLocLine loc msg
 450
 451 addErrRn :: Error -> RnM s d ()
 452 addErrRn err = failWithRn () err
 453
 454 checkRn :: Bool -> Error -> RnM s d ()  -- Check that a condition is true
 455 checkRn False err  = addErrRn err
 456 checkRn True err = returnRn ()
 457
 458 addWarnRn :: Warning -> RnM s d ()
 459 addWarnRn warn = warnWithRn () warn
 460
 461 checkErrsRn :: RnM s d Bool             -- True <=> no errors so far
 462 checkErrsRn  (RnDown loc names_var errs_var occs_var) l_down
 463   = readMutVarSST  errs_var                                     `thenSST`  \ (warns,errs) ->
 464     returnSST (isEmptyBag errs)
 465 \end{code}
 466
 467
 468 ================  Source location =====================
 469
 470 \begin{code}
 471 pushSrcLocRn :: SrcLoc -> RnM s d a -> RnM s d a
 472 pushSrcLocRn loc' m (RnDown loc names_var errs_var occs_var) l_down
 473   = m (RnDown loc' names_var errs_var occs_var) l_down
 474
 475 getSrcLocRn :: RnM s d SrcLoc
 476 getSrcLocRn (RnDown loc names_var errs_var occs_var) l_down
 477   = returnSST loc
 478 \end{code}
 479
 480 ================  Name supply =====================
 481
 482 \begin{code}
 483 getNameSupplyRn :: RnM s d RnNameSupply
 484 getNameSupplyRn (RnDown loc names_var errs_var occs_var) l_down
 485   = readMutVarSST names_var
 486
 487 setNameSupplyRn :: RnNameSupply -> RnM s d ()
 488 setNameSupplyRn names' (RnDown loc names_var errs_var occs_var) l_down
 489   = writeMutVarSST names_var names'
 490
 491 -- The "instance-decl unique supply", inst, is just an integer that's used to
 492 -- give a unique number for each instance declaration.
 493 newInstUniq :: RnM s d Int
 494 newInstUniq (RnDown loc names_var errs_var occs_var) l_down
 495   = readMutVarSST names_var                             `thenSST` \ (us, inst, cache) ->
 496     writeMutVarSST names_var (us, inst+1, cache)        `thenSST_`
 497     returnSST inst
 498 \end{code}
 499
 500 ================  Occurrences =====================
 501
 502 Every time we get an occurrence of a name we put it in one of two lists:
 503         one for "compulsory" occurrences
 504         one for "optional" occurrences
 505
 506 The significance of "compulsory" is
 507         (a) we *must* find the declaration
 508         (b) in the case of type or class names, the name is part of the
 509             source level program, and we must slurp in any instance decls
 510             involving it.
 511
 512 We don't need instance decls "optional" names, because the type inference
 513 process will never come across them.  Optional names are buried inside
 514 type checked (but not renamed) cross-module unfoldings and such.
 515
 516 The pair of lists is held in a mutable variable in RnDown.
 517
 518 The lists are kept separate so that we can process all the compulsory occurrences
 519 before any of the optional ones.  Why?  Because suppose we processed an optional
 520 "g", and slurped an interface decl of g::T->T.  Then we'd rename the type T->T in
 521 optional mode.  But if we later need g compulsorily we'll find that it's already
 522 been slurped and will do nothing.  We could, I suppose, rename it a second time,
 523 but it seems simpler just to do all the compulsory ones first.
 524
 525 \begin{code}
 526 addOccurrenceName :: Name -> RnMS s Name        -- Same name returned as passed
 527 addOccurrenceName name (RnDown loc names_var errs_var occs_var)
 528                        (SDown rn_env local_env mod_name mode)
 529   | isLocallyDefinedName name ||
 530     not_necessary necessity
 531   = returnSST name
 532
 533   | otherwise
 534   = readMutVarSST occs_var                      `thenSST` \ (comp_occs, opt_occs) ->
 535     let
 536         new_occ_pair = case necessity of
 537                          Optional   -> (comp_occs, name:opt_occs)
 538                          Compulsory -> (name:comp_occs, opt_occs)
 539     in
 540     writeMutVarSST occs_var new_occ_pair        `thenSST_`
 541     returnSST name
 542   where
 543     necessity = case mode of
 544                   SourceMode              -> Compulsory
 545                   InterfaceMode necessity -> necessity
 546
 547
 548 addOccurrenceNames :: [Name] -> RnMS s ()
 549 addOccurrenceNames names (RnDown loc names_var errs_var occs_var)
 550                          (SDown rn_env local_env mod_name mode)
 551   | not_necessary necessity
 552   = returnSST ()
 553
 554   | otherwise
 555   = readMutVarSST occs_var                      `thenSST` \ (comp_occs, opt_occs) ->
 556     let
 557         new_occ_pair = case necessity of
 558                          Optional   -> (comp_occs, non_local_names ++ opt_occs)
 559                          Compulsory -> (non_local_names ++ comp_occs, opt_occs)
 560     in
 561     writeMutVarSST occs_var new_occ_pair
 562   where
 563     non_local_names = filter (not . isLocallyDefinedName) names
 564     necessity = case mode of
 565                   SourceMode              -> Compulsory
 566                   InterfaceMode necessity -> necessity
 567
 568         -- Never look for optional things if we're
 569         -- ignoring optional input interface information
 570 not_necessary Compulsory = False
 571 not_necessary Optional   = opt_IgnoreIfacePragmas
 572
 573 popOccurrenceName :: Necessity -> RnM s d (Maybe Name)
 574 popOccurrenceName necessity (RnDown loc names_var errs_var occs_var) l_down
 575   = readMutVarSST occs_var                      `thenSST` \ occs ->
 576     case (necessity, occs) of
 577                 -- Find a compulsory occurrence
 578         (Compulsory, (comp:comps, opts)) -> writeMutVarSST occs_var (comps, opts)       `thenSST_`
 579                                             returnSST (Just comp)
 580
 581                 -- Find an optional occurrence
 582                 -- We shouldn't be looking unless we've done all the compulsories
 583         (Optional, (comps, opt:opts)) -> ASSERT( null comps )
 584                                          writeMutVarSST occs_var (comps, opts)  `thenSST_`
 585                                          returnSST (Just opt)
 586
 587                 -- No suitable occurrence
 588         other -> returnSST Nothing
 589
 590 -- findOccurrencesRn does the enclosed thing with a *fresh* occurrences
 591 -- variable, and returns the list of occurrences thus found.  It's useful
 592 -- when loading instance decls and specialisation signatures, when we want to
 593 -- know the names of the things in the types, but we don't want to treat them
 594 -- as occurrences.
 595
 596 findOccurrencesRn :: RnM s d a -> RnM s d [Name]
 597 findOccurrencesRn enclosed_thing (RnDown loc names_var errs_var occs_var) l_down
 598   = newMutVarSST ([],[])                                                `thenSST` \ new_occs_var ->
 599     enclosed_thing (RnDown loc names_var errs_var new_occs_var) l_down  `thenSST_`
 600     readMutVarSST new_occs_var                                          `thenSST` \ (occs,_) ->
 601     returnSST occs
 602 \end{code}
 603
 604
 605 %************************************************************************
 606 %*                                                                      *
 607 \subsection{Plumbing for rename-source part}
 608 %*                                                                      *
 609 %************************************************************************
 610
 611 ================  RnEnv  =====================
 612
 613 \begin{code}
 614 getGlobalNameEnv :: RnMS s NameEnv
 615 getGlobalNameEnv rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)
 616   = returnSST global_env
 617
 618 getNameEnv :: RnMS s NameEnv
 619 getNameEnv rn_down (SDown rn_env local_env mod_name mode)
 620   = returnSST local_env
 621
 622 setNameEnv :: NameEnv -> RnMS s a -> RnMS s a
 623 setNameEnv local_env' m rn_down (SDown rn_env local_env mod_name mode)
 624   = m rn_down (SDown rn_env local_env' mod_name mode)
 625
 626 getFixityEnv :: RnMS s FixityEnv
 627 getFixityEnv rn_down (SDown (RnEnv name_env fixity_env) local_env mod_name mode)
 628   = returnSST fixity_env
 629 \end{code}
 630
 631 ================  Module and Mode =====================
 632
 633 \begin{code}
 634 getModuleRn :: RnMS s Module
 635 getModuleRn rn_down (SDown rn_env local_env mod_name mode)
 636   = returnSST mod_name
 637 \end{code}
 638
 639 \begin{code}
 640 getModeRn :: RnMS s RnSMode
 641 getModeRn rn_down (SDown rn_env local_env mod_name mode)
 642   = returnSST mode
 643
 644 setModeRn :: RnSMode -> RnMS s a -> RnMS s a
 645 setModeRn new_mode thing_inside rn_down (SDown rn_env local_env mod_name mode)
 646   = thing_inside rn_down (SDown rn_env local_env mod_name new_mode)
 647 \end{code}
 648
 649
 650 %************************************************************************
 651 %*                                                                      *
 652 \subsection{Plumbing for rename-globals part}
 653 %*                                                                      *
 654 %************************************************************************
 655
 656 \begin{code}
 657 getIfacesRn :: RnMG Ifaces
 658 getIfacesRn rn_down (GDown dirs iface_var)
 659   = readMutVarSST iface_var
 660
 661 setIfacesRn :: Ifaces -> RnMG ()
 662 setIfacesRn ifaces rn_down (GDown dirs iface_var)
 663   = writeMutVarSST iface_var ifaces
 664
 665 getSearchPathRn :: RnMG SearchPath
 666 getSearchPathRn rn_down (GDown dirs iface_var)
 667   = returnSST dirs
 668 \end{code}