2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1997
4 \section[RnMonad]{The monad used by the renamer}
21 #include "HsVersions.h"
24 import GlaExts ( RealWorld, stToIO )
28 import BasicTypes ( Version, NewOrData, pprModule )
29 import SrcLoc ( noSrcLoc )
30 import ErrUtils ( addShortErrLocLine, addShortWarnLocLine,
31 pprBagOfErrors, ErrMsg, WarnMsg
33 import Name ( Module, Name, OccName, PrintUnqualified, NameSet, emptyNameSet,
35 modAndOcc, NamedThing(..)
37 import CmdLineOpts ( opt_D_show_rn_trace, opt_IgnoreIfacePragmas )
38 import PrelInfo ( builtinNames )
39 import TysWiredIn ( boolTyCon )
40 import SrcLoc ( SrcLoc, mkGeneratedSrcLoc )
41 import Unique ( Unique )
42 import UniqFM ( UniqFM )
43 import FiniteMap ( FiniteMap, emptyFM, bagToFM, lookupFM )
44 import Bag ( Bag, mapBag, emptyBag, isEmptyBag, snocBag )
50 infixr 9 `thenRn`, `thenRn_`
54 %************************************************************************
56 \subsection{Somewhat magical interface to other monads}
58 %************************************************************************
61 sstToIO :: SST RealWorld r -> IO r
62 sstToIO sst = stToIO (sstToST sst)
64 ioToRnMG :: IO r -> RnMG (Either IOError r)
65 ioToRnMG io rn_down g_down = ioToSST io
67 traceRn :: SDoc -> RnMG ()
68 traceRn msg | opt_D_show_rn_trace = putDocRn msg
69 | otherwise = returnRn ()
71 putDocRn :: SDoc -> RnMG ()
72 putDocRn msg = ioToRnMG (printErrs msg) `thenRn_`
77 %************************************************************************
79 \subsection{Data types}
81 %************************************************************************
83 ===================================================
85 ===================================================
88 type RnM s d r = RnDown s -> d -> SST s r
89 type RnMS s r = RnM s (SDown s) r -- Renaming source
90 type RnMG r = RnM RealWorld GDown r -- Getting global names etc
91 type SSTRWRef a = SSTRef RealWorld a -- ToDo: there ought to be a standard defn of this
94 data RnDown s = RnDown
96 (SSTRef s RnNameSupply)
97 (SSTRef s (Bag WarnMsg, Bag ErrMsg))
98 (SSTRef s ([Occurrence],[Occurrence])) -- Occurrences: compulsory and optional resp
100 type Occurrence = (Name, SrcLoc) -- The srcloc is the occurrence site
102 data Necessity = Compulsory | Optional -- We *must* find definitions for
103 -- compulsory occurrences; we *may* find them
104 -- for optional ones.
106 -- For getting global names
111 -- For renaming source code
114 NameEnv -- Local name envt (includes global name envt,
115 -- but may shadow it)
120 data RnSMode = SourceMode -- Renaming source code
121 | InterfaceMode -- Renaming interface declarations.
122 Necessity -- The "necessity"
123 -- flag says free variables *must* be found and slurped
124 -- or whether they need not be. For value signatures of
125 -- things that are themselves compulsorily imported
126 -- we arrange that the type signature is read
127 -- in compulsory mode,
128 -- but the pragmas in optional mode.
129 (Name -> PrintUnqualified) -- Tells whether the thing can be printed unqualified
131 type SearchPath = [(String,String)] -- List of (directory,suffix) pairs to search
132 -- for interface files.
133 type FreeVars = NameSet
136 ===================================================
138 ===================================================
141 type RnNameSupply = (UniqSupply, Int, FiniteMap (Module,OccName) Name)
142 -- Ensures that one (m,n) pair gets one unique
143 -- The Int is used to give a number to each instance declaration;
144 -- it's really a separate name supply.
146 data RnEnv = RnEnv GlobalNameEnv FixityEnv
147 emptyRnEnv = RnEnv emptyNameEnv emptyFixityEnv
149 type GlobalNameEnv = FiniteMap RdrName (Name, HowInScope)
150 emptyGlobalNameEnv = emptyFM
152 data HowInScope -- Used for error messages only
153 = FromLocalDefn SrcLoc
154 | FromImportDecl Module SrcLoc
156 type NameEnv = FiniteMap RdrName Name
157 emptyNameEnv = emptyFM
159 type FixityEnv = FiniteMap RdrName (Fixity, HowInScope)
160 emptyFixityEnv = emptyFM
161 -- It's possible to have a different fixity for B.op than for op:
163 -- module A( op ) where module B where
164 -- import qualified B( op ) infixr 2 op
165 -- infixl 9 `op` op = ...
166 -- op a b = a `B.op` b
168 data ExportEnv = ExportEnv Avails Fixities
169 type Avails = [AvailInfo]
170 type Fixities = [(OccName, Fixity)]
172 type ExportAvails = (FiniteMap Module Avails, -- Used to figure out "module M" export specifiers
173 -- Includes avails only from *unqualified* imports
174 -- (see 1.4 Report Section 5.1.1)
176 UniqFM AvailInfo) -- Used to figure out all other export specifiers.
177 -- Maps a Name to the AvailInfo that contains it
178 -- NB: Contain bindings for class ops but
179 -- not constructors (see defn of availEntityNames)
182 data GenAvailInfo name = NotAvailable
183 | Avail name -- An ordinary identifier
184 | AvailTC name -- The name of the type or class
185 [name] -- The available pieces of type/class. NB: If the type or
186 -- class is itself to be in scope, it must be in this list.
187 -- Thus, typically: AvailTC Eq [Eq, ==, /=]
188 type AvailInfo = GenAvailInfo Name
189 type RdrAvailInfo = GenAvailInfo OccName
192 ===================================================
194 ===================================================
197 type ExportItem = (Module, IfaceFlavour, [RdrAvailInfo])
198 type VersionInfo name = [ImportVersion name]
200 type ImportVersion name = (Module, IfaceFlavour, Version, WhatsImported name)
201 data WhatsImported name = Everything
202 | Specifically [LocalVersion name] -- List guaranteed non-empty
204 -- ("M", hif, ver, Everything) means there was a "module M" in
205 -- this module's export list, so we just have to go by M's version, "ver",
206 -- not the list of LocalVersions.
209 type LocalVersion name = (name, Version)
213 Module -- Module name
214 Version -- Module version number
215 [ImportVersion OccName] -- Usages
216 [ExportItem] -- Exports
217 [Module] -- Special instance modules
218 [(OccName,Fixity)] -- Fixities
219 [(Version, RdrNameHsDecl)] -- Local definitions
220 [RdrNameInstDecl] -- Local instance declarations
222 type InterfaceDetails = (VersionInfo Name, -- Version information for what this module imports
223 ExportEnv, -- What this module exports
224 [Module]) -- Instance modules
226 type RdrNamePragma = () -- Fudge for now
230 Module -- Name of this module
231 (FiniteMap Module (IfaceFlavour, -- Exports
237 NameSet -- All the names (whether "big" or "small", whether wired-in or not,
238 -- whether locally defined or not) that have been slurped in so far.
240 [(Name,Version)] -- All the (a) non-wired-in (b) "big" (c) non-locally-defined names that
241 -- have been slurped in so far, with their versions.
242 -- This is used to generate the "usage" information for this module.
243 -- Subset of the previous field.
245 (Bag IfaceInst, NameSet) -- The as-yet un-slurped instance decls; this bag is depleted when we
246 -- slurp an instance decl so that we don't slurp the same one twice.
247 -- Together with them is the set of tycons/classes that may allow
248 -- the instance decls in.
250 (FiniteMap Name RdrNameTyDecl)
251 -- Deferred data type declarations; each has the following properties
252 -- * it's a data type decl
253 -- * its TyCon is needed
254 -- * the decl may or may not have been slurped, depending on whether any
255 -- of the constrs are needed.
257 [Module] -- Set of modules with "special" instance declarations
258 -- Excludes this module
261 type DeclsMap = FiniteMap Name (Version, AvailInfo, RdrNameHsDecl)
262 type IfaceInst = ((Module, RdrNameInstDecl), -- Instance decl
263 [Name]) -- "Gate" names. Slurp this instance decl when this
264 -- list becomes empty. It's depleted whenever we
265 -- slurp another type or class decl.
269 %************************************************************************
271 \subsection{Main monad code}
273 %************************************************************************
276 initRn :: Module -> UniqSupply -> SearchPath -> SrcLoc
278 -> IO (r, Bag ErrMsg, Bag WarnMsg)
280 initRn mod us dirs loc do_rn
282 newMutVarSST (us, 1, builtins) `thenSST` \ names_var ->
283 newMutVarSST (emptyBag,emptyBag) `thenSST` \ errs_var ->
284 newMutVarSST (emptyIfaces mod) `thenSST` \ iface_var ->
285 newMutVarSST initOccs `thenSST` \ occs_var ->
287 rn_down = RnDown loc names_var errs_var occs_var
288 g_down = GDown dirs iface_var
291 do_rn rn_down g_down `thenSST` \ res ->
293 -- grab errors and return
294 readMutVarSST errs_var `thenSST` \ (warns,errs) ->
295 returnSST (res, errs, warns)
298 initRnMS :: RnEnv -> Module -> RnSMode -> RnMS RealWorld r -> RnMG r
299 initRnMS rn_env@(RnEnv name_env _) mod_name mode m rn_down g_down
301 s_down = SDown rn_env emptyNameEnv mod_name mode
306 emptyIfaces :: Module -> Ifaces
307 emptyIfaces mod = Ifaces mod emptyFM emptyFM emptyNameSet [] (emptyBag, emptyNameSet) emptyFM []
309 builtins :: FiniteMap (Module,OccName) Name
310 builtins = bagToFM (mapBag (\ name -> (modAndOcc name, name)) builtinNames)
312 -- Initial value for the occurrence pool.
313 initOccs :: ([Occurrence],[Occurrence]) -- Compulsory and optional respectively
314 initOccs = ([(getName boolTyCon, noSrcLoc)], [])
315 -- Booleans occur implicitly a lot, so it's tiresome to keep recording the fact, and
316 -- rather implausible that not one will be used in the module.
317 -- We could add some other common types, notably lists, but the general idea is
318 -- to do as much as possible explicitly.
324 @renameSourceCode@ is used to rename stuff "out-of-line"; that is, not as part of
325 the main renamer. Examples: pragmas (which we don't want to rename unless
326 we actually explore them); and derived definitions, which are only generated
329 The @RnNameSupply@ includes a @UniqueSupply@, so if you call it more than
330 once you must either split it, or install a fresh unique supply.
333 renameSourceCode :: Module
338 -- Alas, we can't use the real runST, with the desired signature:
339 -- renameSourceCode :: RnNameSupply -> RnMS s r -> r
340 -- because we can't manufacture "new versions of runST".
342 renameSourceCode mod_name name_supply m
344 newMutVarSST name_supply `thenSST` \ names_var ->
345 newMutVarSST (emptyBag,emptyBag) `thenSST` \ errs_var ->
346 newMutVarSST ([],[]) `thenSST` \ occs_var ->
348 rn_down = RnDown mkGeneratedSrcLoc names_var errs_var occs_var
349 s_down = SDown emptyRnEnv emptyNameEnv mod_name (InterfaceMode Compulsory (\_ -> False))
351 m rn_down s_down `thenSST` \ result ->
353 readMutVarSST errs_var `thenSST` \ (warns,errs) ->
355 (if not (isEmptyBag errs) then
356 pprTrace "Urk! renameSourceCode found errors" (display errs)
358 else if not (isEmptyBag warns) then
359 pprTrace "Urk! renameSourceCode found warnings" (display warns)
367 display errs = pprBagOfErrors errs
369 {-# INLINE thenRn #-}
370 {-# INLINE thenRn_ #-}
371 {-# INLINE returnRn #-}
374 returnRn :: a -> RnM s d a
375 thenRn :: RnM s d a -> (a -> RnM s d b) -> RnM s d b
376 thenRn_ :: RnM s d a -> RnM s d b -> RnM s d b
377 andRn :: (a -> a -> a) -> RnM s d a -> RnM s d a -> RnM s d a
378 mapRn :: (a -> RnM s d b) -> [a] -> RnM s d [b]
379 mapMaybeRn :: (a -> RnM s d b) -> b -> Maybe a -> RnM s d b
380 sequenceRn :: [RnM s d a] -> RnM s d [a]
381 foldlRn :: (b -> a -> RnM s d b) -> b -> [a] -> RnM s d b
382 mapAndUnzipRn :: (a -> RnM s d (b,c)) -> [a] -> RnM s d ([b],[c])
383 fixRn :: (a -> RnM s d a) -> RnM s d a
385 returnRn v gdown ldown = returnSST v
386 thenRn m k gdown ldown = m gdown ldown `thenSST` \ r -> k r gdown ldown
387 thenRn_ m k gdown ldown = m gdown ldown `thenSST_` k gdown ldown
388 fixRn m gdown ldown = fixSST (\r -> m r gdown ldown)
389 andRn combiner m1 m2 gdown ldown
390 = m1 gdown ldown `thenSST` \ res1 ->
391 m2 gdown ldown `thenSST` \ res2 ->
392 returnSST (combiner res1 res2)
394 sequenceRn [] = returnRn []
395 sequenceRn (m:ms) = m `thenRn` \ r ->
396 sequenceRn ms `thenRn` \ rs ->
399 mapRn f [] = returnRn []
401 = f x `thenRn` \ r ->
402 mapRn f xs `thenRn` \ rs ->
405 foldlRn k z [] = returnRn z
406 foldlRn k z (x:xs) = k z x `thenRn` \ z' ->
409 mapAndUnzipRn f [] = returnRn ([],[])
410 mapAndUnzipRn f (x:xs)
411 = f x `thenRn` \ (r1, r2) ->
412 mapAndUnzipRn f xs `thenRn` \ (rs1, rs2) ->
413 returnRn (r1:rs1, r2:rs2)
415 mapAndUnzip3Rn f [] = returnRn ([],[],[])
416 mapAndUnzip3Rn f (x:xs)
417 = f x `thenRn` \ (r1, r2, r3) ->
418 mapAndUnzip3Rn f xs `thenRn` \ (rs1, rs2, rs3) ->
419 returnRn (r1:rs1, r2:rs2, r3:rs3)
421 mapMaybeRn f def Nothing = returnRn def
422 mapMaybeRn f def (Just v) = f v
427 %************************************************************************
429 \subsection{Boring plumbing for common part}
431 %************************************************************************
434 ================ Errors and warnings =====================
437 failWithRn :: a -> ErrMsg -> RnM s d a
438 failWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
439 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
440 writeMutVarSST errs_var (warns, errs `snocBag` err) `thenSST_`
443 err = addShortErrLocLine loc msg
445 warnWithRn :: a -> WarnMsg -> RnM s d a
446 warnWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
447 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
448 writeMutVarSST errs_var (warns `snocBag` warn, errs) `thenSST_`
451 warn = addShortWarnLocLine loc msg
453 addErrRn :: ErrMsg -> RnM s d ()
454 addErrRn err = failWithRn () err
456 checkRn :: Bool -> ErrMsg -> RnM s d () -- Check that a condition is true
457 checkRn False err = addErrRn err
458 checkRn True err = returnRn ()
460 addWarnRn :: WarnMsg -> RnM s d ()
461 addWarnRn warn = warnWithRn () warn
463 checkErrsRn :: RnM s d Bool -- True <=> no errors so far
464 checkErrsRn (RnDown loc names_var errs_var occs_var) l_down
465 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
466 returnSST (isEmptyBag errs)
470 ================ Source location =====================
473 pushSrcLocRn :: SrcLoc -> RnM s d a -> RnM s d a
474 pushSrcLocRn loc' m (RnDown loc names_var errs_var occs_var) l_down
475 = m (RnDown loc' names_var errs_var occs_var) l_down
477 getSrcLocRn :: RnM s d SrcLoc
478 getSrcLocRn (RnDown loc names_var errs_var occs_var) l_down
482 ================ Name supply =====================
485 getNameSupplyRn :: RnM s d RnNameSupply
486 getNameSupplyRn (RnDown loc names_var errs_var occs_var) l_down
487 = readMutVarSST names_var
489 setNameSupplyRn :: RnNameSupply -> RnM s d ()
490 setNameSupplyRn names' (RnDown loc names_var errs_var occs_var) l_down
491 = writeMutVarSST names_var names'
493 -- The "instance-decl unique supply", inst, is just an integer that's used to
494 -- give a unique number for each instance declaration.
495 newInstUniq :: RnM s d Int
496 newInstUniq (RnDown loc names_var errs_var occs_var) l_down
497 = readMutVarSST names_var `thenSST` \ (us, inst, cache) ->
498 writeMutVarSST names_var (us, inst+1, cache) `thenSST_`
502 ================ Occurrences =====================
504 Every time we get an occurrence of a name we put it in one of two lists:
505 one for "compulsory" occurrences
506 one for "optional" occurrences
508 The significance of "compulsory" is
509 (a) we *must* find the declaration
510 (b) in the case of type or class names, the name is part of the
511 source level program, and we must slurp in any instance decls
514 We don't need instance decls "optional" names, because the type inference
515 process will never come across them. Optional names are buried inside
516 type checked (but not renamed) cross-module unfoldings and such.
518 The pair of lists is held in a mutable variable in RnDown.
520 The lists are kept separate so that we can process all the compulsory occurrences
521 before any of the optional ones. Why? Because suppose we processed an optional
522 "g", and slurped an interface decl of g::T->T. Then we'd rename the type T->T in
523 optional mode. But if we later need g compulsorily we'll find that it's already
524 been slurped and will do nothing. We could, I suppose, rename it a second time,
525 but it seems simpler just to do all the compulsory ones first.
528 addOccurrenceName :: Name -> RnMS s Name -- Same name returned as passed
529 addOccurrenceName name (RnDown loc names_var errs_var occs_var)
530 (SDown rn_env local_env mod_name mode)
531 | isLocallyDefinedName name ||
532 not_necessary necessity
536 = readMutVarSST occs_var `thenSST` \ (comp_occs, opt_occs) ->
538 new_occ_pair = case necessity of
539 Optional -> (comp_occs, (name,loc):opt_occs)
540 Compulsory -> ((name,loc):comp_occs, opt_occs)
542 writeMutVarSST occs_var new_occ_pair `thenSST_`
545 necessity = modeToNecessity mode
548 addOccurrenceNames :: [Name] -> RnMS s ()
549 addOccurrenceNames names (RnDown loc names_var errs_var occs_var)
550 (SDown rn_env local_env mod_name mode)
551 | not_necessary necessity
555 = readMutVarSST occs_var `thenSST` \ (comp_occs, opt_occs) ->
557 new_occ_pair = case necessity of
558 Optional -> (comp_occs, non_local_occs ++ opt_occs)
559 Compulsory -> (non_local_occs ++ comp_occs, opt_occs)
561 writeMutVarSST occs_var new_occ_pair
563 non_local_occs = [(name, loc) | name <- names, not (isLocallyDefinedName name)]
564 necessity = modeToNecessity mode
566 -- Never look for optional things if we're
567 -- ignoring optional input interface information
568 not_necessary Compulsory = False
569 not_necessary Optional = opt_IgnoreIfacePragmas
571 popOccurrenceName :: RnSMode -> RnM s d (Maybe Occurrence)
572 popOccurrenceName mode (RnDown loc names_var errs_var occs_var) l_down
573 = readMutVarSST occs_var `thenSST` \ occs ->
575 -- Find a compulsory occurrence
576 (InterfaceMode Compulsory _, (comp:comps, opts))
577 -> writeMutVarSST occs_var (comps, opts) `thenSST_`
578 returnSST (Just comp)
580 -- Find an optional occurrence
581 -- We shouldn't be looking unless we've done all the compulsories
582 (InterfaceMode Optional _, (comps, opt:opts))
583 -> ASSERT( null comps )
584 writeMutVarSST occs_var (comps, opts) `thenSST_`
587 -- No suitable occurrence
588 other -> returnSST Nothing
590 -- findOccurrencesRn does the enclosed thing with a *fresh* occurrences
591 -- variable, and returns the list of occurrences thus found. It's useful
592 -- when loading instance decls and specialisation signatures, when we want to
593 -- know the names of the things in the types, but we don't want to treat them
596 findOccurrencesRn :: RnM s d a -> RnM s d [Name]
597 findOccurrencesRn enclosed_thing (RnDown loc names_var errs_var occs_var) l_down
598 = newMutVarSST ([],[]) `thenSST` \ new_occs_var ->
599 enclosed_thing (RnDown loc names_var errs_var new_occs_var) l_down `thenSST_`
600 readMutVarSST new_occs_var `thenSST` \ (occs,_) ->
601 returnSST (map fst occs)
605 %************************************************************************
607 \subsection{Plumbing for rename-source part}
609 %************************************************************************
611 ================ RnEnv =====================
614 -- Look in global env only
615 lookupGlobalNameRn :: RdrName -> RnMS s (Maybe Name)
616 lookupGlobalNameRn rdr_name rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)
617 = case lookupFM global_env rdr_name of
618 Just (name, _) -> returnSST (Just name)
619 Nothing -> returnSST Nothing
621 -- Look in both local and global env
622 lookupNameRn :: RdrName -> RnMS s (Maybe Name)
623 lookupNameRn rdr_name rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)
624 = case lookupFM local_env rdr_name of
625 Just name -> returnSST (Just name)
626 Nothing -> case lookupFM global_env rdr_name of
627 Just (name, _) -> returnSST (Just name)
628 Nothing -> returnSST Nothing
630 getNameEnvs :: RnMS s (GlobalNameEnv, NameEnv)
631 getNameEnvs rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)
632 = returnSST (global_env, local_env)
634 getLocalNameEnv :: RnMS s NameEnv
635 getLocalNameEnv rn_down (SDown rn_env local_env mod_name mode)
636 = returnSST local_env
638 setLocalNameEnv :: NameEnv -> RnMS s a -> RnMS s a
639 setLocalNameEnv local_env' m rn_down (SDown rn_env local_env mod_name mode)
640 = m rn_down (SDown rn_env local_env' mod_name mode)
642 getFixityEnv :: RnMS s FixityEnv
643 getFixityEnv rn_down (SDown (RnEnv name_env fixity_env) local_env mod_name mode)
644 = returnSST fixity_env
647 ================ Module and Mode =====================
650 getModuleRn :: RnMS s Module
651 getModuleRn rn_down (SDown rn_env local_env mod_name mode)
656 getModeRn :: RnMS s RnSMode
657 getModeRn rn_down (SDown rn_env local_env mod_name mode)
660 setModeRn :: RnSMode -> RnMS s a -> RnMS s a
661 setModeRn new_mode thing_inside rn_down (SDown rn_env local_env mod_name mode)
662 = thing_inside rn_down (SDown rn_env local_env mod_name new_mode)
666 %************************************************************************
668 \subsection{Plumbing for rename-globals part}
670 %************************************************************************
673 getIfacesRn :: RnMG Ifaces
674 getIfacesRn rn_down (GDown dirs iface_var)
675 = readMutVarSST iface_var
677 setIfacesRn :: Ifaces -> RnMG ()
678 setIfacesRn ifaces rn_down (GDown dirs iface_var)
679 = writeMutVarSST iface_var ifaces
681 getSearchPathRn :: RnMG SearchPath
682 getSearchPathRn rn_down (GDown dirs iface_var)
686 %************************************************************************
688 \subsection{HowInScope}
690 %************************************************************************
693 instance Outputable HowInScope where
694 ppr (FromLocalDefn loc) = ptext SLIT("Defined at") <+> ppr loc
695 ppr (FromImportDecl mod loc) = ptext SLIT("Imported from") <+> quotes (pprModule mod) <+>
696 ptext SLIT("at") <+> ppr loc
701 modeToNecessity SourceMode = Compulsory
702 modeToNecessity (InterfaceMode necessity _) = necessity