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