2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1997
4 \section[RnMonad]{The monad used by the renamer}
7 #include "HsVersions.h"
11 -- close it up (partly done to allow unfoldings)
17 SYN_IE(RdrNameHsDecl),
18 SYN_IE(RdrNameInstDecl),
28 #if __GLASGOW_HASKELL__ <= 201
29 import PreludeGlaST ( SYN_IE(ST), thenStrictlyST, returnStrictlyST )
36 # if __GLASGOW_HASKELL__ >= 209
37 import STBase (ST(..), STret(..) )
39 #define IOError13 IOError
45 import BasicTypes ( SYN_IE(Version), NewOrData )
46 import ErrUtils ( addErrLoc, addShortErrLocLine, addShortWarnLocLine,
47 pprBagOfErrors, SYN_IE(Error), SYN_IE(Warning)
49 import Name ( SYN_IE(Module), Name, OccName, Provenance, SYN_IE(NameSet), emptyNameSet,
51 modAndOcc, NamedThing(..)
53 import CmdLineOpts ( opt_D_show_rn_trace, opt_IgnoreIfacePragmas )
54 import PrelInfo ( builtinNames )
55 import TyCon ( TyCon {- instance NamedThing -} )
56 import TysWiredIn ( boolTyCon )
58 import Outputable ( PprStyle(..), printErrs )
59 import SrcLoc ( SrcLoc, mkGeneratedSrcLoc )
60 import Unique ( Unique )
61 import UniqFM ( UniqFM )
62 import FiniteMap ( FiniteMap, emptyFM, bagToFM )
63 import Bag ( Bag, mapBag, emptyBag, isEmptyBag, snocBag )
66 #if __GLASGOW_HASKELL__ >= 202
70 infixr 9 `thenRn`, `thenRn_`
74 %************************************************************************
76 \subsection{Somewhat magical interface to other monads}
78 %************************************************************************
81 #if __GLASGOW_HASKELL__ >= 200
82 # define REAL_WORLD RealWorld
84 # define REAL_WORLD _RealWorld
89 sstToIO :: SST REAL_WORLD r -> IO r
90 #if __GLASGOW_HASKELL__ < 209
93 sstToST sst `thenStrictlyST` \ r ->
94 returnStrictlyST (Right r))
98 let (ST st_act) = sstToST sst in
100 STret s' v -> IOok s' v)
103 ioToRnMG :: IO r -> RnMG (Either IOError13 r)
104 #if __GLASGOW_HASKELL__ < 209
105 ioToRnMG (MkIO io) rn_down g_down = stToSST io
107 ioToRnMG (IO io) rn_down g_down
112 IOok st' v -> STret st' (Right v)
113 IOfail st' e -> STret st' (Left e)
116 traceRn :: Doc -> RnMG ()
117 traceRn msg | opt_D_show_rn_trace = putDocRn msg
118 | otherwise = returnRn ()
120 putDocRn :: Doc -> RnMG ()
121 putDocRn msg = ioToRnMG (printErrs msg) `thenRn_`
126 %************************************************************************
128 \subsection{Data types}
130 %************************************************************************
132 ===================================================
134 ===================================================
137 type RnM s d r = RnDown s -> d -> SST s r
138 type RnMS s r = RnM s (SDown s) r -- Renaming source
139 type RnMG r = RnM REAL_WORLD GDown r -- Getting global names etc
140 type MutVar a = MutableVar REAL_WORLD a -- ToDo: there ought to be a standard defn of this
143 data RnDown s = RnDown
145 (MutableVar s RnNameSupply)
146 (MutableVar s (Bag Warning, Bag Error))
147 (MutableVar s ([Name],[Name])) -- Occurrences: compulsory and optional resp
149 data Necessity = Compulsory | Optional -- We *must* find definitions for
150 -- compulsory occurrences; we *may* find them
151 -- for optional ones.
153 -- For getting global names
158 -- For renaming source code
161 NameEnv -- Local name envt (includes global name envt,
162 -- but may shadow it)
167 data RnSMode = SourceMode -- Renaming source code
168 | InterfaceMode Necessity -- Renaming interface declarations. The "necessity"
169 -- flag says free variables *must* be found and slurped
170 -- or whether they need not be. For value signatures of
171 -- things that are themselves compulsorily imported
172 -- we arrange that the type signature is read in compulsory mode,
173 -- but the pragmas in optional mode.
175 type SearchPath = [(String,String)] -- List of (directory,suffix) pairs to search
176 -- for interface files.
177 type FreeVars = NameSet
180 ===================================================
182 ===================================================
185 type RnNameSupply = (UniqSupply, Int, FiniteMap (Module,OccName) Name)
186 -- Ensures that one (m,n) pair gets one unique
187 -- The Int is used to give a number to each instance declaration;
188 -- it's really a separate name supply.
190 data RnEnv = RnEnv NameEnv FixityEnv
191 emptyRnEnv = RnEnv emptyNameEnv emptyFixityEnv
193 type NameEnv = FiniteMap RdrName Name
194 emptyNameEnv = emptyFM
196 type FixityEnv = FiniteMap RdrName (Fixity, Provenance)
197 emptyFixityEnv = emptyFM
198 -- It's possible to have a different fixity for B.op than for op:
200 -- module A( op ) where module B where
201 -- import qualified B( op ) infixr 2 op
202 -- infixl 9 `op` op = ...
203 -- op a b = a `B.op` b
205 data ExportEnv = ExportEnv Avails Fixities
206 type Avails = [AvailInfo]
207 type Fixities = [(OccName, (Fixity, Provenance))]
208 -- Can contain duplicates, if one module defines the same fixity,
209 -- or the same type/class/id, more than once. Hence a boring old list.
210 -- This allows us to report duplicates in just one place, namely plusRnEnv.
212 type ExportAvails = (FiniteMap Module Avails, -- Used to figure out "module M" export specifiers
213 -- Includes avails only from *unqualified* imports
214 -- (see 1.4 Report Section 5.1.1)
216 UniqFM AvailInfo) -- Used to figure out all other export specifiers.
217 -- Maps a Name to the AvailInfo that contains it
218 -- NB: Contain bindings for class ops but
219 -- not constructors (see defn of availEntityNames)
222 data GenAvailInfo name = NotAvailable
223 | Avail name -- An ordinary identifier
224 | AvailTC name -- The name of the type or class
225 [name] -- The available pieces of type/class. NB: If the type or
226 -- class is itself to be in scope, it must be in this list.
227 -- Thus, typically: AvailTC Eq [Eq, ==, /=]
228 type AvailInfo = GenAvailInfo Name
229 type RdrAvailInfo = GenAvailInfo OccName
232 ===================================================
234 ===================================================
237 type ExportItem = (Module, IfaceFlavour, [RdrAvailInfo])
238 type VersionInfo name = [ImportVersion name]
239 type ImportVersion name = (Module, IfaceFlavour, Version, [LocalVersion name])
240 type LocalVersion name = (name, Version)
244 Module -- Module name
245 Version -- Module version number
246 [ImportVersion OccName] -- Usages
247 [ExportItem] -- Exports
248 [Module] -- Special instance modules
249 [(OccName,Fixity)] -- Fixities
250 [(Version, RdrNameHsDecl)] -- Local definitions
251 [RdrNameInstDecl] -- Local instance declarations
253 type InterfaceDetails = (VersionInfo Name, -- Version information
254 ExportEnv, -- What this module exports
255 [Module]) -- Instance modules
257 type RdrNamePragma = () -- Fudge for now
261 Module -- Name of this module
262 (FiniteMap Module (IfaceFlavour, -- Exports
268 NameSet -- All the names (whether "big" or "small", whether wired-in or not,
269 -- whether locally defined or not) that have been slurped in so far.
271 [(Name,Version)] -- All the (a) non-wired-in (b) "big" (c) non-locally-defined names that
272 -- have been slurped in so far, with their versions.
273 -- This is used to generate the "usage" information for this module.
274 -- Subset of the previous field.
276 (Bag IfaceInst, NameSet) -- The as-yet un-slurped instance decls; this bag is depleted when we
277 -- slurp an instance decl so that we don't slurp the same one twice.
278 -- Together with them is the set of tycons/classes that may allow
279 -- the instance decls in.
281 (FiniteMap Name RdrNameTyDecl)
282 -- Deferred data type declarations; each has the following properties
283 -- * it's a data type decl
284 -- * its TyCon is needed
285 -- * the decl may or may not have been slurped, depending on whether any
286 -- of the constrs are needed.
288 [Module] -- Set of modules with "special" instance declarations
289 -- Excludes this module
292 type DeclsMap = FiniteMap Name (Version, AvailInfo, RdrNameHsDecl)
293 type IfaceInst = ((Module, RdrNameInstDecl), -- Instance decl
294 [Name]) -- "Gate" names. Slurp this instance decl when this
295 -- list becomes empty. It's depleted whenever we
296 -- slurp another type or class decl.
300 %************************************************************************
302 \subsection{Main monad code}
304 %************************************************************************
307 initRn :: Module -> UniqSupply -> SearchPath -> SrcLoc
309 -> IO (r, Bag Error, Bag Warning)
311 initRn mod us dirs loc do_rn
313 newMutVarSST (us, 1, builtins) `thenSST` \ names_var ->
314 newMutVarSST (emptyBag,emptyBag) `thenSST` \ errs_var ->
315 newMutVarSST (emptyIfaces mod) `thenSST` \ iface_var ->
316 newMutVarSST initOccs `thenSST` \ occs_var ->
318 rn_down = RnDown loc names_var errs_var occs_var
319 g_down = GDown dirs iface_var
322 do_rn rn_down g_down `thenSST` \ res ->
324 -- grab errors and return
325 readMutVarSST errs_var `thenSST` \ (warns,errs) ->
326 returnSST (res, errs, warns)
329 initRnMS :: RnEnv -> Module -> RnSMode -> RnMS REAL_WORLD r -> RnMG r
330 initRnMS rn_env@(RnEnv name_env _) mod_name mode m rn_down g_down
332 s_down = SDown rn_env name_env mod_name mode
337 emptyIfaces :: Module -> Ifaces
338 emptyIfaces mod = Ifaces mod emptyFM emptyFM emptyNameSet [] (emptyBag, emptyNameSet) emptyFM []
340 builtins :: FiniteMap (Module,OccName) Name
341 builtins = bagToFM (mapBag (\ name -> (modAndOcc name, name)) builtinNames)
343 -- Initial value for the occurrence pool.
344 initOccs :: ([Name],[Name]) -- Compulsory and optional respectively
345 initOccs = ([getName boolTyCon], [])
346 -- Booleans occur implicitly a lot, so it's tiresome to keep recording the fact, and
347 -- rather implausible that not one will be used in the module.
348 -- We could add some other common types, notably lists, but the general idea is
349 -- to do as much as possible explicitly.
355 @renameSourceCode@ is used to rename stuff "out-of-line"; that is, not as part of
356 the main renamer. Examples: pragmas (which we don't want to rename unless
357 we actually explore them); and derived definitions, which are only generated
360 The @RnNameSupply@ includes a @UniqueSupply@, so if you call it more than
361 once you must either split it, or install a fresh unique supply.
364 renameSourceCode :: Module
369 -- Alas, we can't use the real runST, with the desired signature:
370 -- renameSourceCode :: RnNameSupply -> RnMS s r -> r
371 -- because we can't manufacture "new versions of runST".
373 renameSourceCode mod_name name_supply m
375 newMutVarSST name_supply `thenSST` \ names_var ->
376 newMutVarSST (emptyBag,emptyBag) `thenSST` \ errs_var ->
377 newMutVarSST ([],[]) `thenSST` \ occs_var ->
379 rn_down = RnDown mkGeneratedSrcLoc names_var errs_var occs_var
380 s_down = SDown emptyRnEnv emptyNameEnv mod_name (InterfaceMode Compulsory)
382 m rn_down s_down `thenSST` \ result ->
384 readMutVarSST errs_var `thenSST` \ (warns,errs) ->
386 (if not (isEmptyBag errs) then
387 trace ("Urk! renameSourceCode found errors" ++ display errs)
388 else if not (isEmptyBag warns) then
389 trace ("Urk! renameSourceCode found warnings" ++ display warns)
396 display errs = show (pprBagOfErrors PprDebug errs)
398 {-# INLINE thenRn #-}
399 {-# INLINE thenRn_ #-}
400 {-# INLINE returnRn #-}
403 returnRn :: a -> RnM s d a
404 thenRn :: RnM s d a -> (a -> RnM s d b) -> RnM s d b
405 thenRn_ :: RnM s d a -> RnM s d b -> RnM s d b
406 andRn :: (a -> a -> a) -> RnM s d a -> RnM s d a -> RnM s d a
407 mapRn :: (a -> RnM s d b) -> [a] -> RnM s d [b]
408 mapMaybeRn :: (a -> RnM s d b) -> b -> Maybe a -> RnM s d b
409 sequenceRn :: [RnM s d a] -> RnM s d [a]
410 foldlRn :: (b -> a -> RnM s d b) -> b -> [a] -> RnM s d b
411 mapAndUnzipRn :: (a -> RnM s d (b,c)) -> [a] -> RnM s d ([b],[c])
412 fixRn :: (a -> RnM s d a) -> RnM s d a
414 returnRn v gdown ldown = returnSST v
415 thenRn m k gdown ldown = m gdown ldown `thenSST` \ r -> k r gdown ldown
416 thenRn_ m k gdown ldown = m gdown ldown `thenSST_` k gdown ldown
417 fixRn m gdown ldown = fixSST (\r -> m r gdown ldown)
418 andRn combiner m1 m2 gdown ldown
419 = m1 gdown ldown `thenSST` \ res1 ->
420 m2 gdown ldown `thenSST` \ res2 ->
421 returnSST (combiner res1 res2)
423 sequenceRn [] = returnRn []
424 sequenceRn (m:ms) = m `thenRn` \ r ->
425 sequenceRn ms `thenRn` \ rs ->
428 mapRn f [] = returnRn []
430 = f x `thenRn` \ r ->
431 mapRn f xs `thenRn` \ rs ->
434 foldlRn k z [] = returnRn z
435 foldlRn k z (x:xs) = k z x `thenRn` \ z' ->
438 mapAndUnzipRn f [] = returnRn ([],[])
439 mapAndUnzipRn f (x:xs)
440 = f x `thenRn` \ (r1, r2) ->
441 mapAndUnzipRn f xs `thenRn` \ (rs1, rs2) ->
442 returnRn (r1:rs1, r2:rs2)
444 mapAndUnzip3Rn f [] = returnRn ([],[],[])
445 mapAndUnzip3Rn f (x:xs)
446 = f x `thenRn` \ (r1, r2, r3) ->
447 mapAndUnzip3Rn f xs `thenRn` \ (rs1, rs2, rs3) ->
448 returnRn (r1:rs1, r2:rs2, r3:rs3)
450 mapMaybeRn f def Nothing = returnRn def
451 mapMaybeRn f def (Just v) = f v
456 %************************************************************************
458 \subsection{Boring plumbing for common part}
460 %************************************************************************
463 ================ Errors and warnings =====================
466 failWithRn :: a -> Error -> RnM s d a
467 failWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
468 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
469 writeMutVarSST errs_var (warns, errs `snocBag` err) `thenSST_`
472 err = addShortErrLocLine loc msg
474 warnWithRn :: a -> Warning -> RnM s d a
475 warnWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
476 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
477 writeMutVarSST errs_var (warns `snocBag` warn, errs) `thenSST_`
480 warn = addShortWarnLocLine loc msg
482 addErrRn :: Error -> RnM s d ()
483 addErrRn err = failWithRn () err
485 checkRn :: Bool -> Error -> RnM s d () -- Check that a condition is true
486 checkRn False err = addErrRn err
487 checkRn True err = returnRn ()
489 addWarnRn :: Warning -> RnM s d ()
490 addWarnRn warn = warnWithRn () warn
492 checkErrsRn :: RnM s d Bool -- True <=> no errors so far
493 checkErrsRn (RnDown loc names_var errs_var occs_var) l_down
494 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
495 returnSST (isEmptyBag errs)
499 ================ Source location =====================
502 pushSrcLocRn :: SrcLoc -> RnM s d a -> RnM s d a
503 pushSrcLocRn loc' m (RnDown loc names_var errs_var occs_var) l_down
504 = m (RnDown loc' names_var errs_var occs_var) l_down
506 getSrcLocRn :: RnM s d SrcLoc
507 getSrcLocRn (RnDown loc names_var errs_var occs_var) l_down
511 ================ Name supply =====================
514 getNameSupplyRn :: RnM s d RnNameSupply
515 getNameSupplyRn (RnDown loc names_var errs_var occs_var) l_down
516 = readMutVarSST names_var
518 setNameSupplyRn :: RnNameSupply -> RnM s d ()
519 setNameSupplyRn names' (RnDown loc names_var errs_var occs_var) l_down
520 = writeMutVarSST names_var names'
522 -- The "instance-decl unique supply", inst, is just an integer that's used to
523 -- give a unique number for each instance declaration.
524 newInstUniq :: RnM s d Int
525 newInstUniq (RnDown loc names_var errs_var occs_var) l_down
526 = readMutVarSST names_var `thenSST` \ (us, inst, cache) ->
527 writeMutVarSST names_var (us, inst+1, cache) `thenSST_`
531 ================ Occurrences =====================
533 Every time we get an occurrence of a name we put it in one of two lists:
534 one for "compulsory" occurrences
535 one for "optional" occurrences
537 The significance of "compulsory" is
538 (a) we *must* find the declaration
539 (b) in the case of type or class names, the name is part of the
540 source level program, and we must slurp in any instance decls
543 We don't need instance decls "optional" names, because the type inference
544 process will never come across them. Optional names are buried inside
545 type checked (but not renamed) cross-module unfoldings and such.
547 The pair of lists is held in a mutable variable in RnDown.
549 The lists are kept separate so that we can process all the compulsory occurrences
550 before any of the optional ones. Why? Because suppose we processed an optional
551 "g", and slurped an interface decl of g::T->T. Then we'd rename the type T->T in
552 optional mode. But if we later need g compulsorily we'll find that it's already
553 been slurped and will do nothing. We could, I suppose, rename it a second time,
554 but it seems simpler just to do all the compulsory ones first.
557 addOccurrenceName :: Name -> RnMS s Name -- Same name returned as passed
558 addOccurrenceName name (RnDown loc names_var errs_var occs_var)
559 (SDown rn_env local_env mod_name mode)
560 | isLocallyDefinedName name ||
561 not_necessary necessity
565 = readMutVarSST occs_var `thenSST` \ (comp_occs, opt_occs) ->
567 new_occ_pair = case necessity of
568 Optional -> (comp_occs, name:opt_occs)
569 Compulsory -> (name:comp_occs, opt_occs)
571 writeMutVarSST occs_var new_occ_pair `thenSST_`
574 necessity = case mode of
575 SourceMode -> Compulsory
576 InterfaceMode necessity -> necessity
579 addOccurrenceNames :: [Name] -> RnMS s ()
580 addOccurrenceNames names (RnDown loc names_var errs_var occs_var)
581 (SDown rn_env local_env mod_name mode)
582 | not_necessary necessity
586 = readMutVarSST occs_var `thenSST` \ (comp_occs, opt_occs) ->
588 new_occ_pair = case necessity of
589 Optional -> (comp_occs, non_local_names ++ opt_occs)
590 Compulsory -> (non_local_names ++ comp_occs, opt_occs)
592 writeMutVarSST occs_var new_occ_pair
594 non_local_names = filter (not . isLocallyDefinedName) names
595 necessity = case mode of
596 SourceMode -> Compulsory
597 InterfaceMode necessity -> necessity
599 -- Never look for optional things if we're
600 -- ignoring optional input interface information
601 not_necessary Compulsory = False
602 not_necessary Optional = opt_IgnoreIfacePragmas
604 popOccurrenceName :: Necessity -> RnM s d (Maybe Name)
605 popOccurrenceName necessity (RnDown loc names_var errs_var occs_var) l_down
606 = readMutVarSST occs_var `thenSST` \ occs ->
607 case (necessity, occs) of
608 -- Find a compulsory occurrence
609 (Compulsory, (comp:comps, opts)) -> writeMutVarSST occs_var (comps, opts) `thenSST_`
610 returnSST (Just comp)
612 -- Find an optional occurrence
613 -- We shouldn't be looking unless we've done all the compulsories
614 (Optional, (comps, opt:opts)) -> ASSERT( null comps )
615 writeMutVarSST occs_var (comps, opts) `thenSST_`
618 -- No suitable occurrence
619 other -> returnSST Nothing
621 -- findOccurrencesRn does the enclosed thing with a *fresh* occurrences
622 -- variable, and returns the list of occurrences thus found. It's useful
623 -- when loading instance decls and specialisation signatures, when we want to
624 -- know the names of the things in the types, but we don't want to treat them
627 findOccurrencesRn :: RnM s d a -> RnM s d [Name]
628 findOccurrencesRn enclosed_thing (RnDown loc names_var errs_var occs_var) l_down
629 = newMutVarSST ([],[]) `thenSST` \ new_occs_var ->
630 enclosed_thing (RnDown loc names_var errs_var new_occs_var) l_down `thenSST_`
631 readMutVarSST new_occs_var `thenSST` \ (occs,_) ->
636 %************************************************************************
638 \subsection{Plumbing for rename-source part}
640 %************************************************************************
642 ================ RnEnv =====================
645 getGlobalNameEnv :: RnMS s NameEnv
646 getGlobalNameEnv rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)
647 = returnSST global_env
649 getNameEnv :: RnMS s NameEnv
650 getNameEnv rn_down (SDown rn_env local_env mod_name mode)
651 = returnSST local_env
653 setNameEnv :: NameEnv -> RnMS s a -> RnMS s a
654 setNameEnv local_env' m rn_down (SDown rn_env local_env mod_name mode)
655 = m rn_down (SDown rn_env local_env' mod_name mode)
657 getFixityEnv :: RnMS s FixityEnv
658 getFixityEnv rn_down (SDown (RnEnv name_env fixity_env) local_env mod_name mode)
659 = returnSST fixity_env
662 ================ Module and Mode =====================
665 getModuleRn :: RnMS s Module
666 getModuleRn rn_down (SDown rn_env local_env mod_name mode)
671 getModeRn :: RnMS s RnSMode
672 getModeRn rn_down (SDown rn_env local_env mod_name mode)
675 setModeRn :: RnSMode -> RnMS s a -> RnMS s a
676 setModeRn new_mode thing_inside rn_down (SDown rn_env local_env mod_name mode)
677 = thing_inside rn_down (SDown rn_env local_env mod_name new_mode)
681 %************************************************************************
683 \subsection{Plumbing for rename-globals part}
685 %************************************************************************
688 getIfacesRn :: RnMG Ifaces
689 getIfacesRn rn_down (GDown dirs iface_var)
690 = readMutVarSST iface_var
692 setIfacesRn :: Ifaces -> RnMG ()
693 setIfacesRn ifaces rn_down (GDown dirs iface_var)
694 = writeMutVarSST iface_var ifaces
696 getSearchPathRn :: RnMG SearchPath
697 getSearchPathRn rn_down (GDown dirs iface_var)