[project @ 2000-07-14 08:17:36 by simonpj]
[ghc-hetmet.git] / 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, RenamedDeprecation )
38 import BasicTypes       ( Version, defaultFixity )
39 import SrcLoc           ( noSrcLoc )
40 import ErrUtils         ( addShortErrLocLine, addShortWarnLocLine,
41                           pprBagOfErrors, ErrMsg, WarnMsg, Message
42                         )
43 import RdrName          ( RdrName, dummyRdrVarName, rdrNameOcc,
44                           RdrNameEnv, emptyRdrEnv, extendRdrEnv, 
45                           lookupRdrEnv, addListToRdrEnv, rdrEnvToList, rdrEnvElts
46                         )
47 import Name             ( Name, OccName, NamedThing(..), getSrcLoc,
48                           isLocallyDefinedName, nameModule, nameOccName,
49                           decode, mkLocalName, mkUnboundName,
50                           NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, extendNameEnvList
51                         )
52 import Module           ( Module, ModuleName, ModuleHiMap, SearchPath, WhereFrom,
53                           mkModuleHiMaps, moduleName, mkSearchPath
54                         )
55 import NameSet          
56 import CmdLineOpts      ( opt_D_dump_rn_trace, opt_HiMap )
57 import PrelInfo         ( builtinNames )
58 import SrcLoc           ( SrcLoc, mkGeneratedSrcLoc )
59 import Unique           ( Unique, getUnique, unboundKey )
60 import FiniteMap        ( FiniteMap, emptyFM, bagToFM, lookupFM, addToFM, addListToFM, 
61                           addListToFM_C, addToFM_C, eltsFM, fmToList
62                         )
63 import Bag              ( Bag, mapBag, emptyBag, isEmptyBag, snocBag )
64 import UniqSupply
65 import Outputable
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 ioToRnM :: IO r -> RnM d (Either IOError r)
79 ioToRnM io rn_down g_down = (io >>= \ ok -> return (Right ok)) 
80                             `catch` 
81                             (\ err -> return (Left err))
82             
83 traceRn :: SDoc -> RnM d ()
84 traceRn msg | opt_D_dump_rn_trace = putDocRn msg
85             | otherwise           = returnRn ()
86
87 putDocRn :: SDoc -> RnM d ()
88 putDocRn msg = ioToRnM (printErrs msg)  `thenRn_`
89                returnRn ()
90 \end{code}
91
92
93 %************************************************************************
94 %*                                                                      *
95 \subsection{Data types}
96 %*                                                                      *
97 %************************************************************************
98
99 %===================================================
100 \subsubsection{         MONAD TYPES}
101 %===================================================
102
103 \begin{code}
104 type RnM d r = RnDown -> d -> IO r
105 type RnMS r  = RnM SDown r              -- Renaming source
106 type RnMG r  = RnM ()    r              -- Getting global names etc
107
108         -- Common part
109 data RnDown = RnDown {
110                   rn_mod     :: ModuleName,
111                   rn_loc     :: SrcLoc,
112                   rn_ns      :: IORef RnNameSupply,
113                   rn_errs    :: IORef (Bag WarnMsg, Bag ErrMsg),
114                   rn_ifaces  :: IORef Ifaces,
115                   rn_hi_maps :: (SearchPath,    -- For error messages
116                                  ModuleHiMap,   -- for .hi files
117                                  ModuleHiMap)   -- for .hi-boot files
118                 }
119
120         -- For renaming source code
121 data SDown = SDown {
122                   rn_mode :: RnMode,
123
124                   rn_genv :: GlobalRdrEnv,
125                         --   Global envt; the fixity component gets extended
126                         --   with local fixity decls
127
128                   rn_lenv :: LocalRdrEnv,       -- Local name envt
129                         --   Does *not* include global name envt; may shadow it
130                         --   Includes both ordinary variables and type variables;
131                         --   they are kept distinct because tyvar have a different
132                         --   occurrence contructor (Name.TvOcc)
133                         -- We still need the unsullied global name env so that
134                         --   we can look up record field names
135
136                   rn_fixenv :: FixityEnv        -- Local fixities
137                         -- The global fixities are held in the
138                         -- rn_ifaces field.  Why?  See the comments
139                         -- with RnIfaces.lookupFixity
140                 }
141
142 data RnMode     = SourceMode                    -- Renaming source code
143                 | InterfaceMode                 -- Renaming interface declarations.  
144 \end{code}
145
146 %===================================================
147 \subsubsection{         ENVIRONMENTS}
148 %===================================================
149
150 \begin{code}
151 --------------------------------
152 type GlobalRdrEnv = RdrNameEnv [Name]   -- The list is because there may be name clashes
153                                         -- These only get reported on lookup,
154                                         -- not on construction
155 type LocalRdrEnv  = RdrNameEnv Name
156
157 --------------------------------
158 type FixityEnv = NameEnv RenamedFixitySig
159         -- We keep the whole fixity sig so that we
160         -- can report line-number info when there is a duplicate
161         -- fixity declaration
162
163 lookupFixity :: FixityEnv -> Name -> Fixity
164 lookupFixity env name
165   = case lookupNameEnv env name of 
166         Just (FixitySig _ fix _) -> fix
167         Nothing                  -> defaultFixity
168
169 --------------------------------
170 type DeprecationEnv = NameEnv DeprecTxt
171 \end{code}
172
173 \begin{code}
174 --------------------------------
175 type RnNameSupply
176  = ( UniqSupply
177
178    , FiniteMap String Int
179         -- This is used as a name supply for dictionary functions
180         -- From the inst decl we derive a string, usually by glomming together
181         -- the class and tycon name -- but it doesn't matter exactly how;
182         -- this map then gives a unique int for each inst decl with that
183         -- string.  (In Haskell 98 there can only be one,
184         -- but not so in more extended versions; also class CC type T
185         -- and class C type TT might both give the string CCT
186         --      
187         -- We could just use one Int for all the instance decls, but this
188         -- way the uniques change less when you add an instance decl,   
189         -- hence less recompilation
190
191    , FiniteMap (ModuleName, OccName) Name
192         -- Ensures that one (module,occname) pair gets one unique
193    , FiniteMap OccName Name
194         -- Ensures that one implicit parameter name gets one unique
195    )
196
197
198 --------------------------------
199 type Avails       = [AvailInfo]
200
201 type ExportAvails = (FiniteMap ModuleName Avails,
202         -- Used to figure out "module M" export specifiers
203         -- Includes avails only from *unqualified* imports
204         -- (see 1.4 Report Section 5.1.1)
205
206                      AvailEnv)  -- Used to figure out all other export specifiers.
207                         
208
209 data GenAvailInfo name  = Avail name     -- An ordinary identifier
210                         | AvailTC name   -- The name of the type or class
211                                   [name] -- The available pieces of type/class.
212                                          -- NB: If the type or class is itself
213                                          -- to be in scope, it must be in this list.
214                                          -- Thus, typically: AvailTC Eq [Eq, ==, /=]
215                         deriving( Eq )
216                         -- Equality used when deciding if the interface has changed
217
218 type AvailEnv     = NameEnv AvailInfo   -- Maps a Name to the AvailInfo that contains it
219 type AvailInfo    = GenAvailInfo Name
220 type RdrAvailInfo = GenAvailInfo OccName
221 \end{code}
222
223 %===================================================
224 \subsubsection{         INTERFACE FILE STUFF}
225 %===================================================
226
227 \begin{code}
228 type ExportItem          = (ModuleName, [RdrAvailInfo])
229
230 type ImportVersion name  = (ModuleName, WhetherHasOrphans, IsBootInterface, WhatsImported name)
231
232 type ModVersionInfo     = (Version,             -- Version of the whole module
233                            Version,             -- Version number for all fixity decls together
234                            Version)             -- ...ditto all rules together
235
236 type WhetherHasOrphans   = Bool
237         -- An "orphan" is 
238         --      * an instance decl in a module other than the defn module for 
239         --              one of the tycons or classes in the instance head
240         --      * a transformation rule in a module other than the one defining
241         --              the function in the head of the rule.
242
243 type IsBootInterface     = Bool
244
245 data WhatsImported name  = NothingAtAll                         -- The module is below us in the
246                                                                 -- hierarchy, but we import nothing
247
248                          | Everything Version                   -- The module version
249
250                          | Specifically Version                 -- Module version
251                                         Version                 -- Fixity version
252                                         Version                 -- Rules version
253                                         [(name,Version)]        -- List guaranteed non-empty
254                          deriving( Eq )
255         -- 'Specifically' doesn't let you say "I imported f but none of the fixities in
256         -- the module. If you use anything in the module you get its fixity and rule version
257         -- So if the fixities or rules change, you'll recompile, even if you don't use either.
258         -- This is easy to implement, and it's safer: you might not have used the rules last
259         -- time round, but if someone has added a new rule you might need it this time
260
261         -- 'Everything' means there was a "module M" in 
262         -- this module's export list, so we just have to go by M's version,
263         -- not the list of (name,version) pairs
264
265 data ParsedIface
266   = ParsedIface {
267       pi_mod       :: Module,                           -- Complete with package info
268       pi_vers      :: Version,                          -- Module version number
269       pi_orphan    :: WhetherHasOrphans,                -- Whether this module has orphans
270       pi_usages    :: [ImportVersion OccName],          -- Usages
271       pi_exports   :: [ExportItem],                     -- Exports
272       pi_insts     :: [RdrNameInstDecl],                -- Local instance declarations
273       pi_decls     :: [(Version, RdrNameHsDecl)],       -- Local definitions
274       pi_fixity    :: (Version, [RdrNameFixitySig]),    -- Local fixity declarations, with their version
275       pi_rules     :: (Version, [RdrNameRuleDecl]),     -- Rules, with their version
276       pi_deprecs   :: [RdrNameDeprecation]              -- Deprecations
277     }
278
279
280 type RdrNamePragma = ()                         -- Fudge for now
281 -------------------
282
283 data Ifaces = Ifaces {
284                 iImpModInfo :: ImportedModuleInfo,
285                                 -- Modules this one depends on: that is, the union 
286                                 -- of the modules its *direct* imports depend on.
287                                 -- NB: The direct imports have .hi files that enumerate *all* the
288                                 -- dependencies (direct or not) of the imported module.
289
290                 iDecls :: DeclsMap,     -- A single, global map of Names to decls
291
292                 iDeferred :: NameSet,   -- data (not newtype) TyCons that have been slurped, 
293                                         -- but none of their constructors have.
294                                         -- If this is still the case right at the end
295                                         -- we can get away with importing them abstractly
296
297                 iFixes :: FixityEnv,    
298                                 -- A single, global map of Names to fixities
299                                 -- See comments with RnIfaces.lookupFixity
300
301                 iSlurp :: NameSet,
302                 -- All the names (whether "big" or "small", whether wired-in or not,
303                 -- whether locally defined or not) that have been slurped in so far.
304
305                 iVSlurp :: [(Name,Version)],
306                 -- All the (a) non-wired-in (b) "big" (c) non-locally-defined 
307                 -- names that have been slurped in so far, with their versions.
308                 -- This is used to generate the "usage" information for this module.
309                 -- Subset of the previous field.
310
311                 iInsts :: IfaceInsts,
312                 -- The as-yet un-slurped instance decls; this bag is depleted when we
313                 -- slurp an instance decl so that we don't slurp the same one twice.
314                 -- Each is 'gated' by the names that must be available before
315                 -- this instance decl is needed.
316
317                 iRules :: IfaceRules,
318                 -- Similar to instance decls, only for rules
319
320                 iDeprecs :: DeprecationEnv
321         }
322
323 type IfaceInsts = Bag GatedDecl
324 type IfaceRules = Bag GatedDecl
325
326 type GatedDecl = (NameSet, (Module, RdrNameHsDecl))
327
328 type ImportedModuleInfo 
329      = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface, 
330                              Maybe (Module, Version, Version, Version, WhereFrom, Avails))
331                                 -- The three Versions are module version, fixity version, rules version
332
333                 -- Suppose the domain element is module 'A'
334                 --
335                 -- The first Bool is True if A contains 
336                 -- 'orphan' rules or instance decls
337
338                 -- The second Bool is true if the interface file actually
339                 -- read was an .hi-boot file
340
341                 -- Nothing => A's interface not yet read, but this module has
342                 --            imported a module, B, that itself depends on A
343                 --
344                 -- Just xx => A's interface has been read.  The Module in 
345                 --              the Just has the correct Dll flag
346
347                 -- This set is used to decide whether to look for
348                 -- A.hi or A.hi-boot when importing A.f.
349                 -- Basically, we look for A.hi if A is in the map, and A.hi-boot
350                 -- otherwise
351
352 type DeclsMap = NameEnv (Version, AvailInfo, Bool, (Module, RdrNameHsDecl))
353                 -- A DeclsMap contains a binding for each Name in the declaration
354                 -- including the constructors of a type decl etc.
355                 -- The Bool is True just for the 'main' Name.
356 \end{code}
357
358
359 %************************************************************************
360 %*                                                                      *
361 \subsection{Main monad code}
362 %*                                                                      *
363 %************************************************************************
364
365 \begin{code}
366 initRn :: ModuleName -> UniqSupply -> SearchPath -> SrcLoc
367        -> RnMG r
368        -> IO (r, Bag ErrMsg, Bag WarnMsg)
369
370 initRn mod us dirs loc do_rn = do
371   himaps    <- mkModuleHiMaps dirs
372   names_var <- newIORef (us, emptyFM, builtins, emptyFM)
373   errs_var  <- newIORef (emptyBag,emptyBag)
374   iface_var <- newIORef emptyIfaces 
375   let
376         rn_down = RnDown { rn_loc = loc, rn_ns = names_var, 
377                            rn_errs = errs_var, 
378                            rn_hi_maps = himaps, 
379                            rn_ifaces = iface_var,
380                            rn_mod = mod }
381
382         -- do the business
383   res <- do_rn rn_down ()
384
385         -- grab errors and return
386   (warns, errs) <- readIORef errs_var
387
388   return (res, errs, warns)
389
390
391 initRnMS :: GlobalRdrEnv -> FixityEnv -> RnMode -> RnMS r -> RnM d r
392 initRnMS rn_env fixity_env mode thing_inside rn_down g_down
393   = let
394         s_down = SDown { rn_genv = rn_env, rn_lenv = emptyRdrEnv, 
395                          rn_fixenv = fixity_env, rn_mode = mode }
396     in
397     thing_inside rn_down s_down
398
399 initIfaceRnMS :: Module -> RnMS r -> RnM d r
400 initIfaceRnMS mod thing_inside 
401   = initRnMS emptyRdrEnv emptyNameEnv InterfaceMode $
402     setModuleRn (moduleName mod) thing_inside
403
404 emptyIfaces :: Ifaces
405 emptyIfaces = Ifaces { iImpModInfo = emptyFM,
406                        iDecls = emptyNameEnv,
407                        iDeferred = emptyNameSet,
408                        iFixes = emptyNameEnv,
409                        iSlurp = unitNameSet (mkUnboundName dummyRdrVarName),
410                         -- Pretend that the dummy unbound name has already been
411                         -- slurped.  This is what's returned for an out-of-scope name,
412                         -- and we don't want thereby to try to suck it in!
413                        iVSlurp = [],
414                        iInsts = emptyBag,
415                        iRules = emptyBag,
416                        iDeprecs = emptyNameEnv
417               }
418
419 builtins :: FiniteMap (ModuleName,OccName) Name
420 builtins = 
421    bagToFM (
422    mapBag (\ name ->  ((moduleName (nameModule name), nameOccName name), name))
423           builtinNames)
424 \end{code}
425
426 @renameSourceCode@ is used to rename stuff ``out-of-line'';
427 that is, not as part of the main renamer.
428 Sole examples: derived definitions,
429 which are only generated in the type checker.
430
431 The @RnNameSupply@ includes a @UniqueSupply@, so if you call it more than
432 once you must either split it, or install a fresh unique supply.
433
434 \begin{code}
435 renameSourceCode :: ModuleName
436                  -> RnNameSupply
437                  -> RnMS r
438                  -> r
439
440 renameSourceCode mod_name name_supply m
441   = unsafePerformIO (
442         -- It's not really unsafe!  When renaming source code we
443         -- only do any I/O if we need to read in a fixity declaration;
444         -- and that doesn't happen in pragmas etc
445
446         mkModuleHiMaps (mkSearchPath opt_HiMap) >>= \ himaps ->
447         newIORef name_supply            >>= \ names_var ->
448         newIORef (emptyBag,emptyBag)    >>= \ errs_var ->
449         let
450             rn_down = RnDown { rn_loc = mkGeneratedSrcLoc, rn_ns = names_var,
451                                rn_errs = errs_var, rn_hi_maps = himaps,
452                                rn_mod = mod_name, 
453                                rn_ifaces = panic "rnameSourceCode: rn_ifaces"  -- Not required
454                              }
455             s_down = SDown { rn_mode = InterfaceMode,
456                                -- So that we can refer to PrelBase.True etc
457                              rn_genv = emptyRdrEnv, rn_lenv = emptyRdrEnv,
458                              rn_fixenv = emptyNameEnv }
459         in
460         m rn_down s_down                        >>= \ result ->
461         
462         readIORef errs_var                      >>= \ (warns,errs) ->
463
464         (if not (isEmptyBag errs) then
465                 pprTrace "Urk! renameSourceCode found errors" (display errs) 
466 #ifdef DEBUG
467          else if not (isEmptyBag warns) then
468                 pprTrace "Note: renameSourceCode found warnings" (display warns)
469 #endif
470          else
471                 id) $
472
473         return result
474     )
475   where
476     display errs = pprBagOfErrors errs
477
478 {-# INLINE thenRn #-}
479 {-# INLINE thenRn_ #-}
480 {-# INLINE returnRn #-}
481 {-# INLINE andRn #-}
482
483 returnRn :: a -> RnM d a
484 thenRn   :: RnM d a -> (a -> RnM d b) -> RnM d b
485 thenRn_  :: RnM d a -> RnM d b -> RnM d b
486 andRn    :: (a -> a -> a) -> RnM d a -> RnM d a -> RnM d a
487 mapRn    :: (a -> RnM d b) -> [a] -> RnM d [b]
488 mapRn_   :: (a -> RnM d b) -> [a] -> RnM d ()
489 mapMaybeRn :: (a -> RnM d (Maybe b)) -> [a] -> RnM d [b]
490 flatMapRn  :: (a -> RnM d [b])       -> [a] -> RnM d [b]
491 sequenceRn :: [RnM d a] -> RnM d [a]
492 foldlRn :: (b  -> a -> RnM d b) -> b -> [a] -> RnM d b
493 mapAndUnzipRn :: (a -> RnM d (b,c)) -> [a] -> RnM d ([b],[c])
494 fixRn    :: (a -> RnM d a) -> RnM d a
495
496 returnRn v gdown ldown  = return v
497 thenRn m k gdown ldown  = m gdown ldown >>= \ r -> k r gdown ldown
498 thenRn_ m k gdown ldown = m gdown ldown >> k gdown ldown
499 fixRn m gdown ldown = fixIO (\r -> m r gdown ldown)
500 andRn combiner m1 m2 gdown ldown
501   = m1 gdown ldown >>= \ res1 ->
502     m2 gdown ldown >>= \ res2 ->
503     return (combiner res1 res2)
504
505 sequenceRn []     = returnRn []
506 sequenceRn (m:ms) =  m                  `thenRn` \ r ->
507                      sequenceRn ms      `thenRn` \ rs ->
508                      returnRn (r:rs)
509
510 mapRn f []     = returnRn []
511 mapRn f (x:xs)
512   = f x         `thenRn` \ r ->
513     mapRn f xs  `thenRn` \ rs ->
514     returnRn (r:rs)
515
516 mapRn_ f []     = returnRn ()
517 mapRn_ f (x:xs) = 
518     f x         `thenRn_`
519     mapRn_ f xs
520
521 foldlRn k z [] = returnRn z
522 foldlRn k z (x:xs) = k z x      `thenRn` \ z' ->
523                      foldlRn k z' xs
524
525 mapAndUnzipRn f [] = returnRn ([],[])
526 mapAndUnzipRn f (x:xs)
527   = f x                 `thenRn` \ (r1,  r2)  ->
528     mapAndUnzipRn f xs  `thenRn` \ (rs1, rs2) ->
529     returnRn (r1:rs1, r2:rs2)
530
531 mapAndUnzip3Rn f [] = returnRn ([],[],[])
532 mapAndUnzip3Rn f (x:xs)
533   = f x                 `thenRn` \ (r1,  r2,  r3)  ->
534     mapAndUnzip3Rn f xs `thenRn` \ (rs1, rs2, rs3) ->
535     returnRn (r1:rs1, r2:rs2, r3:rs3)
536
537 mapMaybeRn f []     = returnRn []
538 mapMaybeRn f (x:xs) = f x               `thenRn` \ maybe_r ->
539                       mapMaybeRn f xs   `thenRn` \ rs ->
540                       case maybe_r of
541                         Nothing -> returnRn rs
542                         Just r  -> returnRn (r:rs)
543
544 flatMapRn f []     = returnRn []
545 flatMapRn f (x:xs) = f x                `thenRn` \ r ->
546                      flatMapRn f xs     `thenRn` \ rs ->
547                      returnRn (r ++ rs)
548 \end{code}
549
550
551
552 %************************************************************************
553 %*                                                                      *
554 \subsection{Boring plumbing for common part}
555 %*                                                                      *
556 %************************************************************************
557
558
559 %================
560 \subsubsection{  Errors and warnings}
561 %=====================
562
563 \begin{code}
564 failWithRn :: a -> Message -> RnM d a
565 failWithRn res msg (RnDown {rn_errs = errs_var, rn_loc = loc}) l_down
566   = readIORef  errs_var                                         >>=  \ (warns,errs) ->
567     writeIORef errs_var (warns, errs `snocBag` err)             >> 
568     return res
569   where
570     err = addShortErrLocLine loc msg
571
572 warnWithRn :: a -> Message -> RnM d a
573 warnWithRn res msg (RnDown {rn_errs = errs_var, rn_loc = loc}) l_down
574   = readIORef  errs_var                                         >>=  \ (warns,errs) ->
575     writeIORef errs_var (warns `snocBag` warn, errs)    >> 
576     return res
577   where
578     warn = addShortWarnLocLine loc msg
579
580 addErrRn :: Message -> RnM d ()
581 addErrRn err = failWithRn () err
582
583 checkRn :: Bool -> Message -> RnM d ()  -- Check that a condition is true
584 checkRn False err = addErrRn err
585 checkRn True  err = returnRn ()
586
587 warnCheckRn :: Bool -> Message -> RnM d ()      -- Check that a condition is true
588 warnCheckRn False err = addWarnRn err
589 warnCheckRn True  err = returnRn ()
590
591 addWarnRn :: Message -> RnM d ()
592 addWarnRn warn = warnWithRn () warn
593
594 checkErrsRn :: RnM d Bool               -- True <=> no errors so far
595 checkErrsRn (RnDown {rn_errs = errs_var}) l_down
596   = readIORef  errs_var                                         >>=  \ (warns,errs) ->
597     return (isEmptyBag errs)
598 \end{code}
599
600
601 %================
602 \subsubsection{  Source location}
603 %=====================
604
605 \begin{code}
606 pushSrcLocRn :: SrcLoc -> RnM d a -> RnM d a
607 pushSrcLocRn loc' m down l_down
608   = m (down {rn_loc = loc'}) l_down
609
610 getSrcLocRn :: RnM d SrcLoc
611 getSrcLocRn down l_down
612   = return (rn_loc down)
613 \end{code}
614
615 %================
616 \subsubsection{  Name supply}
617 %=====================
618
619 \begin{code}
620 getNameSupplyRn :: RnM d RnNameSupply
621 getNameSupplyRn rn_down l_down
622   = readIORef (rn_ns rn_down)
623
624 setNameSupplyRn :: RnNameSupply -> RnM d ()
625 setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
626   = writeIORef names_var names'
627
628 -- See comments with RnNameSupply above.
629 newInstUniq :: String -> RnM d Int
630 newInstUniq key (RnDown {rn_ns = names_var}) l_down
631   = readIORef names_var                         >>= \ (us, mapInst, cache, ipcache) ->
632     let
633         uniq = case lookupFM mapInst key of
634                    Just x  -> x+1
635                    Nothing -> 0
636         mapInst' = addToFM mapInst key uniq
637     in
638     writeIORef names_var (us, mapInst', cache, ipcache) >>
639     return uniq
640
641 getUniqRn :: RnM d Unique
642 getUniqRn (RnDown {rn_ns = names_var}) l_down
643  = readIORef names_var >>= \ (us, mapInst, cache, ipcache) ->
644    let
645      (us1,us') = splitUniqSupply us
646    in
647    writeIORef names_var (us', mapInst, cache, ipcache)  >>
648    return (uniqFromSupply us1)
649 \end{code}
650
651 %================
652 \subsubsection{  Module}
653 %=====================
654
655 \begin{code}
656 getModuleRn :: RnM d ModuleName
657 getModuleRn (RnDown {rn_mod = mod_name}) l_down
658   = return mod_name
659
660 setModuleRn :: ModuleName -> RnM d a -> RnM d a
661 setModuleRn new_mod enclosed_thing rn_down l_down
662   = enclosed_thing (rn_down {rn_mod = new_mod}) l_down
663 \end{code}
664
665
666 %************************************************************************
667 %*                                                                      *
668 \subsection{Plumbing for rename-source part}
669 %*                                                                      *
670 %************************************************************************
671
672 %================
673 \subsubsection{  RnEnv}
674 %=====================
675
676 \begin{code}
677 getNameEnvs :: RnMS (GlobalRdrEnv, LocalRdrEnv)
678 getNameEnvs rn_down (SDown {rn_genv = global_env, rn_lenv = local_env})
679   = return (global_env, local_env)
680
681 getLocalNameEnv :: RnMS LocalRdrEnv
682 getLocalNameEnv rn_down (SDown {rn_lenv = local_env})
683   = return local_env
684
685 setLocalNameEnv :: LocalRdrEnv -> RnMS a -> RnMS a
686 setLocalNameEnv local_env' m rn_down l_down
687   = m rn_down (l_down {rn_lenv = local_env'})
688
689 getFixityEnv :: RnMS FixityEnv
690 getFixityEnv rn_down (SDown {rn_fixenv = fixity_env})
691   = return fixity_env
692
693 extendFixityEnv :: [(Name, RenamedFixitySig)] -> RnMS a -> RnMS a
694 extendFixityEnv fixes enclosed_scope
695                 rn_down l_down@(SDown {rn_fixenv = fixity_env})
696   = let
697         new_fixity_env = extendNameEnvList fixity_env fixes
698     in
699     enclosed_scope rn_down (l_down {rn_fixenv = new_fixity_env})
700 \end{code}
701
702 %================
703 \subsubsection{  Mode}
704 %=====================
705
706 \begin{code}
707 getModeRn :: RnMS RnMode
708 getModeRn rn_down (SDown {rn_mode = mode})
709   = return mode
710
711 setModeRn :: RnMode -> RnMS a -> RnMS a
712 setModeRn new_mode thing_inside rn_down l_down
713   = thing_inside rn_down (l_down {rn_mode = new_mode})
714 \end{code}
715
716
717 %************************************************************************
718 %*                                                                      *
719 \subsection{Plumbing for rename-globals part}
720 %*                                                                      *
721 %************************************************************************
722
723 \begin{code}
724 getIfacesRn :: RnM d Ifaces
725 getIfacesRn (RnDown {rn_ifaces = iface_var}) _
726   = readIORef iface_var
727
728 setIfacesRn :: Ifaces -> RnM d ()
729 setIfacesRn ifaces (RnDown {rn_ifaces = iface_var}) _
730   = writeIORef iface_var ifaces
731
732 getHiMaps :: RnM d (SearchPath, ModuleHiMap, ModuleHiMap)
733 getHiMaps (RnDown {rn_hi_maps = himaps}) _ 
734   = return himaps
735 \end{code}
736 \end{code}