2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnMonad]{The monad used by the renamer}
21 #include "HsVersions.h"
24 import GlaExts ( RealWorld, stToIO )
25 import List ( intersperse )
29 import RnHsSyn ( RenamedFixitySig )
30 import BasicTypes ( Version, IfaceFlavour(..) )
31 import SrcLoc ( noSrcLoc )
32 import ErrUtils ( addShortErrLocLine, addShortWarnLocLine,
33 pprBagOfErrors, ErrMsg, WarnMsg
35 import Name ( Module, Name, OccName, PrintUnqualified,
36 isLocallyDefinedName, pprModule,
37 modAndOcc, NamedThing(..)
40 import CmdLineOpts ( opt_D_show_rn_trace, opt_IgnoreIfacePragmas, opt_WarnHiShadows )
41 import PrelInfo ( builtinNames )
42 import TysWiredIn ( boolTyCon )
43 import SrcLoc ( SrcLoc, mkGeneratedSrcLoc )
44 import Unique ( Unique )
45 import UniqFM ( UniqFM )
46 import FiniteMap ( FiniteMap, emptyFM, bagToFM, lookupFM, addToFM, addListToFM,
47 addListToFM_C, addToFM_C, eltsFM
49 import Bag ( Bag, mapBag, emptyBag, isEmptyBag, snocBag )
50 import Maybes ( seqMaybe, mapMaybe )
56 import DirUtils ( getDirectoryContents )
57 import IO ( hPutStrLn, stderr, isDoesNotExistError )
58 import Monad ( foldM )
59 import Maybe ( fromMaybe )
60 import Constants ( interfaceFileFormatVersion )
62 infixr 9 `thenRn`, `thenRn_`
66 %************************************************************************
68 \subsection{Somewhat magical interface to other monads}
70 %************************************************************************
73 sstToIO :: SST RealWorld r -> IO r
74 sstToIO sst = stToIO (sstToST sst)
76 ioToRnMG :: IO r -> RnMG (Either IOError r)
77 ioToRnMG io rn_down g_down = ioToSST io
79 traceRn :: SDoc -> RnMG ()
80 traceRn msg | opt_D_show_rn_trace = putDocRn msg
81 | otherwise = returnRn ()
83 putDocRn :: SDoc -> RnMG ()
84 putDocRn msg = ioToRnMG (printErrs msg) `thenRn_`
89 %************************************************************************
91 \subsection{Data types}
93 %************************************************************************
95 ===================================================
97 ===================================================
100 type RnM s d r = RnDown s -> d -> SST s r
101 type RnMS s r = RnM s (SDown s) r -- Renaming source
102 type RnMG r = RnM RealWorld GDown r -- Getting global names etc
103 type SSTRWRef a = SSTRef RealWorld a -- ToDo: there ought to be a standard defn of this
106 data RnDown s = RnDown
108 (SSTRef s RnNameSupply)
109 (SSTRef s (Bag WarnMsg, Bag ErrMsg))
110 (SSTRef s ([Occurrence],[Occurrence])) -- Occurrences: compulsory and optional resp
112 type Occurrence = (Name, SrcLoc) -- The srcloc is the occurrence site
114 data Necessity = Compulsory | Optional -- We *must* find definitions for
115 -- compulsory occurrences; we *may* find them
116 -- for optional ones.
118 -- For getting global names
120 ModuleHiMap -- for .hi files
121 ModuleHiMap -- for .hi-boot files
124 -- For renaming source code
126 RnEnv -- Global envt; the fixity component gets extended
127 -- with local fixity decls
128 LocalRdrEnv -- Local name envt
129 -- Does *not* includes 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
139 data RnSMode = SourceMode -- Renaming source code
140 | InterfaceMode -- Renaming interface declarations.
141 Necessity -- The "necessity"
142 -- flag says free variables *must* be found and slurped
143 -- or whether they need not be. For value signatures of
144 -- things that are themselves compulsorily imported
145 -- we arrange that the type signature is read
146 -- in compulsory mode,
147 -- but the pragmas in optional mode.
149 type SearchPath = [(String,String)] -- List of (directory,suffix) pairs to search
150 -- for interface files.
152 type ModuleHiMap = FiniteMap String String
153 -- mapping from module name to the file path of its corresponding
157 ===================================================
159 ===================================================
162 --------------------------------
163 type RdrNameEnv a = FiniteMap RdrName a
164 type GlobalRdrEnv = RdrNameEnv [Name] -- The list is because there may be name clashes
165 -- These only get reported on lookup,
166 -- not on construction
167 type LocalRdrEnv = RdrNameEnv Name
169 emptyRdrEnv :: RdrNameEnv a
170 lookupRdrEnv :: RdrNameEnv a -> RdrName -> Maybe a
171 addListToRdrEnv :: RdrNameEnv a -> [(RdrName,a)] -> RdrNameEnv a
173 emptyRdrEnv = emptyFM
174 lookupRdrEnv = lookupFM
175 addListToRdrEnv = addListToFM
178 --------------------------------
179 type NameEnv a = UniqFM a -- Domain is Name
181 emptyNameEnv :: NameEnv a
182 nameEnvElts :: NameEnv a -> [a]
183 addToNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
184 addToNameEnv :: NameEnv a -> Name -> a -> NameEnv a
185 plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a
186 extendNameEnv :: NameEnv a -> [(Name,a)] -> NameEnv a
187 lookupNameEnv :: NameEnv a -> Name -> Maybe a
188 delFromNameEnv :: NameEnv a -> Name -> NameEnv a
189 elemNameEnv :: Name -> NameEnv a -> Bool
191 emptyNameEnv = emptyUFM
192 nameEnvElts = eltsUFM
193 addToNameEnv_C = addToUFM_C
194 addToNameEnv = addToUFM
195 plusNameEnv = plusUFM
196 extendNameEnv = addListToUFM
197 lookupNameEnv = lookupUFM
198 delFromNameEnv = delFromUFM
199 elemNameEnv = elemUFM
201 --------------------------------
202 type FixityEnv = NameEnv RenamedFixitySig
204 --------------------------------
205 data RnEnv = RnEnv GlobalRdrEnv FixityEnv
206 emptyRnEnv = RnEnv emptyRdrEnv emptyNameEnv
210 --------------------------------
214 , FiniteMap (OccName, OccName) Int
215 -- This is used as a name supply for dictionary functions
216 -- From the inst decl we derive a (class, tycon) pair;
217 -- this map then gives a unique int for each inst decl with that
218 -- (class, tycon) pair. (In Haskell 98 there can only be one,
219 -- but not so in more extended versions.)
221 -- We could just use one Int for all the instance decls, but this
222 -- way the uniques change less when you add an instance decl,
223 -- hence less recompilation
225 , FiniteMap (Module,OccName) Name
226 -- Ensures that one (module,occname) pair gets one unique
230 --------------------------------
231 data ExportEnv = ExportEnv Avails Fixities
232 type Avails = [AvailInfo]
233 type Fixities = [(Name, Fixity)]
235 type ExportAvails = (FiniteMap Module Avails, -- Used to figure out "module M" export specifiers
236 -- Includes avails only from *unqualified* imports
237 -- (see 1.4 Report Section 5.1.1)
239 NameEnv AvailInfo) -- Used to figure out all other export specifiers.
240 -- Maps a Name to the AvailInfo that contains it
243 data GenAvailInfo name = NotAvailable
244 | Avail name -- An ordinary identifier
245 | AvailTC name -- The name of the type or class
246 [name] -- The available pieces of type/class. NB: If the type or
247 -- class is itself to be in scope, it must be in this list.
248 -- Thus, typically: AvailTC Eq [Eq, ==, /=]
249 type AvailInfo = GenAvailInfo Name
250 type RdrAvailInfo = GenAvailInfo OccName
253 ===================================================
255 ===================================================
258 type ExportItem = (Module, IfaceFlavour, [RdrAvailInfo])
259 type VersionInfo name = [ImportVersion name]
261 type ImportVersion name = (Module, IfaceFlavour, Version, WhatsImported name)
262 data WhatsImported name = Everything
263 | Specifically [LocalVersion name] -- List guaranteed non-empty
265 -- ("M", hif, ver, Everything) means there was a "module M" in
266 -- this module's export list, so we just have to go by M's version, "ver",
267 -- not the list of LocalVersions.
270 type LocalVersion name = (name, Version)
274 Module -- Module name
275 Version -- Module version number
276 [ImportVersion OccName] -- Usages
277 [ExportItem] -- Exports
278 [Module] -- Special instance modules
279 [(Version, RdrNameHsDecl)] -- Local definitions
280 [RdrNameInstDecl] -- Local instance declarations
282 type InterfaceDetails = (VersionInfo Name, -- Version information for what this module imports
283 ExportEnv, -- What this module exports
284 [Module]) -- Instance modules
286 type RdrNamePragma = () -- Fudge for now
289 data Ifaces = Ifaces {
290 iMod :: Module, -- Name of this module
292 iModMap :: FiniteMap Module (IfaceFlavour, -- Exports
296 iDecls :: DeclsMap, -- A single, global map of Names to decls
298 iFixes :: FixityEnv, -- A single, global map of Names to fixities
300 iSlurp :: NameSet, -- All the names (whether "big" or "small", whether wired-in or not,
301 -- whether locally defined or not) that have been slurped in so far.
303 iVSlurp :: [(Name,Version)], -- All the (a) non-wired-in (b) "big" (c) non-locally-defined names that
304 -- have been slurped in so far, with their versions.
305 -- This is used to generate the "usage" information for this module.
306 -- Subset of the previous field.
308 iDefInsts :: (Bag IfaceInst, NameSet),
309 -- The as-yet un-slurped instance decls; this bag is depleted when we
310 -- slurp an instance decl so that we don't slurp the same one twice.
311 -- Together with them is the set of tycons/classes that may allow
312 -- the instance decls in.
314 iDefData :: NameEnv (Module, RdrNameTyClDecl),
315 -- Deferred data type declarations; each has the following properties
316 -- * it's a data type decl
317 -- * its TyCon is needed
318 -- * the decl may or may not have been slurped, depending on whether any
319 -- of the constrs are needed.
321 iInstMods :: [Module] -- Set of modules with "special" instance declarations
322 -- Excludes this module
326 type DeclsMap = NameEnv (Version, AvailInfo, RdrNameHsDecl, Bool)
327 -- A DeclsMap contains a binding for each Name in the declaration
328 -- including the constructors of a type decl etc.
329 -- The Bool is True just for the 'main' Name.
331 type IfaceInst = ((Module, RdrNameInstDecl), -- Instance decl
332 NameSet) -- "Gate" names. Slurp this instance decl when this
333 -- set becomes empty. It's depleted whenever we
334 -- slurp another type or class decl.
338 %************************************************************************
340 \subsection{Main monad code}
342 %************************************************************************
345 initRn :: Module -> UniqSupply -> SearchPath -> SrcLoc
347 -> IO (r, Bag ErrMsg, Bag WarnMsg)
349 initRn mod us dirs loc do_rn = do
350 names_var <- sstToIO (newMutVarSST (us, emptyFM, builtins))
351 errs_var <- sstToIO (newMutVarSST (emptyBag,emptyBag))
352 iface_var <- sstToIO (newMutVarSST (emptyIfaces mod))
353 occs_var <- sstToIO (newMutVarSST initOccs)
354 (himap, hibmap) <- mkModuleHiMaps dirs
356 rn_down = RnDown loc names_var errs_var occs_var
357 g_down = GDown himap hibmap iface_var
360 res <- sstToIO (do_rn rn_down g_down)
362 -- grab errors and return
363 (warns, errs) <- sstToIO (readMutVarSST errs_var)
364 return (res, errs, warns)
367 initRnMS :: RnEnv -> Module -> RnSMode -> RnMS RealWorld r -> RnMG r
368 initRnMS rn_env@(RnEnv name_env _) mod_name mode m rn_down g_down
370 s_down = SDown rn_env emptyRdrEnv mod_name mode
375 emptyIfaces :: Module -> Ifaces
376 emptyIfaces mod = Ifaces { iMod = mod,
378 iDecls = emptyNameEnv,
379 iFixes = emptyNameEnv,
380 iSlurp = emptyNameSet,
382 iDefInsts = (emptyBag, emptyNameSet),
383 iDefData = emptyNameEnv,
387 builtins :: FiniteMap (Module,OccName) Name
388 builtins = bagToFM (mapBag (\ name -> (modAndOcc name, name)) builtinNames)
390 -- Initial value for the occurrence pool.
391 initOccs :: ([Occurrence],[Occurrence]) -- Compulsory and optional respectively
392 initOccs = ([(getName boolTyCon, noSrcLoc)], [])
393 -- Booleans occur implicitly a lot, so it's tiresome to keep recording the fact, and
394 -- rather implausible that not one will be used in the module.
395 -- We could add some other common types, notably lists, but the general idea is
396 -- to do as much as possible explicitly.
400 mkModuleHiMaps :: SearchPath -> IO (ModuleHiMap, ModuleHiMap)
401 mkModuleHiMaps dirs = foldM (getAllFilesMatching dirs) (env,env) dirs
405 getAllFilesMatching :: SearchPath
406 -> (ModuleHiMap, ModuleHiMap)
407 -> (FilePath, String)
408 -> IO (ModuleHiMap, ModuleHiMap)
409 getAllFilesMatching dirs hims (dir_path, suffix) = ( do
410 -- fpaths entries do not have dir_path prepended
411 fpaths <- getDirectoryContents dir_path
412 return (foldl addModules hims fpaths)
417 ("Import path element `" ++ dir_path ++
418 if (isDoesNotExistError err) then
419 "' does not exist, ignoring."
421 "' couldn't read, ignoring.")
426 xiffus = reverse dotted_suffix
434 hi_boot_version_xiffus =
435 reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus
436 hi_boot_xiffus = "toob-ih." -- .hi-boot reversed.
438 addModules his@(hi_env, hib_env) nm = fromMaybe his $
439 map (\ (mod_nm,v) -> (addToFM_C addNewOne hi_env mod_nm v, hib_env))
440 (go xiffus rev_nm) `seqMaybe`
442 map (\ (mod_nm,v) -> (hi_env, addToFM_C overrideNew hib_env mod_nm v))
443 (go hi_boot_version_xiffus rev_nm) `seqMaybe`
445 map (\ (mod_nm,v) -> (hi_env, addToFM_C addNewOne hib_env mod_nm v))
446 (go hi_boot_xiffus rev_nm)
450 go [] xs = Just (reverse xs, dir_path ++'/':nm)
454 | otherwise = Nothing
457 | opt_WarnHiShadows = conflict
458 | otherwise = stickWithOld
460 stickWithOld old new = old
461 overrideNew old new = new
463 conflict old_path new_path
464 | old_path /= new_path =
465 pprTrace "Warning: " (text "Identically named interface files present on import path, " $$
466 text (show old_path) <+> text "shadows" $$
467 text (show new_path) $$
468 text "on the import path: " <+>
469 text (concat (intersperse ":" (map fst dirs))))
471 | otherwise = old_path -- don't warn about innocous shadowings.
476 @renameSourceCode@ is used to rename stuff "out-of-line"; that is, not as part of
477 the main renamer. Examples: pragmas (which we don't want to rename unless
478 we actually explore them); and derived definitions, which are only generated
481 The @RnNameSupply@ includes a @UniqueSupply@, so if you call it more than
482 once you must either split it, or install a fresh unique supply.
485 renameSourceCode :: Module
490 -- Alas, we can't use the real runST, with the desired signature:
491 -- renameSourceCode :: RnNameSupply -> RnMS s r -> r
492 -- because we can't manufacture "new versions of runST".
494 renameSourceCode mod_name name_supply m
496 newMutVarSST name_supply `thenSST` \ names_var ->
497 newMutVarSST (emptyBag,emptyBag) `thenSST` \ errs_var ->
498 newMutVarSST ([],[]) `thenSST` \ occs_var ->
500 rn_down = RnDown mkGeneratedSrcLoc names_var errs_var occs_var
501 s_down = SDown emptyRnEnv emptyRdrEnv mod_name (InterfaceMode Compulsory)
503 m rn_down s_down `thenSST` \ result ->
505 readMutVarSST errs_var `thenSST` \ (warns,errs) ->
507 (if not (isEmptyBag errs) then
508 pprTrace "Urk! renameSourceCode found errors" (display errs)
510 else if not (isEmptyBag warns) then
511 pprTrace "Urk! renameSourceCode found warnings" (display warns)
519 display errs = pprBagOfErrors errs
521 {-# INLINE thenRn #-}
522 {-# INLINE thenRn_ #-}
523 {-# INLINE returnRn #-}
526 returnRn :: a -> RnM s d a
527 thenRn :: RnM s d a -> (a -> RnM s d b) -> RnM s d b
528 thenRn_ :: RnM s d a -> RnM s d b -> RnM s d b
529 andRn :: (a -> a -> a) -> RnM s d a -> RnM s d a -> RnM s d a
530 mapRn :: (a -> RnM s d b) -> [a] -> RnM s d [b]
531 mapMaybeRn :: (a -> RnM s d b) -> b -> Maybe a -> RnM s d b
532 sequenceRn :: [RnM s d a] -> RnM s d [a]
533 foldlRn :: (b -> a -> RnM s d b) -> b -> [a] -> RnM s d b
534 mapAndUnzipRn :: (a -> RnM s d (b,c)) -> [a] -> RnM s d ([b],[c])
535 fixRn :: (a -> RnM s d a) -> RnM s d a
537 returnRn v gdown ldown = returnSST v
538 thenRn m k gdown ldown = m gdown ldown `thenSST` \ r -> k r gdown ldown
539 thenRn_ m k gdown ldown = m gdown ldown `thenSST_` k gdown ldown
540 fixRn m gdown ldown = fixSST (\r -> m r gdown ldown)
541 andRn combiner m1 m2 gdown ldown
542 = m1 gdown ldown `thenSST` \ res1 ->
543 m2 gdown ldown `thenSST` \ res2 ->
544 returnSST (combiner res1 res2)
546 sequenceRn [] = returnRn []
547 sequenceRn (m:ms) = m `thenRn` \ r ->
548 sequenceRn ms `thenRn` \ rs ->
551 mapRn f [] = returnRn []
553 = f x `thenRn` \ r ->
554 mapRn f xs `thenRn` \ rs ->
557 foldlRn k z [] = returnRn z
558 foldlRn k z (x:xs) = k z x `thenRn` \ z' ->
561 mapAndUnzipRn f [] = returnRn ([],[])
562 mapAndUnzipRn f (x:xs)
563 = f x `thenRn` \ (r1, r2) ->
564 mapAndUnzipRn f xs `thenRn` \ (rs1, rs2) ->
565 returnRn (r1:rs1, r2:rs2)
567 mapAndUnzip3Rn f [] = returnRn ([],[],[])
568 mapAndUnzip3Rn f (x:xs)
569 = f x `thenRn` \ (r1, r2, r3) ->
570 mapAndUnzip3Rn f xs `thenRn` \ (rs1, rs2, rs3) ->
571 returnRn (r1:rs1, r2:rs2, r3:rs3)
573 mapMaybeRn f def Nothing = returnRn def
574 mapMaybeRn f def (Just v) = f v
579 %************************************************************************
581 \subsection{Boring plumbing for common part}
583 %************************************************************************
586 ================ Errors and warnings =====================
589 failWithRn :: a -> ErrMsg -> RnM s d a
590 failWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
591 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
592 writeMutVarSST errs_var (warns, errs `snocBag` err) `thenSST_`
595 err = addShortErrLocLine loc msg
597 warnWithRn :: a -> WarnMsg -> RnM s d a
598 warnWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
599 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
600 writeMutVarSST errs_var (warns `snocBag` warn, errs) `thenSST_`
603 warn = addShortWarnLocLine loc msg
605 addErrRn :: ErrMsg -> RnM s d ()
606 addErrRn err = failWithRn () err
608 checkRn :: Bool -> ErrMsg -> RnM s d () -- Check that a condition is true
609 checkRn False err = addErrRn err
610 checkRn True err = returnRn ()
612 warnCheckRn :: Bool -> ErrMsg -> RnM s d () -- Check that a condition is true
613 warnCheckRn False err = addWarnRn err
614 warnCheckRn True err = returnRn ()
616 addWarnRn :: WarnMsg -> RnM s d ()
617 addWarnRn warn = warnWithRn () warn
619 checkErrsRn :: RnM s d Bool -- True <=> no errors so far
620 checkErrsRn (RnDown loc names_var errs_var occs_var) l_down
621 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
622 returnSST (isEmptyBag errs)
626 ================ Source location =====================
629 pushSrcLocRn :: SrcLoc -> RnM s d a -> RnM s d a
630 pushSrcLocRn loc' m (RnDown loc names_var errs_var occs_var) l_down
631 = m (RnDown loc' names_var errs_var occs_var) l_down
633 getSrcLocRn :: RnM s d SrcLoc
634 getSrcLocRn (RnDown loc names_var errs_var occs_var) l_down
638 ================ Name supply =====================
641 getNameSupplyRn :: RnM s d RnNameSupply
642 getNameSupplyRn (RnDown loc names_var errs_var occs_var) l_down
643 = readMutVarSST names_var
645 setNameSupplyRn :: RnNameSupply -> RnM s d ()
646 setNameSupplyRn names' (RnDown loc names_var errs_var occs_var) l_down
647 = writeMutVarSST names_var names'
649 -- See comments with RnNameSupply above.
650 newInstUniq :: (OccName, OccName) -> RnM s d Int
651 newInstUniq key (RnDown loc names_var errs_var occs_var) l_down
652 = readMutVarSST names_var `thenSST` \ (us, mapInst, cache) ->
654 uniq = case lookupFM mapInst key of
657 mapInst' = addToFM mapInst key uniq
659 writeMutVarSST names_var (us, mapInst', cache) `thenSST_`
663 ================ Occurrences =====================
665 Every time we get an occurrence of a name we put it in one of two lists:
666 one for "compulsory" occurrences
667 one for "optional" occurrences
669 The significance of "compulsory" is
670 (a) we *must* find the declaration
671 (b) in the case of type or class names, the name is part of the
672 source level program, and we must slurp in any instance decls
675 We don't need instance decls "optional" names, because the type inference
676 process will never come across them. Optional names are buried inside
677 type checked (but not renamed) cross-module unfoldings and such.
679 The pair of lists is held in a mutable variable in RnDown.
681 The lists are kept separate so that we can process all the compulsory occurrences
682 before any of the optional ones. Why? Because suppose we processed an optional
683 "g", and slurped an interface decl of g::T->T. Then we'd rename the type T->T in
684 optional mode. But if we later need g compulsorily we'll find that it's already
685 been slurped and will do nothing. We could, I suppose, rename it a second time,
686 but it seems simpler just to do all the compulsory ones first.
689 addOccurrenceName :: Name -> RnMS s Name -- Same name returned as passed
690 addOccurrenceName name (RnDown loc names_var errs_var occs_var)
691 (SDown rn_env local_env mod_name mode)
692 | isLocallyDefinedName name ||
693 not_necessary necessity
697 = readMutVarSST occs_var `thenSST` \ (comp_occs, opt_occs) ->
699 new_occ_pair = case necessity of
700 Optional -> (comp_occs, (name,loc):opt_occs)
701 Compulsory -> ((name,loc):comp_occs, opt_occs)
703 writeMutVarSST occs_var new_occ_pair `thenSST_`
706 necessity = modeToNecessity mode
709 addOccurrenceNames :: [Name] -> RnMS s ()
710 addOccurrenceNames names (RnDown loc names_var errs_var occs_var)
711 (SDown rn_env local_env mod_name mode)
712 | not_necessary necessity
716 = readMutVarSST occs_var `thenSST` \ (comp_occs, opt_occs) ->
718 new_occ_pair = case necessity of
719 Optional -> (comp_occs, non_local_occs ++ opt_occs)
720 Compulsory -> (non_local_occs ++ comp_occs, opt_occs)
722 writeMutVarSST occs_var new_occ_pair
724 non_local_occs = [(name, loc) | name <- names, not (isLocallyDefinedName name)]
725 necessity = modeToNecessity mode
727 -- Never look for optional things if we're
728 -- ignoring optional input interface information
729 not_necessary Compulsory = False
730 not_necessary Optional = opt_IgnoreIfacePragmas
732 popOccurrenceName :: RnSMode -> RnM s d (Maybe Occurrence)
733 popOccurrenceName mode (RnDown loc names_var errs_var occs_var) l_down
734 = readMutVarSST occs_var `thenSST` \ occs ->
736 -- Find a compulsory occurrence
737 (InterfaceMode Compulsory, (comp:comps, opts))
738 -> writeMutVarSST occs_var (comps, opts) `thenSST_`
739 returnSST (Just comp)
741 -- Find an optional occurrence
742 -- We shouldn't be looking unless we've done all the compulsories
743 (InterfaceMode Optional, (comps, opt:opts))
744 -> ASSERT2( null comps, ppr comps )
745 writeMutVarSST occs_var (comps, opts) `thenSST_`
748 -- No suitable occurrence
749 other -> returnSST Nothing
751 -- discardOccurrencesRn does the enclosed thing with a *fresh* occurrences
752 -- variable, and discards the list of occurrences thus found. It's useful
753 -- when loading instance decls and specialisation signatures, when we want to
754 -- know the names of the things in the types, but we don't want to treat them
757 discardOccurrencesRn :: RnM s d a -> RnM s d a
758 discardOccurrencesRn enclosed_thing (RnDown loc names_var errs_var occs_var) l_down
759 = newMutVarSST ([],[]) `thenSST` \ new_occs_var ->
760 enclosed_thing (RnDown loc names_var errs_var new_occs_var) l_down
764 %************************************************************************
766 \subsection{Plumbing for rename-source part}
768 %************************************************************************
770 ================ RnEnv =====================
773 getNameEnvs :: RnMS s (GlobalRdrEnv, LocalRdrEnv)
774 getNameEnvs rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)
775 = returnSST (global_env, local_env)
777 getLocalNameEnv :: RnMS s LocalRdrEnv
778 getLocalNameEnv rn_down (SDown rn_env local_env mod_name mode)
779 = returnSST local_env
781 setLocalNameEnv :: LocalRdrEnv -> RnMS s a -> RnMS s a
782 setLocalNameEnv local_env' m rn_down (SDown rn_env local_env mod_name mode)
783 = m rn_down (SDown rn_env local_env' mod_name mode)
785 getFixityEnv :: RnMS s FixityEnv
786 getFixityEnv rn_down (SDown (RnEnv name_env fixity_env) local_env mod_name mode)
787 = returnSST fixity_env
789 extendFixityEnv :: [(Name, RenamedFixitySig)] -> RnMS s a -> RnMS s a
790 extendFixityEnv fixes enclosed_scope
791 rn_down (SDown (RnEnv name_env fixity_env) local_env mod_name mode)
793 new_fixity_env = extendNameEnv fixity_env fixes
795 enclosed_scope rn_down (SDown (RnEnv name_env new_fixity_env) local_env mod_name mode)
798 ================ Module and Mode =====================
801 getModuleRn :: RnMS s Module
802 getModuleRn rn_down (SDown rn_env local_env mod_name mode)
807 getModeRn :: RnMS s RnSMode
808 getModeRn rn_down (SDown rn_env local_env mod_name mode)
811 setModeRn :: RnSMode -> RnMS s a -> RnMS s a
812 setModeRn new_mode thing_inside rn_down (SDown rn_env local_env mod_name mode)
813 = thing_inside rn_down (SDown rn_env local_env mod_name new_mode)
817 %************************************************************************
819 \subsection{Plumbing for rename-globals part}
821 %************************************************************************
824 getIfacesRn :: RnMG Ifaces
825 getIfacesRn rn_down (GDown himap hibmap iface_var)
826 = readMutVarSST iface_var
828 setIfacesRn :: Ifaces -> RnMG ()
829 setIfacesRn ifaces rn_down (GDown himap hibmap iface_var)
830 = writeMutVarSST iface_var ifaces
832 getModuleHiMap :: IfaceFlavour -> RnMG ModuleHiMap
833 getModuleHiMap as_source rn_down (GDown himap hibmap iface_var)
835 HiBootFile -> returnSST hibmap
840 %************************************************************************
842 \subsection{HowInScope}
844 %************************************************************************
847 modeToNecessity SourceMode = Compulsory
848 modeToNecessity (InterfaceMode necessity) = necessity