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)
357 else if not (isEmptyBag warns) then
358 pprTrace "Urk! renameSourceCode found warnings" (display warns)
365 display errs = pprBagOfErrors errs
367 {-# INLINE thenRn #-}
368 {-# INLINE thenRn_ #-}
369 {-# INLINE returnRn #-}
372 returnRn :: a -> RnM s d a
373 thenRn :: RnM s d a -> (a -> RnM s d b) -> RnM s d b
374 thenRn_ :: RnM s d a -> RnM s d b -> RnM s d b
375 andRn :: (a -> a -> a) -> RnM s d a -> RnM s d a -> RnM s d a
376 mapRn :: (a -> RnM s d b) -> [a] -> RnM s d [b]
377 mapMaybeRn :: (a -> RnM s d b) -> b -> Maybe a -> RnM s d b
378 sequenceRn :: [RnM s d a] -> RnM s d [a]
379 foldlRn :: (b -> a -> RnM s d b) -> b -> [a] -> RnM s d b
380 mapAndUnzipRn :: (a -> RnM s d (b,c)) -> [a] -> RnM s d ([b],[c])
381 fixRn :: (a -> RnM s d a) -> RnM s d a
383 returnRn v gdown ldown = returnSST v
384 thenRn m k gdown ldown = m gdown ldown `thenSST` \ r -> k r gdown ldown
385 thenRn_ m k gdown ldown = m gdown ldown `thenSST_` k gdown ldown
386 fixRn m gdown ldown = fixSST (\r -> m r gdown ldown)
387 andRn combiner m1 m2 gdown ldown
388 = m1 gdown ldown `thenSST` \ res1 ->
389 m2 gdown ldown `thenSST` \ res2 ->
390 returnSST (combiner res1 res2)
392 sequenceRn [] = returnRn []
393 sequenceRn (m:ms) = m `thenRn` \ r ->
394 sequenceRn ms `thenRn` \ rs ->
397 mapRn f [] = returnRn []
399 = f x `thenRn` \ r ->
400 mapRn f xs `thenRn` \ rs ->
403 foldlRn k z [] = returnRn z
404 foldlRn k z (x:xs) = k z x `thenRn` \ z' ->
407 mapAndUnzipRn f [] = returnRn ([],[])
408 mapAndUnzipRn f (x:xs)
409 = f x `thenRn` \ (r1, r2) ->
410 mapAndUnzipRn f xs `thenRn` \ (rs1, rs2) ->
411 returnRn (r1:rs1, r2:rs2)
413 mapAndUnzip3Rn f [] = returnRn ([],[],[])
414 mapAndUnzip3Rn f (x:xs)
415 = f x `thenRn` \ (r1, r2, r3) ->
416 mapAndUnzip3Rn f xs `thenRn` \ (rs1, rs2, rs3) ->
417 returnRn (r1:rs1, r2:rs2, r3:rs3)
419 mapMaybeRn f def Nothing = returnRn def
420 mapMaybeRn f def (Just v) = f v
425 %************************************************************************
427 \subsection{Boring plumbing for common part}
429 %************************************************************************
432 ================ Errors and warnings =====================
435 failWithRn :: a -> ErrMsg -> RnM s d a
436 failWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
437 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
438 writeMutVarSST errs_var (warns, errs `snocBag` err) `thenSST_`
441 err = addShortErrLocLine loc msg
443 warnWithRn :: a -> WarnMsg -> RnM s d a
444 warnWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
445 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
446 writeMutVarSST errs_var (warns `snocBag` warn, errs) `thenSST_`
449 warn = addShortWarnLocLine loc msg
451 addErrRn :: ErrMsg -> RnM s d ()
452 addErrRn err = failWithRn () err
454 checkRn :: Bool -> ErrMsg -> RnM s d () -- Check that a condition is true
455 checkRn False err = addErrRn err
456 checkRn True err = returnRn ()
458 addWarnRn :: WarnMsg -> RnM s d ()
459 addWarnRn warn = warnWithRn () warn
461 checkErrsRn :: RnM s d Bool -- True <=> no errors so far
462 checkErrsRn (RnDown loc names_var errs_var occs_var) l_down
463 = readMutVarSST errs_var `thenSST` \ (warns,errs) ->
464 returnSST (isEmptyBag errs)
468 ================ Source location =====================
471 pushSrcLocRn :: SrcLoc -> RnM s d a -> RnM s d a
472 pushSrcLocRn loc' m (RnDown loc names_var errs_var occs_var) l_down
473 = m (RnDown loc' names_var errs_var occs_var) l_down
475 getSrcLocRn :: RnM s d SrcLoc
476 getSrcLocRn (RnDown loc names_var errs_var occs_var) l_down
480 ================ Name supply =====================
483 getNameSupplyRn :: RnM s d RnNameSupply
484 getNameSupplyRn (RnDown loc names_var errs_var occs_var) l_down
485 = readMutVarSST names_var
487 setNameSupplyRn :: RnNameSupply -> RnM s d ()
488 setNameSupplyRn names' (RnDown loc names_var errs_var occs_var) l_down
489 = writeMutVarSST names_var names'
491 -- The "instance-decl unique supply", inst, is just an integer that's used to
492 -- give a unique number for each instance declaration.
493 newInstUniq :: RnM s d Int
494 newInstUniq (RnDown loc names_var errs_var occs_var) l_down
495 = readMutVarSST names_var `thenSST` \ (us, inst, cache) ->
496 writeMutVarSST names_var (us, inst+1, cache) `thenSST_`
500 ================ Occurrences =====================
502 Every time we get an occurrence of a name we put it in one of two lists:
503 one for "compulsory" occurrences
504 one for "optional" occurrences
506 The significance of "compulsory" is
507 (a) we *must* find the declaration
508 (b) in the case of type or class names, the name is part of the
509 source level program, and we must slurp in any instance decls
512 We don't need instance decls "optional" names, because the type inference
513 process will never come across them. Optional names are buried inside
514 type checked (but not renamed) cross-module unfoldings and such.
516 The pair of lists is held in a mutable variable in RnDown.
518 The lists are kept separate so that we can process all the compulsory occurrences
519 before any of the optional ones. Why? Because suppose we processed an optional
520 "g", and slurped an interface decl of g::T->T. Then we'd rename the type T->T in
521 optional mode. But if we later need g compulsorily we'll find that it's already
522 been slurped and will do nothing. We could, I suppose, rename it a second time,
523 but it seems simpler just to do all the compulsory ones first.
526 addOccurrenceName :: Name -> RnMS s Name -- Same name returned as passed
527 addOccurrenceName name (RnDown loc names_var errs_var occs_var)
528 (SDown rn_env local_env mod_name mode)
529 | isLocallyDefinedName name ||
530 not_necessary necessity
534 = readMutVarSST occs_var `thenSST` \ (comp_occs, opt_occs) ->
536 new_occ_pair = case necessity of
537 Optional -> (comp_occs, (name,loc):opt_occs)
538 Compulsory -> ((name,loc):comp_occs, opt_occs)
540 writeMutVarSST occs_var new_occ_pair `thenSST_`
543 necessity = modeToNecessity mode
546 addOccurrenceNames :: [Name] -> RnMS s ()
547 addOccurrenceNames names (RnDown loc names_var errs_var occs_var)
548 (SDown rn_env local_env mod_name mode)
549 | not_necessary necessity
553 = readMutVarSST occs_var `thenSST` \ (comp_occs, opt_occs) ->
555 new_occ_pair = case necessity of
556 Optional -> (comp_occs, non_local_occs ++ opt_occs)
557 Compulsory -> (non_local_occs ++ comp_occs, opt_occs)
559 writeMutVarSST occs_var new_occ_pair
561 non_local_occs = [(name, loc) | name <- names, not (isLocallyDefinedName name)]
562 necessity = modeToNecessity mode
564 -- Never look for optional things if we're
565 -- ignoring optional input interface information
566 not_necessary Compulsory = False
567 not_necessary Optional = opt_IgnoreIfacePragmas
569 popOccurrenceName :: RnSMode -> RnM s d (Maybe Occurrence)
570 popOccurrenceName mode (RnDown loc names_var errs_var occs_var) l_down
571 = readMutVarSST occs_var `thenSST` \ occs ->
573 -- Find a compulsory occurrence
574 (InterfaceMode Compulsory _, (comp:comps, opts))
575 -> writeMutVarSST occs_var (comps, opts) `thenSST_`
576 returnSST (Just comp)
578 -- Find an optional occurrence
579 -- We shouldn't be looking unless we've done all the compulsories
580 (InterfaceMode Optional _, (comps, opt:opts))
581 -> ASSERT( null comps )
582 writeMutVarSST occs_var (comps, opts) `thenSST_`
585 -- No suitable occurrence
586 other -> returnSST Nothing
588 -- findOccurrencesRn does the enclosed thing with a *fresh* occurrences
589 -- variable, and returns the list of occurrences thus found. It's useful
590 -- when loading instance decls and specialisation signatures, when we want to
591 -- know the names of the things in the types, but we don't want to treat them
594 findOccurrencesRn :: RnM s d a -> RnM s d [Name]
595 findOccurrencesRn enclosed_thing (RnDown loc names_var errs_var occs_var) l_down
596 = newMutVarSST ([],[]) `thenSST` \ new_occs_var ->
597 enclosed_thing (RnDown loc names_var errs_var new_occs_var) l_down `thenSST_`
598 readMutVarSST new_occs_var `thenSST` \ (occs,_) ->
599 returnSST (map fst occs)
603 %************************************************************************
605 \subsection{Plumbing for rename-source part}
607 %************************************************************************
609 ================ RnEnv =====================
612 -- Look in global env only
613 lookupGlobalNameRn :: RdrName -> RnMS s (Maybe Name)
614 lookupGlobalNameRn rdr_name rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)
615 = case lookupFM global_env rdr_name of
616 Just (name, _) -> returnSST (Just name)
617 Nothing -> returnSST Nothing
619 -- Look in both local and global env
620 lookupNameRn :: RdrName -> RnMS s (Maybe Name)
621 lookupNameRn rdr_name rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)
622 = case lookupFM local_env rdr_name of
623 Just name -> returnSST (Just name)
624 Nothing -> case lookupFM global_env rdr_name of
625 Just (name, _) -> returnSST (Just name)
626 Nothing -> returnSST Nothing
628 getNameEnvs :: RnMS s (GlobalNameEnv, NameEnv)
629 getNameEnvs rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)
630 = returnSST (global_env, local_env)
632 getLocalNameEnv :: RnMS s NameEnv
633 getLocalNameEnv rn_down (SDown rn_env local_env mod_name mode)
634 = returnSST local_env
636 setLocalNameEnv :: NameEnv -> RnMS s a -> RnMS s a
637 setLocalNameEnv local_env' m rn_down (SDown rn_env local_env mod_name mode)
638 = m rn_down (SDown rn_env local_env' mod_name mode)
640 getFixityEnv :: RnMS s FixityEnv
641 getFixityEnv rn_down (SDown (RnEnv name_env fixity_env) local_env mod_name mode)
642 = returnSST fixity_env
645 ================ Module and Mode =====================
648 getModuleRn :: RnMS s Module
649 getModuleRn rn_down (SDown rn_env local_env mod_name mode)
654 getModeRn :: RnMS s RnSMode
655 getModeRn rn_down (SDown rn_env local_env mod_name mode)
658 setModeRn :: RnSMode -> RnMS s a -> RnMS s a
659 setModeRn new_mode thing_inside rn_down (SDown rn_env local_env mod_name mode)
660 = thing_inside rn_down (SDown rn_env local_env mod_name new_mode)
664 %************************************************************************
666 \subsection{Plumbing for rename-globals part}
668 %************************************************************************
671 getIfacesRn :: RnMG Ifaces
672 getIfacesRn rn_down (GDown dirs iface_var)
673 = readMutVarSST iface_var
675 setIfacesRn :: Ifaces -> RnMG ()
676 setIfacesRn ifaces rn_down (GDown dirs iface_var)
677 = writeMutVarSST iface_var ifaces
679 getSearchPathRn :: RnMG SearchPath
680 getSearchPathRn rn_down (GDown dirs iface_var)
684 %************************************************************************
686 \subsection{HowInScope}
688 %************************************************************************
691 instance Outputable HowInScope where
692 ppr (FromLocalDefn loc) = ptext SLIT("Defined at") <+> ppr loc
693 ppr (FromImportDecl mod loc) = ptext SLIT("Imported from") <+> quotes (pprModule mod) <+>
694 ptext SLIT("at") <+> ppr loc
699 modeToNecessity SourceMode = Compulsory
700 modeToNecessity (InterfaceMode necessity _) = necessity