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 )
31 import SrcLoc ( noSrcLoc )
32 import ErrUtils ( addShortErrLocLine, addShortWarnLocLine,
33 pprBagOfErrors, ErrMsg, WarnMsg, Message
35 import Name ( Module, Name, OccName, NamedThing(..), IfaceFlavour,
36 isLocallyDefinedName, nameModule, nameOccName
39 import RdrName ( RdrName )
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 rn_omit :: Name -> Bool, -- True <=> omit qualifier when printing
109 rn_ns :: SSTRef s RnNameSupply,
110 rn_errs :: SSTRef s (Bag WarnMsg, Bag ErrMsg),
111 rn_occs :: SSTRef s ([Occurrence],[Occurrence]), -- Occurrences: compulsory and optional resp
115 type Occurrence = (Name, SrcLoc) -- The srcloc is the occurrence site
117 data Necessity = Compulsory | Optional -- We *must* find definitions for
118 -- compulsory occurrences; we *may* find them
119 -- for optional ones.
121 -- For getting global names
123 rn_hi_map :: ModuleHiMap, -- for .hi files
124 rn_hiboot_map :: ModuleHiMap, -- for .hi-boot files
125 rn_ifaces :: SSTRWRef Ifaces
128 -- For renaming source code
129 data SDown s = SDown {
131 rn_genv :: RnEnv, -- Global envt; the fixity component gets extended
132 -- with local fixity decls
133 rn_lenv :: LocalRdrEnv -- Local name envt
134 -- Does *not* includes global name envt; may shadow it
135 -- Includes both ordinary variables and type variables;
136 -- they are kept distinct because tyvar have a different
137 -- occurrence contructor (Name.TvOcc)
138 -- We still need the unsullied global name env so that
139 -- we can look up record field names
142 data RnMode = SourceMode -- Renaming source code
143 | InterfaceMode -- Renaming interface declarations.
144 Necessity -- 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
149 -- in compulsory mode,
150 -- but the pragmas in optional mode.
152 type SearchPath = [(String,String)] -- List of (directory,suffix) pairs to search
153 -- for interface files.
155 type ModuleHiMap = FiniteMap String String
156 -- mapping from module name to the file path of its corresponding
160 ===================================================
162 ===================================================
165 --------------------------------
166 type RdrNameEnv a = FiniteMap RdrName a
167 type GlobalRdrEnv = RdrNameEnv [Name] -- The list is because there may be name clashes
168 -- These only get reported on lookup,
169 -- not on construction
170 type LocalRdrEnv = RdrNameEnv Name
172 emptyRdrEnv :: RdrNameEnv a
173 lookupRdrEnv :: RdrNameEnv a -> RdrName -> Maybe a
174 addListToRdrEnv :: RdrNameEnv a -> [(RdrName,a)] -> RdrNameEnv a
176 emptyRdrEnv = emptyFM
177 lookupRdrEnv = lookupFM
178 addListToRdrEnv = addListToFM
181 --------------------------------
182 type NameEnv a = UniqFM a -- Domain is Name
184 emptyNameEnv :: NameEnv a
185 nameEnvElts :: NameEnv a -> [a]
186 addToNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
187 addToNameEnv :: NameEnv a -> Name -> a -> NameEnv a
188 plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a
189 extendNameEnv :: NameEnv a -> [(Name,a)] -> NameEnv a
190 lookupNameEnv :: NameEnv a -> Name -> Maybe a
191 delFromNameEnv :: NameEnv a -> Name -> NameEnv a
192 elemNameEnv :: Name -> NameEnv a -> Bool
194 emptyNameEnv = emptyUFM
195 nameEnvElts = eltsUFM
196 addToNameEnv_C = addToUFM_C
197 addToNameEnv = addToUFM
198 plusNameEnv = plusUFM
199 extendNameEnv = addListToUFM
200 lookupNameEnv = lookupUFM
201 delFromNameEnv = delFromUFM
202 elemNameEnv = elemUFM
204 --------------------------------
205 type FixityEnv = NameEnv RenamedFixitySig
207 --------------------------------
208 data RnEnv = RnEnv GlobalRdrEnv FixityEnv
209 emptyRnEnv = RnEnv emptyRdrEnv emptyNameEnv
213 --------------------------------
217 , FiniteMap (OccName, OccName) Int
218 -- This is used as a name supply for dictionary functions
219 -- From the inst decl we derive a (class, tycon) pair;
220 -- this map then gives a unique int for each inst decl with that
221 -- (class, tycon) pair. (In Haskell 98 there can only be one,
222 -- but not so in more extended versions.)
224 -- We could just use one Int for all the instance decls, but this
225 -- way the uniques change less when you add an instance decl,
226 -- hence less recompilation
228 , FiniteMap (Module,OccName) Name
229 -- Ensures that one (module,occname) pair gets one unique
233 --------------------------------
234 data ExportEnv = ExportEnv Avails Fixities
235 type Avails = [AvailInfo]
236 type Fixities = [(Name, Fixity)]
238 type ExportAvails = (FiniteMap Module Avails, -- Used to figure out "module M" export specifiers
239 -- Includes avails only from *unqualified* imports
240 -- (see 1.4 Report Section 5.1.1)
242 NameEnv AvailInfo) -- Used to figure out all other export specifiers.
243 -- Maps a Name to the AvailInfo that contains it
246 data GenAvailInfo name = Avail name -- An ordinary identifier
247 | AvailTC name -- The name of the type or class
248 [name] -- The available pieces of type/class. NB: If the type or
249 -- class is itself to be in scope, it must be in this list.
250 -- Thus, typically: AvailTC Eq [Eq, ==, /=]
251 type AvailInfo = GenAvailInfo Name
252 type RdrAvailInfo = GenAvailInfo OccName
255 ===================================================
257 ===================================================
260 type ExportItem = (Module, [RdrAvailInfo])
261 type VersionInfo name = [ImportVersion name]
263 type ImportVersion name = (Module, Version, WhatsImported name)
264 data WhatsImported name = Everything
265 | Specifically [LocalVersion name] -- List guaranteed non-empty
267 -- ("M", hif, ver, Everything) means there was a "module M" in
268 -- this module's export list, so we just have to go by M's version, "ver",
269 -- not the list of LocalVersions.
272 type LocalVersion name = (name, Version)
276 Module -- Module name
277 Version -- Module version number
278 [ImportVersion OccName] -- Usages
279 [ExportItem] -- Exports
280 [Module] -- Special instance modules
281 [(Version, RdrNameHsDecl)] -- Local definitions
282 [RdrNameInstDecl] -- Local instance declarations
284 type InterfaceDetails = (VersionInfo Name, -- Version information for what this module imports
285 ExportEnv, -- What this module exports
286 [Module]) -- Instance modules
288 type RdrNamePragma = () -- Fudge for now
291 data Ifaces = Ifaces {
292 iMod :: Module, -- Name of the module being compiled
294 iModMap :: FiniteMap Module (IfaceFlavour, -- Exports
298 iDecls :: DeclsMap, -- A single, global map of Names to decls
300 iFixes :: FixityEnv, -- A single, global map of Names to fixities
302 iSlurp :: NameSet, -- 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.
305 iVSlurp :: [(Name,Version)], -- All the (a) non-wired-in (b) "big" (c) non-locally-defined names that
306 -- have been slurped in so far, with their versions.
307 -- This is used to generate the "usage" information for this module.
308 -- Subset of the previous field.
310 iDefInsts :: (Bag IfaceInst, NameSet),
311 -- The as-yet un-slurped instance decls; this bag is depleted when we
312 -- slurp an instance decl so that we don't slurp the same one twice.
313 -- Together with them is the set of tycons/classes that may allow
314 -- the instance decls in.
316 iDefData :: NameEnv (Module, RdrNameTyClDecl),
317 -- Deferred data type declarations; each has the following properties
318 -- * it's a data type decl
319 -- * its TyCon is needed
320 -- * the decl may or may not have been slurped, depending on whether any
321 -- of the constrs are needed.
323 iInstMods :: [Module] -- Set of modules with "special" instance declarations
324 -- Excludes this module
328 type DeclsMap = NameEnv (Version, AvailInfo, RdrNameHsDecl, Bool)
329 -- A DeclsMap contains a binding for each Name in the declaration
330 -- including the constructors of a type decl etc.
331 -- The Bool is True just for the 'main' Name.
333 type IfaceInst = ((Module, RdrNameInstDecl), -- Instance decl
334 NameSet) -- "Gate" names. Slurp this instance decl when this
335 -- set becomes empty. It's depleted whenever we
336 -- slurp another type or class decl.
340 %************************************************************************
342 \subsection{Main monad code}
344 %************************************************************************
347 initRn :: Module -> UniqSupply -> SearchPath -> SrcLoc
349 -> IO (r, Bag ErrMsg, Bag WarnMsg)
351 initRn mod us dirs loc do_rn = do
352 names_var <- sstToIO (newMutVarSST (us, emptyFM, builtins))
353 errs_var <- sstToIO (newMutVarSST (emptyBag,emptyBag))
354 iface_var <- sstToIO (newMutVarSST (emptyIfaces mod))
355 occs_var <- sstToIO (newMutVarSST initOccs)
356 (himap, hibmap) <- mkModuleHiMaps dirs
358 rn_down = RnDown { rn_loc = loc, rn_omit = \n -> False, rn_ns = names_var,
359 rn_errs = errs_var, rn_occs = occs_var,
361 g_down = GDown { rn_hi_map = himap, rn_hiboot_map = hibmap, rn_ifaces = iface_var }
364 res <- sstToIO (do_rn rn_down g_down)
366 -- grab errors and return
367 (warns, errs) <- sstToIO (readMutVarSST errs_var)
368 return (res, errs, warns)
371 initRnMS :: RnEnv -> RnMode -> RnMS RealWorld r -> RnMG r
372 initRnMS rn_env mode m rn_down g_down
374 s_down = SDown { rn_genv = rn_env, rn_lenv = emptyRdrEnv, rn_mode = mode }
379 emptyIfaces :: Module -> Ifaces
380 emptyIfaces mod = Ifaces { iMod = mod,
382 iDecls = emptyNameEnv,
383 iFixes = emptyNameEnv,
384 iSlurp = emptyNameSet,
386 iDefInsts = (emptyBag, emptyNameSet),
387 iDefData = emptyNameEnv,
391 builtins :: FiniteMap (Module,OccName) Name
393 mapBag (\ name -> ((nameModule name, nameOccName name), name))
396 -- Initial value for the occurrence pool.
397 initOccs :: ([Occurrence],[Occurrence]) -- Compulsory and optional respectively
398 initOccs = ([(getName boolTyCon, noSrcLoc)], [])
399 -- Booleans occur implicitly a lot, so it's tiresome to keep recording the fact, and
400 -- rather implausible that not one will be used in the module.
401 -- We could add some other common types, notably lists, but the general idea is
402 -- to do as much as possible explicitly.
406 mkModuleHiMaps :: SearchPath -> IO (ModuleHiMap, ModuleHiMap)
407 mkModuleHiMaps dirs = foldM (getAllFilesMatching dirs) (env,env) dirs
411 getAllFilesMatching :: SearchPath
412 -> (ModuleHiMap, ModuleHiMap)
413 -> (FilePath, String)
414 -> IO (ModuleHiMap, ModuleHiMap)
415 getAllFilesMatching dirs hims (dir_path, suffix) = ( do
416 -- fpaths entries do not have dir_path prepended
417 fpaths <- getDirectoryContents dir_path
418 return (foldl addModules hims fpaths)
423 ("Import path element `" ++ dir_path ++
424 if (isDoesNotExistError err) then
425 "' does not exist, ignoring."
427 "' couldn't read, ignoring.")
432 xiffus = reverse dotted_suffix
440 hi_boot_version_xiffus =
441 reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus
442 hi_boot_xiffus = "toob-ih." -- .hi-boot reversed.
444 addModules his@(hi_env, hib_env) nm = fromMaybe his $
445 FMAP (\ (mod_nm,v) -> (addToFM_C addNewOne hi_env mod_nm v, hib_env))
446 (go xiffus rev_nm) `seqMaybe`
448 FMAP (\ (mod_nm,v) -> (hi_env, addToFM_C overrideNew hib_env mod_nm v))
449 (go hi_boot_version_xiffus rev_nm) `seqMaybe`
451 FMAP (\ (mod_nm,v) -> (hi_env, addToFM_C addNewOne hib_env mod_nm v))
452 (go hi_boot_xiffus rev_nm)
456 go [] xs = Just (reverse xs, dir_path ++'/':nm)
460 | otherwise = Nothing
463 | opt_WarnHiShadows = conflict
464 | otherwise = stickWithOld
466 stickWithOld old new = old
467 overrideNew old new = new
469 conflict old_path new_path
470 | old_path /= new_path =
471 pprTrace "Warning: " (text "Identically named interface files present on import path, " $$
472 text (show old_path) <+> text "shadows" $$
473 text (show new_path) $$
474 text "on the import path: " <+>
475 text (concat (intersperse ":" (map fst dirs))))
477 | otherwise = old_path -- don't warn about innocous shadowings.
482 @renameSourceCode@ is used to rename stuff "out-of-line"; that is, not as part of
483 the main renamer. Examples: pragmas (which we don't want to rename unless
484 we actually explore them); and derived definitions, which are only generated
487 The @RnNameSupply@ includes a @UniqueSupply@, so if you call it more than
488 once you must either split it, or install a fresh unique supply.
491 renameSourceCode :: Module
496 -- Alas, we can't use the real runST, with the desired signature:
497 -- renameSourceCode :: RnNameSupply -> RnMS s r -> r
498 -- because we can't manufacture "new versions of runST".
500 renameSourceCode mod_name name_supply m
502 newMutVarSST name_supply `thenSST` \ names_var ->
503 newMutVarSST (emptyBag,emptyBag) `thenSST` \ errs_var ->
504 newMutVarSST ([],[]) `thenSST` \ occs_var ->
506 rn_down = RnDown { rn_loc = mkGeneratedSrcLoc, rn_ns = names_var,
507 rn_errs = errs_var, rn_occs = occs_var,
509 s_down = SDown { rn_mode = InterfaceMode Compulsory,
510 rn_genv = emptyRnEnv, rn_lenv = emptyRdrEnv }
512 m rn_down s_down `thenSST` \ result ->
514 readMutVarSST errs_var `thenSST` \ (warns,errs) ->
516 (if not (isEmptyBag errs) then
517 pprTrace "Urk! renameSourceCode found errors" (display errs)
519 else if not (isEmptyBag warns) then
520 pprTrace "Note: renameSourceCode found warnings" (display warns)
528 display errs = pprBagOfErrors errs
530 {-# INLINE thenRn #-}
531 {-# INLINE thenRn_ #-}
532 {-# INLINE returnRn #-}
535 returnRn :: a -> RnM s d a
536 thenRn :: RnM s d a -> (a -> RnM s d b) -> RnM s d b
537 thenRn_ :: RnM s d a -> RnM s d b -> RnM s d b
538 andRn :: (a -> a -> a) -> RnM s d a -> RnM s d a -> RnM s d a
539 mapRn :: (a -> RnM s d b) -> [a] -> RnM s d [b]
540 mapMaybeRn :: (a -> RnM s d (Maybe b)) -> [a] -> RnM s d [b]
541 sequenceRn :: [RnM s d a] -> RnM s d [a]
542 foldlRn :: (b -> a -> RnM s d b) -> b -> [a] -> RnM s d b
543 mapAndUnzipRn :: (a -> RnM s d (b,c)) -> [a] -> RnM s d ([b],[c])
544 fixRn :: (a -> RnM s d a) -> RnM s d a
546 returnRn v gdown ldown = returnSST v
547 thenRn m k gdown ldown = m gdown ldown `thenSST` \ r -> k r gdown ldown
548 thenRn_ m k gdown ldown = m gdown ldown `thenSST_` k gdown ldown
549 fixRn m gdown ldown = fixSST (\r -> m r gdown ldown)
550 andRn combiner m1 m2 gdown ldown
551 = m1 gdown ldown `thenSST` \ res1 ->
552 m2 gdown ldown `thenSST` \ res2 ->
553 returnSST (combiner res1 res2)
555 sequenceRn [] = returnRn []
556 sequenceRn (m:ms) = m `thenRn` \ r ->
557 sequenceRn ms `thenRn` \ rs ->
560 mapRn f [] = returnRn []
562 = f x `thenRn` \ r ->
563 mapRn f xs `thenRn` \ rs ->
566 foldlRn k z [] = returnRn z
567 foldlRn k z (x:xs) = k z x `thenRn` \ z' ->
570 mapAndUnzipRn f [] = returnRn ([],[])
571 mapAndUnzipRn f (x:xs)
572 = f x `thenRn` \ (r1, r2) ->
573 mapAndUnzipRn f xs `thenRn` \ (rs1, rs2) ->
574 returnRn (r1:rs1, r2:rs2)
576 mapAndUnzip3Rn f [] = returnRn ([],[],[])
577 mapAndUnzip3Rn f (x:xs)
578 = f x `thenRn` \ (r1, r2, r3) ->
579 mapAndUnzip3Rn f xs `thenRn` \ (rs1, rs2, rs3) ->
580 returnRn (r1:rs1, r2:rs2, r3:rs3)
582 mapMaybeRn f [] = returnRn []
583 mapMaybeRn f (x:xs) = f x `thenRn` \ maybe_r ->
584 mapMaybeRn f xs `thenRn` \ rs ->
586 Nothing -> returnRn rs
587 Just r -> returnRn (r:rs)
592 %************************************************************************
594 \subsection{Boring plumbing for common part}
596 %************************************************************************
599 ================ Errors and warnings =====================
602 failWithRn :: a -> Message -> RnM s d a
603 failWithRn res msg (RnDown {rn_errs = errs_var, rn_loc = loc}) l_down
604 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
605 writeMutVarSST errs_var (warns, errs `snocBag` err) `thenSST_`
608 err = addShortErrLocLine loc msg
610 warnWithRn :: a -> Message -> RnM s d a
611 warnWithRn res msg (RnDown {rn_errs = errs_var, rn_loc = loc}) l_down
612 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
613 writeMutVarSST errs_var (warns `snocBag` warn, errs) `thenSST_`
616 warn = addShortWarnLocLine loc msg
618 addErrRn :: Message -> RnM s d ()
619 addErrRn err = failWithRn () err
621 checkRn :: Bool -> Message -> RnM s d () -- Check that a condition is true
622 checkRn False err = addErrRn err
623 checkRn True err = returnRn ()
625 warnCheckRn :: Bool -> Message -> RnM s d () -- Check that a condition is true
626 warnCheckRn False err = addWarnRn err
627 warnCheckRn True err = returnRn ()
629 addWarnRn :: Message -> RnM s d ()
630 addWarnRn warn = warnWithRn () warn
632 checkErrsRn :: RnM s d Bool -- True <=> no errors so far
633 checkErrsRn (RnDown {rn_errs = errs_var}) l_down
634 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
635 returnSST (isEmptyBag errs)
639 ================ Source location =====================
642 pushSrcLocRn :: SrcLoc -> RnM s d a -> RnM s d a
643 pushSrcLocRn loc' m down l_down
644 = m (down {rn_loc = loc'}) l_down
646 getSrcLocRn :: RnM s d SrcLoc
647 getSrcLocRn down l_down
648 = returnSST (rn_loc down)
651 ================ Name supply =====================
654 getNameSupplyRn :: RnM s d RnNameSupply
655 getNameSupplyRn rn_down l_down
656 = readMutVarSST (rn_ns rn_down)
658 setNameSupplyRn :: RnNameSupply -> RnM s d ()
659 setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
660 = writeMutVarSST names_var names'
662 -- See comments with RnNameSupply above.
663 newInstUniq :: (OccName, OccName) -> RnM s d Int
664 newInstUniq key (RnDown {rn_ns = names_var}) l_down
665 = readMutVarSST names_var `thenSST` \ (us, mapInst, cache) ->
667 uniq = case lookupFM mapInst key of
670 mapInst' = addToFM mapInst key uniq
672 writeMutVarSST names_var (us, mapInst', cache) `thenSST_`
676 ================ Occurrences =====================
678 Every time we get an occurrence of a name we put it in one of two lists:
679 one for "compulsory" occurrences
680 one for "optional" occurrences
682 The significance of "compulsory" is
683 (a) we *must* find the declaration
684 (b) in the case of type or class names, the name is part of the
685 source level program, and we must slurp in any instance decls
688 We don't need instance decls "optional" names, because the type inference
689 process will never come across them. Optional names are buried inside
690 type checked (but not renamed) cross-module unfoldings and such.
692 The pair of lists is held in a mutable variable in RnDown.
694 The lists are kept separate so that we can process all the compulsory occurrences
695 before any of the optional ones. Why? Because suppose we processed an optional
696 "g", and slurped an interface decl of g::T->T. Then we'd rename the type T->T in
697 optional mode. But if we later need g compulsorily we'll find that it's already
698 been slurped and will do nothing. We could, I suppose, rename it a second time,
699 but it seems simpler just to do all the compulsory ones first.
702 addOccurrenceName :: Name -> RnMS s Name -- Same name returned as passed
703 addOccurrenceName name (RnDown {rn_loc = loc, rn_occs = occs_var})
704 (SDown {rn_mode = mode})
705 | isLocallyDefinedName name ||
706 not_necessary necessity
710 = readMutVarSST occs_var `thenSST` \ (comp_occs, opt_occs) ->
712 new_occ_pair = case necessity of
713 Optional -> (comp_occs, (name,loc):opt_occs)
714 Compulsory -> ((name,loc):comp_occs, opt_occs)
716 writeMutVarSST occs_var new_occ_pair `thenSST_`
719 necessity = modeToNecessity mode
722 addOccurrenceNames :: [Name] -> RnMS s ()
723 addOccurrenceNames names (RnDown {rn_loc = loc, rn_occs = occs_var})
724 (SDown {rn_mode = mode})
725 | not_necessary necessity
729 = readMutVarSST occs_var `thenSST` \ (comp_occs, opt_occs) ->
731 new_occ_pair = case necessity of
732 Optional -> (comp_occs, non_local_occs ++ opt_occs)
733 Compulsory -> (non_local_occs ++ comp_occs, opt_occs)
735 writeMutVarSST occs_var new_occ_pair
737 non_local_occs = [(name, loc) | name <- names, not (isLocallyDefinedName name)]
738 necessity = modeToNecessity mode
740 -- Never look for optional things if we're
741 -- ignoring optional input interface information
742 not_necessary Compulsory = False
743 not_necessary Optional = opt_IgnoreIfacePragmas
745 popOccurrenceName :: RnMode -> RnM s d (Maybe Occurrence)
746 popOccurrenceName mode (RnDown {rn_occs = occs_var}) l_down
747 = readMutVarSST occs_var `thenSST` \ occs ->
749 -- Find a compulsory occurrence
750 (InterfaceMode Compulsory, (comp:comps, opts))
751 -> writeMutVarSST occs_var (comps, opts) `thenSST_`
752 returnSST (Just comp)
754 -- Find an optional occurrence
755 -- We shouldn't be looking unless we've done all the compulsories
756 (InterfaceMode Optional, (comps, opt:opts))
757 -> ASSERT2( null comps, ppr comps )
758 writeMutVarSST occs_var (comps, opts) `thenSST_`
761 -- No suitable occurrence
762 other -> returnSST Nothing
764 -- discardOccurrencesRn does the enclosed thing with a *fresh* occurrences
765 -- variable, and discards the list of occurrences thus found. It's useful
766 -- when loading instance decls and specialisation signatures, when we want to
767 -- know the names of the things in the types, but we don't want to treat them
770 discardOccurrencesRn :: RnM s d a -> RnM s d a
771 discardOccurrencesRn enclosed_thing rn_down l_down
772 = newMutVarSST ([],[]) `thenSST` \ new_occs_var ->
773 enclosed_thing (rn_down {rn_occs = new_occs_var}) l_down
777 ================ Module =====================
780 getModuleRn :: RnM s d Module
781 getModuleRn (RnDown {rn_mod = mod_name}) l_down
784 setModuleRn :: Module -> RnM s d a -> RnM s d a
785 setModuleRn new_mod enclosed_thing rn_down l_down
786 = enclosed_thing (rn_down {rn_mod = new_mod}) l_down
790 setOmitQualFn :: (Name -> Bool) -> RnM s d a -> RnM s d a
791 setOmitQualFn fn m g_down l_down = m (g_down { rn_omit = fn }) l_down
793 getOmitQualFn :: RnM s d (Name -> Bool)
794 getOmitQualFn (RnDown {rn_omit = omit_fn}) l_down
798 %************************************************************************
800 \subsection{Plumbing for rename-source part}
802 %************************************************************************
804 ================ RnEnv =====================
807 getNameEnvs :: RnMS s (GlobalRdrEnv, LocalRdrEnv)
808 getNameEnvs rn_down (SDown {rn_genv = RnEnv global_env fixity_env, rn_lenv = local_env})
809 = returnSST (global_env, local_env)
811 getLocalNameEnv :: RnMS s LocalRdrEnv
812 getLocalNameEnv rn_down (SDown {rn_lenv = local_env})
813 = returnSST local_env
815 setLocalNameEnv :: LocalRdrEnv -> RnMS s a -> RnMS s a
816 setLocalNameEnv local_env' m rn_down l_down
817 = m rn_down (l_down {rn_lenv = local_env'})
819 getFixityEnv :: RnMS s FixityEnv
820 getFixityEnv rn_down (SDown {rn_genv = RnEnv name_env fixity_env})
821 = returnSST fixity_env
823 extendFixityEnv :: [(Name, RenamedFixitySig)] -> RnMS s a -> RnMS s a
824 extendFixityEnv fixes enclosed_scope
825 rn_down l_down@(SDown {rn_genv = RnEnv name_env fixity_env})
827 new_fixity_env = extendNameEnv fixity_env fixes
829 enclosed_scope rn_down (l_down {rn_genv = RnEnv name_env new_fixity_env})
832 ================ Mode =====================
835 getModeRn :: RnMS s RnMode
836 getModeRn rn_down (SDown {rn_mode = mode})
839 setModeRn :: RnMode -> RnMS s a -> RnMS s a
840 setModeRn new_mode thing_inside rn_down l_down
841 = thing_inside rn_down (l_down {rn_mode = new_mode})
845 %************************************************************************
847 \subsection{Plumbing for rename-globals part}
849 %************************************************************************
852 getIfacesRn :: RnMG Ifaces
853 getIfacesRn rn_down (GDown {rn_ifaces = iface_var})
854 = readMutVarSST iface_var
856 setIfacesRn :: Ifaces -> RnMG ()
857 setIfacesRn ifaces rn_down (GDown {rn_ifaces = iface_var})
858 = writeMutVarSST iface_var ifaces
860 getModuleHiMap :: Bool -> RnMG ModuleHiMap
861 getModuleHiMap want_hi_boot rn_down (GDown {rn_hi_map = himap, rn_hiboot_map = hibmap})
862 | want_hi_boot = returnSST hibmap
863 | otherwise = returnSST himap
867 %************************************************************************
869 \subsection{HowInScope}
871 %************************************************************************
874 modeToNecessity SourceMode = Compulsory
875 modeToNecessity (InterfaceMode necessity) = necessity