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 GenAvailInfo name  = 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 type AvailInfo    = GenAvailInfo Name
 206 type RdrAvailInfo = GenAvailInfo OccName
 207 \end{code}
 208
 209 ===================================================
 210                 INTERFACE FILE STUFF
 211 ===================================================
 212
 213 \begin{code}
 214 type ExportItem          = (Module, IfaceFlavour, [RdrAvailInfo])
 215 type VersionInfo name    = [ImportVersion name]
 216 type ImportVersion name  = (Module, IfaceFlavour, Version, [LocalVersion name])
 217 type LocalVersion name   = (name, Version)
 218
 219 data ParsedIface
 220   = ParsedIface
 221       Module                    -- Module name
 222       Version                   -- Module version number
 223       [ImportVersion OccName]           -- Usages
 224       [ExportItem]                      -- Exports
 225       [Module]                          -- Special instance modules
 226       [(OccName,Fixity)]                -- Fixities
 227       [(Version, RdrNameHsDecl)]        -- Local definitions
 228       [RdrNameInstDecl]                 -- Local instance declarations
 229
 230 type InterfaceDetails = (VersionInfo Name,      -- Version information
 231                          ExportEnv,             -- What this module exports
 232                          [Module])              -- Instance modules
 233
 234 type RdrNamePragma = ()                         -- Fudge for now
 235 -------------------
 236
 237 data Ifaces = Ifaces
 238                 Module                                          -- Name of this module
 239                 (FiniteMap Module (IfaceFlavour,                -- Exports
 240                                    Version,
 241                                    Avails,
 242                                    [(OccName,Fixity)]))
 243                 DeclsMap
 244
 245                 NameSet                 -- All the names (whether "big" or "small", whether wired-in or not,
 246                                         -- whether locally defined or not) that have been slurped in so far.
 247
 248                 [(Name,Version)]        -- All the (a) non-wired-in (b) "big" (c) non-locally-defined names that
 249                                         -- have been slurped in so far, with their versions.
 250                                         -- This is used to generate the "usage" information for this module.
 251                                         -- Subset of the previous field.
 252
 253                 (Bag IfaceInst, NameSet) -- The as-yet un-slurped instance decls; this bag is depleted when we
 254                                          -- slurp an instance decl so that we don't slurp the same one twice.
 255                                          -- Together with them is the set of tycons/classes that may allow
 256                                          -- the instance decls in.
 257
 258                 (FiniteMap Name RdrNameTyDecl)
 259                                         -- Deferred data type declarations; each has the following properties
 260                                         --      * it's a data type decl
 261                                         --      * its TyCon is needed
 262                                         --      * the decl may or may not have been slurped, depending on whether any
 263                                         --        of the constrs are needed.
 264
 265                 [Module]                -- Set of modules with "special" instance declarations
 266                                         -- Excludes this module
 267
 268
 269 type DeclsMap    = FiniteMap Name (Version, AvailInfo, RdrNameHsDecl)
 270 type IfaceInst   = ((Module, RdrNameInstDecl),  -- Instance decl
 271                     [Name])                     -- "Gate" names.  Slurp this instance decl when this
 272                                                 -- list becomes empty.  It's depleted whenever we
 273                                                 -- slurp another type or class decl.
 274 \end{code}
 275
 276
 277 %************************************************************************
 278 %*                                                                      *
 279 \subsection{Main monad code}
 280 %*                                                                      *
 281 %************************************************************************
 282
 283 \begin{code}
 284 initRn :: Module -> UniqSupply -> SearchPath -> SrcLoc
 285        -> RnMG r
 286        -> IO (r, Bag Error, Bag Warning)
 287
 288 initRn mod us dirs loc do_rn
 289   = sstToIO $
 290     newMutVarSST (us, 1, builtins)      `thenSST` \ names_var ->
 291     newMutVarSST (emptyBag,emptyBag)    `thenSST` \ errs_var ->
 292     newMutVarSST (emptyIfaces mod)      `thenSST` \ iface_var ->
 293     newMutVarSST initOccs               `thenSST` \ occs_var ->
 294     let
 295         rn_down = RnDown loc names_var errs_var occs_var
 296         g_down  = GDown dirs iface_var
 297     in
 298         -- do the buisness
 299     do_rn rn_down g_down                `thenSST` \ res ->
 300
 301         -- grab errors and return
 302     readMutVarSST errs_var                      `thenSST` \ (warns,errs) ->
 303     returnSST (res, errs, warns)
 304
 305
 306 initRnMS :: RnEnv -> Module -> RnSMode -> RnMS REAL_WORLD r -> RnMG r
 307 initRnMS rn_env@(RnEnv name_env _) mod_name mode m rn_down g_down
 308   = let
 309         s_down = SDown rn_env name_env mod_name mode
 310     in
 311     m rn_down s_down
 312
 313
 314 emptyIfaces :: Module -> Ifaces
 315 emptyIfaces mod = Ifaces mod emptyFM emptyFM emptyNameSet [] (emptyBag, emptyNameSet) emptyFM []
 316
 317 builtins :: FiniteMap (Module,OccName) Name
 318 builtins = bagToFM (mapBag (\ name -> (modAndOcc name, name)) builtinNames)
 319
 320         -- Initial value for the occurrence pool.
 321 initOccs :: ([Name],[Name])     -- Compulsory and optional respectively
 322 initOccs = ([getName boolTyCon], [])
 323         -- Booleans occur implicitly a lot, so it's tiresome to keep recording the fact, and
 324         -- rather implausible that not one will be used in the module.
 325         -- We could add some other common types, notably lists, but the general idea is
 326         -- to do as much as possible explicitly.
 327 \end{code}
 328
 329 \end{code}
 330
 331
 332 @renameSourceCode@ is used to rename stuff "out-of-line"; that is, not as part of
 333 the main renamer.  Examples: pragmas (which we don't want to rename unless
 334 we actually explore them); and derived definitions, which are only generated
 335 in the type checker.
 336
 337 The @RnNameSupply@ includes a @UniqueSupply@, so if you call it more than
 338 once you must either split it, or install a fresh unique supply.
 339
 340 \begin{code}
 341 renameSourceCode :: Module
 342                  -> RnNameSupply
 343                  -> RnMS REAL_WORLD r
 344                  -> r
 345
 346 -- Alas, we can't use the real runST, with the desired signature:
 347 --      renameSourceCode :: RnNameSupply -> RnMS s r -> r
 348 -- because we can't manufacture "new versions of runST".
 349
 350 renameSourceCode mod_name name_supply m
 351   = runSST (
 352         newMutVarSST name_supply                `thenSST` \ names_var ->
 353         newMutVarSST (emptyBag,emptyBag)        `thenSST` \ errs_var ->
 354         newMutVarSST ([],[])                    `thenSST` \ occs_var ->
 355         let
 356             rn_down = RnDown mkGeneratedSrcLoc names_var errs_var occs_var
 357             s_down = SDown emptyRnEnv emptyNameEnv mod_name (InterfaceMode Compulsory)
 358         in
 359         m rn_down s_down                        `thenSST` \ result ->
 360
 361         readMutVarSST errs_var                  `thenSST` \ (warns,errs) ->
 362
 363         (if not (isEmptyBag errs) then
 364                 trace ("Urk! renameSourceCode found errors" ++ display errs)
 365          else if not (isEmptyBag warns) then
 366                 trace ("Urk! renameSourceCode found warnings" ++ display warns)
 367          else
 368                 id) $
 369
 370         returnSST result
 371     )
 372   where
 373     display errs = show (pprBagOfErrors PprDebug errs)
 374
 375 {-# INLINE thenRn #-}
 376 {-# INLINE thenRn_ #-}
 377 {-# INLINE returnRn #-}
 378 {-# INLINE andRn #-}
 379
 380 returnRn :: a -> RnM s d a
 381 thenRn   :: RnM s d a -> (a -> RnM s d b) -> RnM s d b
 382 thenRn_  :: RnM s d a -> RnM s d b -> RnM s d b
 383 andRn    :: (a -> a -> a) -> RnM s d a -> RnM s d a -> RnM s d a
 384 mapRn    :: (a -> RnM s d b) -> [a] -> RnM s d [b]
 385 sequenceRn :: [RnM s d a] -> RnM s d [a]
 386 foldlRn :: (b  -> a -> RnM s d b) -> b -> [a] -> RnM s d b
 387 mapAndUnzipRn :: (a -> RnM s d (b,c)) -> [a] -> RnM s d ([b],[c])
 388 fixRn    :: (a -> RnM s d a) -> RnM s d a
 389
 390 returnRn v gdown ldown  = returnSST v
 391 thenRn m k gdown ldown  = m gdown ldown `thenSST` \ r -> k r gdown ldown
 392 thenRn_ m k gdown ldown = m gdown ldown `thenSST_` k gdown ldown
 393 fixRn m gdown ldown = fixSST (\r -> m r gdown ldown)
 394 andRn combiner m1 m2 gdown ldown
 395   = m1 gdown ldown `thenSST` \ res1 ->
 396     m2 gdown ldown `thenSST` \ res2 ->
 397     returnSST (combiner res1 res2)
 398
 399 sequenceRn []     = returnRn []
 400 sequenceRn (m:ms) =  m                  `thenRn` \ r ->
 401                      sequenceRn ms      `thenRn` \ rs ->
 402                      returnRn (r:rs)
 403
 404 mapRn f []     = returnRn []
 405 mapRn f (x:xs)
 406   = f x         `thenRn` \ r ->
 407     mapRn f xs  `thenRn` \ rs ->
 408     returnRn (r:rs)
 409
 410 foldlRn k z [] = returnRn z
 411 foldlRn k z (x:xs) = k z x      `thenRn` \ z' ->
 412                      foldlRn k z' xs
 413
 414 mapAndUnzipRn f [] = returnRn ([],[])
 415 mapAndUnzipRn f (x:xs)
 416   = f x                 `thenRn` \ (r1,  r2)  ->
 417     mapAndUnzipRn f xs  `thenRn` \ (rs1, rs2) ->
 418     returnRn (r1:rs1, r2:rs2)
 419
 420 mapAndUnzip3Rn f [] = returnRn ([],[],[])
 421 mapAndUnzip3Rn f (x:xs)
 422   = f x                 `thenRn` \ (r1,  r2,  r3)  ->
 423     mapAndUnzip3Rn f xs `thenRn` \ (rs1, rs2, rs3) ->
 424     returnRn (r1:rs1, r2:rs2, r3:rs3)
 425 \end{code}
 426
 427
 428
 429 %************************************************************************
 430 %*                                                                      *
 431 \subsection{Boring plumbing for common part}
 432 %*                                                                      *
 433 %************************************************************************
 434
 435
 436 ================  Errors and warnings =====================
 437
 438 \begin{code}
 439 failWithRn :: a -> Error -> RnM s d a
 440 failWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
 441   = readMutVarSST  errs_var                                     `thenSST`  \ (warns,errs) ->
 442     writeMutVarSST errs_var (warns, errs `snocBag` err)         `thenSST_`
 443     returnSST res
 444   where
 445     err = addShortErrLocLine loc msg
 446
 447 warnWithRn :: a -> Warning -> RnM s d a
 448 warnWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
 449   = readMutVarSST  errs_var                                     `thenSST`  \ (warns,errs) ->
 450     writeMutVarSST errs_var (warns `snocBag` warn, errs)        `thenSST_`
 451     returnSST res
 452   where
 453     warn = addShortWarnLocLine loc msg
 454
 455 addErrRn :: Error -> RnM s d ()
 456 addErrRn err = failWithRn () err
 457
 458 checkRn :: Bool -> Error -> RnM s d ()  -- Check that a condition is true
 459 checkRn False err  = addErrRn err
 460 checkRn True err = returnRn ()
 461
 462 addWarnRn :: Warning -> RnM s d ()
 463 addWarnRn warn = warnWithRn () warn
 464
 465 checkErrsRn :: RnM s d Bool             -- True <=> no errors so far
 466 checkErrsRn  (RnDown loc names_var errs_var occs_var) l_down
 467   = readMutVarSST  errs_var                                     `thenSST`  \ (warns,errs) ->
 468     returnSST (isEmptyBag errs)
 469 \end{code}
 470
 471
 472 ================  Source location =====================
 473
 474 \begin{code}
 475 pushSrcLocRn :: SrcLoc -> RnM s d a -> RnM s d a
 476 pushSrcLocRn loc' m (RnDown loc names_var errs_var occs_var) l_down
 477   = m (RnDown loc' names_var errs_var occs_var) l_down
 478
 479 getSrcLocRn :: RnM s d SrcLoc
 480 getSrcLocRn (RnDown loc names_var errs_var occs_var) l_down
 481   = returnSST loc
 482 \end{code}
 483
 484 ================  Name supply =====================
 485
 486 \begin{code}
 487 getNameSupplyRn :: RnM s d RnNameSupply
 488 getNameSupplyRn (RnDown loc names_var errs_var occs_var) l_down
 489   = readMutVarSST names_var
 490
 491 setNameSupplyRn :: RnNameSupply -> RnM s d ()
 492 setNameSupplyRn names' (RnDown loc names_var errs_var occs_var) l_down
 493   = writeMutVarSST names_var names'
 494
 495 -- The "instance-decl unique supply", inst, is just an integer that's used to
 496 -- give a unique number for each instance declaration.
 497 newInstUniq :: RnM s d Int
 498 newInstUniq (RnDown loc names_var errs_var occs_var) l_down
 499   = readMutVarSST names_var                             `thenSST` \ (us, inst, cache) ->
 500     writeMutVarSST names_var (us, inst+1, cache)        `thenSST_`
 501     returnSST inst
 502 \end{code}
 503
 504 ================  Occurrences =====================
 505
 506 Every time we get an occurrence of a name we put it in one of two lists:
 507         one for "compulsory" occurrences
 508         one for "optional" occurrences
 509
 510 The significance of "compulsory" is
 511         (a) we *must* find the declaration
 512         (b) in the case of type or class names, the name is part of the
 513             source level program, and we must slurp in any instance decls
 514             involving it.
 515
 516 We don't need instance decls "optional" names, because the type inference
 517 process will never come across them.  Optional names are buried inside
 518 type checked (but not renamed) cross-module unfoldings and such.
 519
 520 The pair of lists is held in a mutable variable in RnDown.
 521
 522 The lists are kept separate so that we can process all the compulsory occurrences
 523 before any of the optional ones.  Why?  Because suppose we processed an optional
 524 "g", and slurped an interface decl of g::T->T.  Then we'd rename the type T->T in
 525 optional mode.  But if we later need g compulsorily we'll find that it's already
 526 been slurped and will do nothing.  We could, I suppose, rename it a second time,
 527 but it seems simpler just to do all the compulsory ones first.
 528
 529 \begin{code}
 530 addOccurrenceName :: Name -> RnMS s Name        -- Same name returned as passed
 531 addOccurrenceName name (RnDown loc names_var errs_var occs_var)
 532                        (SDown rn_env local_env mod_name mode)
 533   | isLocallyDefinedName name ||
 534     not_necessary necessity
 535   = returnSST name
 536
 537   | otherwise
 538   = readMutVarSST occs_var                      `thenSST` \ (comp_occs, opt_occs) ->
 539     let
 540         new_occ_pair = case necessity of
 541                          Optional   -> (comp_occs, name:opt_occs)
 542                          Compulsory -> (name:comp_occs, opt_occs)
 543     in
 544     writeMutVarSST occs_var new_occ_pair        `thenSST_`
 545     returnSST name
 546   where
 547     necessity = case mode of
 548                   SourceMode              -> Compulsory
 549                   InterfaceMode necessity -> necessity
 550
 551
 552 addOccurrenceNames :: [Name] -> RnMS s ()
 553 addOccurrenceNames names (RnDown loc names_var errs_var occs_var)
 554                          (SDown rn_env local_env mod_name mode)
 555   | not_necessary necessity
 556   = returnSST ()
 557
 558   | otherwise
 559   = readMutVarSST occs_var                      `thenSST` \ (comp_occs, opt_occs) ->
 560     let
 561         new_occ_pair = case necessity of
 562                          Optional   -> (comp_occs, non_local_names ++ opt_occs)
 563                          Compulsory -> (non_local_names ++ comp_occs, opt_occs)
 564     in
 565     writeMutVarSST occs_var new_occ_pair
 566   where
 567     non_local_names = filter (not . isLocallyDefinedName) names
 568     necessity = case mode of
 569                   SourceMode              -> Compulsory
 570                   InterfaceMode necessity -> necessity
 571
 572         -- Never look for optional things if we're
 573         -- ignoring optional input interface information
 574 not_necessary Compulsory = False
 575 not_necessary Optional   = opt_IgnoreIfacePragmas
 576
 577 popOccurrenceName :: Necessity -> RnM s d (Maybe Name)
 578 popOccurrenceName necessity (RnDown loc names_var errs_var occs_var) l_down
 579   = readMutVarSST occs_var                      `thenSST` \ occs ->
 580     case (necessity, occs) of
 581                 -- Find a compulsory occurrence
 582         (Compulsory, (comp:comps, opts)) -> writeMutVarSST occs_var (comps, opts)       `thenSST_`
 583                                             returnSST (Just comp)
 584
 585                 -- Find an optional occurrence
 586                 -- We shouldn't be looking unless we've done all the compulsories
 587         (Optional, (comps, opt:opts)) -> ASSERT( null comps )
 588                                          writeMutVarSST occs_var (comps, opts)  `thenSST_`
 589                                          returnSST (Just opt)
 590
 591                 -- No suitable occurrence
 592         other -> returnSST Nothing
 593
 594 -- findOccurrencesRn does the enclosed thing with a *fresh* occurrences
 595 -- variable, and returns the list of occurrences thus found.  It's useful
 596 -- when loading instance decls and specialisation signatures, when we want to
 597 -- know the names of the things in the types, but we don't want to treat them
 598 -- as occurrences.
 599
 600 findOccurrencesRn :: RnM s d a -> RnM s d [Name]
 601 findOccurrencesRn enclosed_thing (RnDown loc names_var errs_var occs_var) l_down
 602   = newMutVarSST ([],[])                                                `thenSST` \ new_occs_var ->
 603     enclosed_thing (RnDown loc names_var errs_var new_occs_var) l_down  `thenSST_`
 604     readMutVarSST new_occs_var                                          `thenSST` \ (occs,_) ->
 605     returnSST occs
 606 \end{code}
 607
 608
 609 %************************************************************************
 610 %*                                                                      *
 611 \subsection{Plumbing for rename-source part}
 612 %*                                                                      *
 613 %************************************************************************
 614
 615 ================  RnEnv  =====================
 616
 617 \begin{code}
 618 getGlobalNameEnv :: RnMS s NameEnv
 619 getGlobalNameEnv rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)
 620   = returnSST global_env
 621
 622 getNameEnv :: RnMS s NameEnv
 623 getNameEnv rn_down (SDown rn_env local_env mod_name mode)
 624   = returnSST local_env
 625
 626 setNameEnv :: NameEnv -> RnMS s a -> RnMS s a
 627 setNameEnv local_env' m rn_down (SDown rn_env local_env mod_name mode)
 628   = m rn_down (SDown rn_env local_env' mod_name mode)
 629
 630 getFixityEnv :: RnMS s FixityEnv
 631 getFixityEnv rn_down (SDown (RnEnv name_env fixity_env) local_env mod_name mode)
 632   = returnSST fixity_env
 633 \end{code}
 634
 635 ================  Module and Mode =====================
 636
 637 \begin{code}
 638 getModuleRn :: RnMS s Module
 639 getModuleRn rn_down (SDown rn_env local_env mod_name mode)
 640   = returnSST mod_name
 641 \end{code}
 642
 643 \begin{code}
 644 getModeRn :: RnMS s RnSMode
 645 getModeRn rn_down (SDown rn_env local_env mod_name mode)
 646   = returnSST mode
 647
 648 setModeRn :: RnSMode -> RnMS s a -> RnMS s a
 649 setModeRn new_mode thing_inside rn_down (SDown rn_env local_env mod_name mode)
 650   = thing_inside rn_down (SDown rn_env local_env mod_name new_mode)
 651 \end{code}
 652
 653
 654 %************************************************************************
 655 %*                                                                      *
 656 \subsection{Plumbing for rename-globals part}
 657 %*                                                                      *
 658 %************************************************************************
 659
 660 \begin{code}
 661 getIfacesRn :: RnMG Ifaces
 662 getIfacesRn rn_down (GDown dirs iface_var)
 663   = readMutVarSST iface_var
 664
 665 setIfacesRn :: Ifaces -> RnMG ()
 666 setIfacesRn ifaces rn_down (GDown dirs iface_var)
 667   = writeMutVarSST iface_var ifaces
 668
 669 getSearchPathRn :: RnMG SearchPath
 670 getSearchPathRn rn_down (GDown dirs iface_var)
 671   = returnSST dirs
 672 \end{code}