2 % (c) The University of Glasgow, 2000
4 \section[HscTypes]{Types for the per-module compiler}
10 ModuleLocation(..), showModMsg,
12 ModDetails(..), ModIface(..),
13 HomeSymbolTable, emptySymbolTable,
15 HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
16 lookupIface, lookupIfaceByModName, moduleNameToModule,
19 InteractiveContext(..),
21 IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
23 VersionInfo(..), initialVersionInfo, lookupVersion,
24 FixityEnv, lookupFixity, collectFixities,
26 TyThing(..), isTyClThing, implicitTyThingIds,
28 TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
29 extendTypeEnvList, extendTypeEnvWithIds,
30 typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
32 ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..),
33 PersistentRenamerState(..), IsBootInterface, DeclsMap,
34 IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn, IsExported,
35 NameSupply(..), OrigNameCache, OrigIParamCache,
36 Avails, AvailEnv, emptyAvailEnv,
37 GenAvailInfo(..), AvailInfo, RdrAvailInfo,
38 ExportItem, RdrExportItem,
39 PersistentCompilerState(..),
41 Deprecations(..), lookupDeprec,
43 InstEnv, ClsInstEnv, DFunId,
44 PackageInstEnv, PackageRuleBase,
46 GlobalRdrEnv, GlobalRdrElt(..), pprGlobalRdrEnv,
47 LocalRdrEnv, extendLocalRdrEnv,
51 Provenance(..), ImportReason(..),
52 pprNameProvenance, hasBetterProv
56 #include "HsVersions.h"
58 import RdrName ( RdrName, RdrNameEnv, addListToRdrEnv,
59 mkRdrUnqual, rdrEnvToList )
60 import Name ( Name, NamedThing, getName, nameOccName, nameModule, nameSrcLoc )
62 import OccName ( OccName )
64 import InstEnv ( InstEnv, ClsInstEnv, DFunId )
65 import Rules ( RuleBase )
66 import CoreSyn ( CoreBind )
68 import Class ( Class, classSelIds )
69 import TyCon ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons_maybe )
70 import DataCon ( dataConWorkId, dataConWrapId )
72 import BasicTypes ( Version, initialVersion, Fixity, defaultFixity, IPName )
74 import HsSyn ( DeprecTxt, TyClDecl, tyClDeclName, ifaceRuleDeclName,
76 import RdrHsSyn ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl )
77 import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
79 import CoreSyn ( IdCoreRule )
83 import Maybes ( seqMaybe, orElse, expectJust )
85 import SrcLoc ( SrcLoc, isGoodSrcLoc )
86 import Util ( thenCmp, sortLt )
87 import UniqSupply ( UniqSupply )
88 import Maybe ( fromJust )
91 %************************************************************************
93 \subsection{Which mode we're in
95 %************************************************************************
98 data GhciMode = Batch | Interactive | OneShot
103 %************************************************************************
105 \subsection{Module locations}
107 %************************************************************************
112 ml_hs_file :: Maybe FilePath,
113 ml_hspp_file :: Maybe FilePath, -- path of preprocessed source
114 ml_hi_file :: FilePath,
115 ml_obj_file :: Maybe FilePath
119 instance Outputable ModuleLocation where
122 -- Probably doesn't really belong here, but used in HscMain and InteractiveUI.
124 showModMsg :: Bool -> Module -> ModuleLocation -> String
125 showModMsg use_object mod location =
126 mod_str ++ replicate (max 0 (16 - length mod_str)) ' '
127 ++" ( " ++ expectJust "showModMsg" (ml_hs_file location) ++ ", "
129 then expectJust "showModMsg" (ml_obj_file location)
132 where mod_str = moduleUserString mod
135 For a module in another package, the hs_file and obj_file
136 components of ModuleLocation are undefined.
138 The locations specified by a ModuleLocation may or may not
139 correspond to actual files yet: for example, even if the object
140 file doesn't exist, the ModuleLocation still contains the path to
141 where the object file will reside if/when it is created.
144 %************************************************************************
146 \subsection{Symbol tables and Module details}
148 %************************************************************************
150 A @ModIface@ plus a @ModDetails@ summarises everything we know
151 about a compiled module. The @ModIface@ is the stuff *before* linking,
152 and can be written out to an interface file. (The @ModDetails@ is after
153 linking; it is the "linked" form of the mi_decls field.)
155 When we *read* an interface file, we also construct a @ModIface@ from it,
156 except that the mi_decls part is empty; when reading we consolidate
157 the declarations into a single indexed map in the @PersistentRenamerState@.
162 mi_module :: !Module,
163 mi_package :: !PackageName, -- Which package the module comes from
164 mi_version :: !VersionInfo, -- Module version number
166 mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans
167 -- NOT STRICT! we fill this field with _|_ sometimes
169 mi_boot :: !IsBootInterface, -- read from an hi-boot file?
171 mi_usages :: ![ImportVersion Name],
172 -- Usages; kept sorted so that it's easy to decide
173 -- whether to write a new iface file (changing usages
174 -- doesn't affect the version of this module)
176 mi_exports :: ![ExportItem],
177 -- What it exports Kept sorted by (mod,occ), to make
178 -- version comparisons easier
180 mi_globals :: !(Maybe GlobalRdrEnv),
181 -- Its top level environment or Nothing if we read this
182 -- interface from a file.
184 mi_fixities :: !FixityEnv, -- Fixities
185 mi_deprecs :: !Deprecations, -- Deprecations
187 mi_decls :: IfaceDecls -- The RnDecls form of ModDetails
188 -- NOT STRICT! we fill this field with _|_ sometimes
191 data IfaceDecls = IfaceDecls { dcl_tycl :: [RenamedTyClDecl], -- Sorted
192 dcl_rules :: [RenamedRuleDecl], -- Sorted
193 dcl_insts :: [RenamedInstDecl] } -- Unsorted
195 mkIfaceDecls :: [RenamedTyClDecl] -> [RenamedRuleDecl] -> [RenamedInstDecl] -> IfaceDecls
196 mkIfaceDecls tycls rules insts
197 = IfaceDecls { dcl_tycl = sortLt lt_tycl tycls,
198 dcl_rules = sortLt lt_rule rules,
201 d1 `lt_tycl` d2 = tyClDeclName d1 < tyClDeclName d2
202 r1 `lt_rule` r2 = ifaceRuleDeclName r1 < ifaceRuleDeclName r2
205 -- typechecker should only look at this, not ModIface
206 -- Should be able to construct ModDetails from mi_decls in ModIface
209 -- The next three fields are created by the typechecker
210 md_types :: !TypeEnv,
211 md_insts :: ![DFunId], -- Dfun-ids for the instances in this module
212 md_rules :: ![IdCoreRule], -- Domain may include Ids from other modules
213 md_binds :: ![CoreBind]
216 -- The ModDetails takes on several slightly different forms:
218 -- After typecheck + desugar
219 -- md_types Contains TyCons, Classes, and implicit Ids
220 -- md_insts All instances from this module (incl derived ones)
221 -- md_rules All rules from this module
222 -- md_binds Desugared bindings
224 -- After simplification
225 -- md_types Same as after typecheck
227 -- md_rules Orphan rules only (local ones now attached to binds)
228 -- md_binds With rules attached
231 -- md_types Now contains Ids as well, replete with final IdInfo
232 -- The Ids are only the ones that are visible from
233 -- importing modules. Without -O that means only
234 -- exported Ids, but with -O importing modules may
235 -- see ids mentioned in unfoldings of exported Ids
237 -- md_insts Same DFunIds as before, but with final IdInfo,
238 -- and the unique might have changed; remember that
239 -- CoreTidy links up the uniques of old and new versions
241 -- md_rules All rules for exported things, substituted with final Ids
245 -- Passed back to compilation manager
246 -- Just as after CoreTidy, but with md_binds nuked
251 emptyModIface :: Module -> ModIface
253 = ModIface { mi_module = mod,
254 mi_package = preludePackage, -- XXX fully bogus
255 mi_version = initialVersionInfo,
260 mi_fixities = emptyNameEnv,
261 mi_globals = Nothing,
262 mi_deprecs = NoDeprecs,
263 mi_decls = panic "emptyModIface: decls"
267 Symbol tables map modules to ModDetails:
270 type SymbolTable = ModuleEnv ModDetails
271 type IfaceTable = ModuleEnv ModIface
273 type HomeIfaceTable = IfaceTable
274 type PackageIfaceTable = IfaceTable
276 type HomeSymbolTable = SymbolTable -- Domain = modules in the home package
278 emptySymbolTable :: SymbolTable
279 emptySymbolTable = emptyModuleEnv
281 emptyIfaceTable :: IfaceTable
282 emptyIfaceTable = emptyModuleEnv
285 Simple lookups in the symbol table.
288 lookupIface :: HomeIfaceTable -> PackageIfaceTable -> Name -> Maybe ModIface
289 -- We often have two IfaceTables, and want to do a lookup
290 lookupIface hit pit name
291 = lookupModuleEnv hit mod `seqMaybe` lookupModuleEnv pit mod
293 mod = nameModule name
295 lookupIfaceByModName :: HomeIfaceTable -> PackageIfaceTable -> ModuleName -> Maybe ModIface
296 -- We often have two IfaceTables, and want to do a lookup
297 lookupIfaceByModName hit pit mod
298 = lookupModuleEnvByName hit mod `seqMaybe` lookupModuleEnvByName pit mod
300 -- Use instead of Finder.findModule if possible: this way doesn't
301 -- require filesystem operations, and it is guaranteed not to fail
302 -- when the IfaceTables are properly populated (i.e. after the renamer).
303 moduleNameToModule :: HomeIfaceTable -> PackageIfaceTable -> ModuleName
305 moduleNameToModule hit pit mod
306 = mi_module (fromJust (lookupIfaceByModName hit pit mod))
310 %************************************************************************
312 \subsection{The interactive context}
314 %************************************************************************
317 data InteractiveContext
318 = InteractiveContext {
319 ic_toplev_scope :: [Module], -- Include the "top-level" scope of
322 ic_exports :: [Module], -- Include just the exports of these
325 ic_rn_gbl_env :: GlobalRdrEnv, -- The cached GlobalRdrEnv, built from
326 -- ic_toplev_scope and ic_exports
328 ic_print_unqual :: PrintUnqualified,
329 -- cached PrintUnqualified, as above
331 ic_rn_local_env :: LocalRdrEnv, -- Lexical context for variables bound
332 -- during interaction
334 ic_type_env :: TypeEnv -- Ditto for types
339 %************************************************************************
341 \subsection{Type environment stuff}
343 %************************************************************************
346 data TyThing = AnId Id
350 isTyClThing :: TyThing -> Bool
351 isTyClThing (ATyCon _) = True
352 isTyClThing (AClass _) = True
353 isTyClThing (AnId _) = False
355 instance NamedThing TyThing where
356 getName (AnId id) = getName id
357 getName (ATyCon tc) = getName tc
358 getName (AClass cl) = getName cl
360 instance Outputable TyThing where
361 ppr (AnId id) = ptext SLIT("AnId") <+> ppr id
362 ppr (ATyCon tc) = ptext SLIT("ATyCon") <+> ppr tc
363 ppr (AClass cl) = ptext SLIT("AClass") <+> ppr cl
366 typeEnvElts :: TypeEnv -> [TyThing]
367 typeEnvClasses :: TypeEnv -> [Class]
368 typeEnvTyCons :: TypeEnv -> [TyCon]
369 typeEnvIds :: TypeEnv -> [Id]
371 typeEnvElts env = nameEnvElts env
372 typeEnvClasses env = [cl | AClass cl <- typeEnvElts env]
373 typeEnvTyCons env = [tc | ATyCon tc <- typeEnvElts env]
374 typeEnvIds env = [id | AnId id <- typeEnvElts env]
376 implicitTyThingIds :: [TyThing] -> [Id]
377 -- Add the implicit data cons and selectors etc
378 implicitTyThingIds things
379 = concat (map go things)
382 go (AClass cl) = classSelIds cl
383 go (ATyCon tc) = tyConGenIds tc ++
385 [ n | dc <- tyConDataCons_maybe tc `orElse` [],
386 n <- implicitConIds tc dc]
387 -- Synonyms return empty list of constructors and selectors
389 implicitConIds tc dc -- Newtypes have a constructor wrapper,
391 | isNewTyCon tc = [dataConWrapId dc]
392 | otherwise = [dataConWorkId dc, dataConWrapId dc]
397 type TypeEnv = NameEnv TyThing
399 emptyTypeEnv = emptyNameEnv
401 mkTypeEnv :: [TyThing] -> TypeEnv
402 mkTypeEnv things = extendTypeEnvList emptyTypeEnv things
404 extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
405 extendTypeEnvList env things
406 = extendNameEnvList env [(getName thing, thing) | thing <- things]
408 extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
409 extendTypeEnvWithIds env ids
410 = extendNameEnvList env [(getName id, AnId id) | id <- ids]
414 lookupType :: HomeSymbolTable -> PackageTypeEnv -> Name -> Maybe TyThing
415 lookupType hst pte name
416 = case lookupModuleEnv hst (nameModule name) of
417 Just details -> lookupNameEnv (md_types details) name
418 Nothing -> lookupNameEnv pte name
421 %************************************************************************
423 \subsection{Auxiliary types}
425 %************************************************************************
427 These types are defined here because they are mentioned in ModDetails,
428 but they are mostly elaborated elsewhere
433 vers_module :: Version, -- Changes when anything changes
434 vers_exports :: Version, -- Changes when export list changes
435 vers_rules :: Version, -- Changes when any rule changes
436 vers_decls :: NameEnv Version
437 -- Versions for "big" names only (not data constructors, class ops)
438 -- The version of an Id changes if its fixity changes
439 -- Ditto data constructors, class operations, except that the version of
440 -- the parent class/tycon changes
442 -- If a name isn't in the map, it means 'initialVersion'
445 initialVersionInfo :: VersionInfo
446 initialVersionInfo = VersionInfo { vers_module = initialVersion,
447 vers_exports = initialVersion,
448 vers_rules = initialVersion,
449 vers_decls = emptyNameEnv
452 lookupVersion :: NameEnv Version -> Name -> Version
453 lookupVersion env name = lookupNameEnv env name `orElse` initialVersion
455 data Deprecations = NoDeprecs
456 | DeprecAll DeprecTxt -- Whole module deprecated
457 | DeprecSome (NameEnv (Name,DeprecTxt)) -- Some things deprecated
459 -- We keep the Name in the range, so we can print them out
461 lookupDeprec :: Deprecations -> Name -> Maybe DeprecTxt
462 lookupDeprec NoDeprecs name = Nothing
463 lookupDeprec (DeprecAll txt) name = Just txt
464 lookupDeprec (DeprecSome env) name = case lookupNameEnv env name of
465 Just (_, txt) -> Just txt
468 instance Eq Deprecations where
469 -- Used when checking whether we need write a new interface
470 NoDeprecs == NoDeprecs = True
471 (DeprecAll t1) == (DeprecAll t2) = t1 == t2
472 (DeprecSome e1) == (DeprecSome e2) = nameEnvElts e1 == nameEnvElts e2
478 type Avails = [AvailInfo]
479 type AvailInfo = GenAvailInfo Name
480 type RdrAvailInfo = GenAvailInfo OccName
482 data GenAvailInfo name = Avail name -- An ordinary identifier
483 | AvailTC name -- The name of the type or class
484 [name] -- The available pieces of type/class.
485 -- NB: If the type or class is itself
486 -- to be in scope, it must be in this list.
487 -- Thus, typically: AvailTC Eq [Eq, ==, /=]
489 -- Equality used when deciding if the interface has changed
491 type RdrExportItem = (ModuleName, [RdrAvailInfo])
492 type ExportItem = (ModuleName, [AvailInfo])
494 type AvailEnv = NameEnv AvailInfo -- Maps a Name to the AvailInfo that contains it
496 emptyAvailEnv :: AvailEnv
497 emptyAvailEnv = emptyNameEnv
499 instance Outputable n => Outputable (GenAvailInfo n) where
502 pprAvail :: Outputable n => GenAvailInfo n -> SDoc
503 pprAvail (AvailTC n ns) = ppr n <> case {- filter (/= n) -} ns of
505 ns' -> braces (hsep (punctuate comma (map ppr ns')))
507 pprAvail (Avail n) = ppr n
511 type FixityEnv = NameEnv Fixity
513 lookupFixity :: FixityEnv -> Name -> Fixity
514 lookupFixity env n = lookupNameEnv env n `orElse` defaultFixity
516 collectFixities :: FixityEnv -> [TyClDecl Name pat] -> [(Name,Fixity)]
517 collectFixities env decls
519 | d <- decls, (n,_) <- tyClDeclNames d,
520 Just fix <- [lookupNameEnv env n]
525 %************************************************************************
527 \subsection{ModIface}
529 %************************************************************************
532 type WhetherHasOrphans = Bool
534 -- * an instance decl in a module other than the defn module for
535 -- one of the tycons or classes in the instance head
536 -- * a transformation rule in a module other than the one defining
537 -- the function in the head of the rule.
539 type IsBootInterface = Bool
541 type ImportVersion name = (ModuleName, WhetherHasOrphans, IsBootInterface, WhatsImported name)
543 data WhatsImported name = NothingAtAll -- The module is below us in the
544 -- hierarchy, but we import nothing
546 | Everything Version -- Used for modules from other packages;
547 -- we record only the module's version number
550 Version -- Module version
551 (Maybe Version) -- Export-list version, if we depend on it
552 [(name,Version)] -- List guaranteed non-empty
553 Version -- Rules version
556 -- 'Specifically' doesn't let you say "I imported f but none of the rules in
557 -- the module". If you use anything in the module you get its rule version
558 -- So if the rules change, you'll recompile, even if you don't use them.
559 -- This is easy to implement, and it's safer: you might not have used the rules last
560 -- time round, but if someone has added a new rule you might need it this time
562 -- The export list field is (Just v) if we depend on the export list:
563 -- we imported the module without saying exactly what we imported
564 -- We need to recompile if the module exports changes, because we might
565 -- now have a name clash in the importing module.
567 type IsExported = Name -> Bool -- True for names that are exported from this module
571 %************************************************************************
573 \subsection{The persistent compiler state}
575 %************************************************************************
577 The @PersistentCompilerState@ persists across successive calls to the
580 * A ModIface for each non-home-package module
582 * An accumulated TypeEnv from all the modules in imported packages
584 * An accumulated InstEnv from all the modules in imported packages
585 The point is that we don't want to keep recreating it whenever
586 we compile a new module. The InstEnv component of pcPST is empty.
587 (This means we might "see" instances that we shouldn't "really" see;
588 but the Haskell Report is vague on what is meant to be visible,
589 so we just take the easy road here.)
593 * The persistent renamer state
596 data PersistentCompilerState
598 pcs_PIT :: !PackageIfaceTable, -- Domain = non-home-package modules
599 -- the mi_decls component is empty
601 pcs_PTE :: !PackageTypeEnv, -- Domain = non-home-package modules
602 -- except that the InstEnv components is empty
604 pcs_insts :: !PackageInstEnv, -- The total InstEnv accumulated from all
605 -- the non-home-package modules
607 pcs_rules :: !PackageRuleBase, -- Ditto RuleEnv
609 pcs_PRS :: !PersistentRenamerState
614 The persistent renamer state contains:
616 * A name supply, which deals with allocating unique names to
617 (Module,OccName) original names,
619 * A "holding pen" for declarations that have been read out of
620 interface files but not yet sucked in, renamed, and typechecked
623 type PackageTypeEnv = TypeEnv
624 type PackageRuleBase = RuleBase
625 type PackageInstEnv = InstEnv
627 data PersistentRenamerState
628 = PRS { prsOrig :: !NameSupply,
629 prsImpMods :: !ImportedModuleInfo,
631 -- Holding pens for stuff that has been read in
632 -- but not yet slurped into the renamer
633 prsDecls :: !DeclsMap,
634 prsInsts :: !IfaceInsts,
635 prsRules :: !IfaceRules
639 The NameSupply makes sure that there is just one Unique assigned for
640 each original name; i.e. (module-name, occ-name) pair. The Name is
641 always stored as a Global, and has the SrcLoc of its binding location.
642 Actually that's not quite right. When we first encounter the original
643 name, we might not be at its binding site (e.g. we are reading an
644 interface file); so we give it 'noSrcLoc' then. Later, when we find
645 its binding site, we fix it up.
647 Exactly the same is true of the Module stored in the Name. When we first
648 encounter the occurrence, we may not know the details of the module, so
649 we just store junk. Then when we find the binding site, we fix it up.
653 = NameSupply { nsUniqs :: UniqSupply,
655 nsNames :: OrigNameCache,
656 -- Ensures that one original name gets one unique
657 nsIPs :: OrigIParamCache
658 -- Ensures that one implicit parameter name gets one unique
661 type OrigNameCache = FiniteMap (ModuleName,OccName) Name
662 type OrigIParamCache = FiniteMap (IPName RdrName) (IPName Name)
665 @ImportedModuleInfo@ contains info ONLY about modules that have not yet
666 been loaded into the iPIT. These modules are mentioned in interfaces we've
667 already read, so we know a tiny bit about them, but we havn't yet looked
668 at the interface file for the module itself. It needs to persist across
669 invocations of the renamer, at least from Rename.checkOldIface to Rename.renameSource.
670 And there's no harm in it persisting across multiple compilations.
673 type ImportedModuleInfo = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface)
676 A DeclsMap contains a binding for each Name in the declaration
677 including the constructors of a type decl etc. The Bool is True just
681 type DeclsMap = (NameEnv (AvailInfo, Bool, (Module, RdrNameTyClDecl)), Int)
682 -- The Int says how many have been sucked in
684 type IfaceInsts = GatedDecls RdrNameInstDecl
685 type IfaceRules = GatedDecls RdrNameRuleDecl
687 type GatedDecls d = (Bag (GatedDecl d), Int) -- The Int says how many have been sucked in
688 type GatedDecl d = (GateFn, (Module, d))
689 type GateFn = (Name -> Bool) -> Bool -- Returns True <=> gate is open
690 -- The (Name -> Bool) fn returns True for visible Names
691 -- For example, suppose this is in an interface file
692 -- instance C T where ...
693 -- We want to slurp this decl if both C and T are "visible" in
694 -- the importing module. See "The gating story" in RnIfaces for details.
698 %************************************************************************
700 \subsection{Provenance and export info}
702 %************************************************************************
704 A LocalRdrEnv is used for local bindings (let, where, lambda, case)
707 type LocalRdrEnv = RdrNameEnv Name
709 extendLocalRdrEnv :: LocalRdrEnv -> [Name] -> LocalRdrEnv
710 extendLocalRdrEnv env names
711 = addListToRdrEnv env [(mkRdrUnqual (nameOccName n), n) | n <- names]
714 The GlobalRdrEnv gives maps RdrNames to Names. There is a separate
715 one for each module, corresponding to that module's top-level scope.
718 type GlobalRdrEnv = RdrNameEnv [GlobalRdrElt]
719 -- The list is because there may be name clashes
720 -- These only get reported on lookup, not on construction
722 data GlobalRdrElt = GRE Name Provenance (Maybe DeprecTxt)
723 -- The Maybe DeprecTxt tells whether this name is deprecated
726 = vcat (map pp (rdrEnvToList env))
728 pp (rn, nps) = ppr rn <> colon <+>
729 vcat [ppr n <+> pprNameProvenance n p | (GRE n p _) <- nps]
732 The "provenance" of something says how it came to be in scope.
736 = LocalDef -- Defined locally
738 | NonLocalDef -- Defined non-locally
741 -- Just used for grouping error messages (in RnEnv.warnUnusedBinds)
742 instance Eq Provenance where
743 p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
745 instance Eq ImportReason where
746 p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
748 instance Ord Provenance where
749 compare LocalDef LocalDef = EQ
750 compare LocalDef (NonLocalDef _) = LT
751 compare (NonLocalDef _) LocalDef = GT
753 compare (NonLocalDef reason1) (NonLocalDef reason2)
754 = compare reason1 reason2
756 instance Ord ImportReason where
757 compare ImplicitImport ImplicitImport = EQ
758 compare ImplicitImport (UserImport _ _ _) = LT
759 compare (UserImport _ _ _) ImplicitImport = GT
760 compare (UserImport m1 loc1 _) (UserImport m2 loc2 _)
761 = (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
765 = UserImport Module SrcLoc Bool -- Imported from module M on line L
766 -- Note the M may well not be the defining module
768 -- The Bool is true iff the thing was named *explicitly* in the import spec,
769 -- rather than being imported as part of a group; e.g.
772 -- Here, everything imported by B, and the constructors of T
773 -- are not named explicitly; only T is named explicitly.
774 -- This info is used when warning of unused names.
776 | ImplicitImport -- Imported implicitly for some other reason
780 hasBetterProv :: Provenance -> Provenance -> Bool
782 -- a local thing over an imported thing
783 -- a user-imported thing over a non-user-imported thing
784 -- an explicitly-imported thing over an implicitly imported thing
785 hasBetterProv LocalDef _ = True
786 hasBetterProv (NonLocalDef (UserImport _ _ _ )) (NonLocalDef ImplicitImport) = True
787 hasBetterProv _ _ = False
789 pprNameProvenance :: Name -> Provenance -> SDoc
790 pprNameProvenance name LocalDef = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
791 pprNameProvenance name (NonLocalDef why) = sep [ppr_reason why,
792 nest 2 (ppr_defn (nameSrcLoc name))]
794 ppr_reason ImplicitImport = ptext SLIT("implicitly imported")
795 ppr_reason (UserImport mod loc _) = ptext SLIT("imported from") <+> ppr mod <+> ptext SLIT("at") <+> ppr loc
797 ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("at") <+> ppr loc)