lookupIface, lookupIfaceByModName,
emptyModIface,
- IfaceDecls(..),
+ IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
VersionInfo(..), initialVersionInfo,
InstEnv, ClsInstEnv, DFunId,
PackageInstEnv, PackageRuleBase,
- GlobalRdrEnv, RdrAvailInfo,
+ GlobalRdrEnv, RdrAvailInfo, pprGlobalRdrEnv,
-- Provenance
- Provenance(..), ImportReason(..), PrintUnqualified,
+ Provenance(..), ImportReason(..),
pprNameProvenance, hasBetterProv
) where
#include "HsVersions.h"
-import RdrName ( RdrNameEnv, emptyRdrEnv )
-import Name ( Name, NameEnv, NamedThing,
- emptyNameEnv, extendNameEnv,
- lookupNameEnv, emptyNameEnv, nameEnvElts,
- isLocallyDefined, getName, nameModule,
- nameSrcLoc )
-import NameSet ( NameSet )
+import RdrName ( RdrNameEnv, emptyRdrEnv, rdrEnvToList )
+import Name ( Name, NamedThing, isLocallyDefined,
+ getName, nameModule, nameSrcLoc )
+import Name -- Env
import OccName ( OccName )
import Module ( Module, ModuleName, ModuleEnv,
- lookupModuleEnv, lookupModuleEnvByName
+ lookupModuleEnv, lookupModuleEnvByName, emptyModuleEnv
)
+import InstEnv ( InstEnv, ClsInstEnv, DFunId )
import Rules ( RuleBase )
-import VarSet ( TyVarSet )
import Id ( Id )
import Class ( Class )
import TyCon ( TyCon )
import BasicTypes ( Version, initialVersion, Fixity )
-import HsSyn ( DeprecTxt )
-import RdrHsSyn ( RdrNameHsDecl, RdrNameTyClDecl )
+import HsSyn ( DeprecTxt, tyClDeclName, ifaceRuleDeclName )
+import RdrHsSyn ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl )
import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
import CoreSyn ( IdCoreRule )
-import Type ( Type )
import FiniteMap ( FiniteMap )
import Bag ( Bag )
import Maybes ( seqMaybe )
-import UniqFM ( UniqFM, emptyUFM )
import Outputable
import SrcLoc ( SrcLoc, isGoodSrcLoc )
-import Util ( thenCmp )
+import Util ( thenCmp, sortLt )
import UniqSupply ( UniqSupply )
\end{code}
dcl_rules :: [RenamedRuleDecl], -- Sorted
dcl_insts :: [RenamedInstDecl] } -- Unsorted
+mkIfaceDecls :: [RenamedTyClDecl] -> [RenamedRuleDecl] -> [RenamedInstDecl] -> IfaceDecls
+mkIfaceDecls tycls rules insts
+ = IfaceDecls { dcl_tycl = sortLt lt_tycl tycls,
+ dcl_rules = sortLt lt_rule rules,
+ dcl_insts = insts }
+ where
+ d1 `lt_tycl` d2 = nameOccName (tyClDeclName d1) < nameOccName (tyClDeclName d2)
+ r1 `lt_rule` r2 = nameOccName (ifaceRuleDeclName r1) < nameOccName (ifaceRuleDeclName r2)
+
+ -- I wanted to sort just by the Name, but there's a problem: we are comparing
+ -- the old version of an interface with the new version. The latter will use
+ -- local names like 'lvl23' that were constructed not by the renamer but by
+ -- the simplifier. So the unqiues aren't going to line up.
+ --
+ -- It's ok to compare by OccName because this comparison only drives the
+ -- computation of new version numbers.
+ --
+ -- Better solutions: Compare in a way that is insensitive to the name used
+ -- for local things. This would decrease the wobbles due
+ -- to 'lvl23' changing to 'lvl24'.
+ --
+ -- NB: there's a related comparision on MkIface.diffDecls!
+
+
+
+
-- typechecker should only look at this, not ModIface
-- Should be able to construct ModDetails from mi_decls in ModIface
data ModDetails
type HomeSymbolTable = SymbolTable -- Domain = modules in the home package
emptyIfaceTable :: IfaceTable
-emptyIfaceTable = emptyUFM
+emptyIfaceTable = emptyModuleEnv
\end{code}
Simple lookups in the symbol table.
lookupDeprec (DeprecSome env) name = case lookupNameEnv env name of
Just (_, txt) -> Just txt
Nothing -> Nothing
-
-type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
-
-type ClsInstEnv = [(TyVarSet, [Type], DFunId)] -- The instances for a particular class
-type DFunId = Id
\end{code}
-- Equality used when deciding if the interface has changed
type AvailEnv = NameEnv AvailInfo -- Maps a Name to the AvailInfo that contains it
+
+instance Outputable n => Outputable (GenAvailInfo n) where
+ ppr = pprAvail
+
+pprAvail :: Outputable n => GenAvailInfo n -> SDoc
+pprAvail (AvailTC n ns) = ppr n <> case {- filter (/= n) -} ns of
+ [] -> empty
+ ns' -> braces (hsep (punctuate comma (map ppr ns')))
+
+pprAvail (Avail n) = ppr n
\end{code}
for the 'main' Name.
\begin{code}
-type DeclsMap = NameEnv (AvailInfo, Bool, (Module, RdrNameTyClDecl))
+type DeclsMap = (NameEnv (AvailInfo, Bool, (Module, RdrNameTyClDecl)), Int)
+ -- The Int says how many have been sucked in
-type IfaceInsts = Bag GatedDecl
-type IfaceRules = Bag GatedDecl
+type IfaceInsts = GatedDecls RdrNameInstDecl
+type IfaceRules = GatedDecls RdrNameRuleDecl
-type GatedDecl = (NameSet, (Module, RdrNameHsDecl))
+type GatedDecls d = (Bag (GatedDecl d), Int) -- The Int says how many have been sucked in
+type GatedDecl d = ([Name], (Module, d))
\end{code}
type GlobalRdrEnv = RdrNameEnv [(Name,Provenance)] -- The list is because there may be name clashes
-- These only get reported on lookup,
-- not on construction
+
+pprGlobalRdrEnv env
+ = vcat (map pp (rdrEnvToList env))
+ where
+ pp (rn, nps) = ppr rn <> colon <+>
+ vcat [ppr n <+> pprNameProvenance n p | (n,p) <- nps]
\end{code}
The "provenance" of something says how it came to be in scope.
| NonLocalDef -- Defined non-locally
ImportReason
- PrintUnqualified
-- Just used for grouping error messages (in RnEnv.warnUnusedBinds)
instance Eq Provenance where
instance Ord Provenance where
compare LocalDef LocalDef = EQ
- compare LocalDef (NonLocalDef _ _) = LT
- compare (NonLocalDef _ _) LocalDef = GT
+ compare LocalDef (NonLocalDef _) = LT
+ compare (NonLocalDef _) LocalDef = GT
- compare (NonLocalDef reason1 _) (NonLocalDef reason2 _)
+ compare (NonLocalDef reason1) (NonLocalDef reason2)
= compare reason1 reason2
instance Ord ImportReason where
-- This info is used when warning of unused names.
| ImplicitImport -- Imported implicitly for some other reason
-
-
-type PrintUnqualified = Bool -- True <=> the unqualified name of this thing is
- -- in scope in this module, so print it
- -- unqualified in error messages
\end{code}
\begin{code}
-- a local thing over an imported thing
-- a user-imported thing over a non-user-imported thing
-- an explicitly-imported thing over an implicitly imported thing
-hasBetterProv LocalDef _ = True
-hasBetterProv (NonLocalDef (UserImport _ _ True) _) _ = True
-hasBetterProv (NonLocalDef (UserImport _ _ _ ) _) (NonLocalDef ImplicitImport _) = True
-hasBetterProv _ _ = False
+hasBetterProv LocalDef _ = True
+hasBetterProv (NonLocalDef (UserImport _ _ _ )) (NonLocalDef ImplicitImport) = True
+hasBetterProv _ _ = False
pprNameProvenance :: Name -> Provenance -> SDoc
-pprNameProvenance name LocalDef = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
-pprNameProvenance name (NonLocalDef why _) = sep [ppr_reason why,
- nest 2 (parens (ppr_defn (nameSrcLoc name)))]
+pprNameProvenance name LocalDef = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
+pprNameProvenance name (NonLocalDef why) = sep [ppr_reason why,
+ nest 2 (parens (ppr_defn (nameSrcLoc name)))]
ppr_reason ImplicitImport = ptext SLIT("implicitly imported")
ppr_reason (UserImport mod loc _) = ptext SLIT("imported from") <+> ppr mod <+> ptext SLIT("at") <+> ppr loc
projects / ghc-hetmet.git / blobdiff