\begin{code}
module HscTypes (
- Finder, ModuleLocation(..),
+ ModuleLocation(..),
ModDetails(..), ModIface(..), GlobalSymbolTable,
HomeSymbolTable, PackageSymbolTable,
- HomeIfaceTable, PackageIfaceTable,
+ HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
+ lookupTable, lookupTableByModName,
- VersionInfo(..),
+ IfaceDecls(..),
- TyThing(..), groupTyThings,
+ VersionInfo(..), initialVersionInfo,
- TypeEnv, extendTypeEnv, lookupTypeEnv,
+ TyThing(..), groupTyThings, isTyClThing,
- lookupFixityEnv,
+ TypeEnv, extendTypeEnv, lookupTypeEnv,
+ typeEnvClasses, typeEnvTyCons,
WhetherHasOrphans, ImportVersion, WhatsImported(..),
PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
- IfaceInsts, IfaceRules, DeprecationEnv, GatedDecl,
+ IfaceInsts, IfaceRules, GatedDecl,
OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
AvailEnv, AvailInfo, GenAvailInfo(..),
PersistentCompilerState(..),
+ Deprecations(..), lookupDeprec,
+
InstEnv, ClsInstEnv, DFunId,
+ PackageInstEnv, PackageRuleBase,
GlobalRdrEnv, RdrAvailInfo,
import Name ( Name, NameEnv, NamedThing,
emptyNameEnv, unitNameEnv, extendNameEnv, plusNameEnv,
lookupNameEnv, emptyNameEnv, getName, nameModule,
- nameSrcLoc )
+ nameSrcLoc, nameEnvElts )
import NameSet ( NameSet )
import OccName ( OccName )
import Module ( Module, ModuleName, ModuleEnv,
- lookupModuleEnv )
+ extendModuleEnv, lookupModuleEnv, lookupModuleEnvByName
+ )
+import Rules ( RuleBase )
import VarSet ( TyVarSet )
-import VarEnv ( IdEnv, emptyVarEnv )
import Id ( Id )
import Class ( Class )
import TyCon ( TyCon )
-import BasicTypes ( Version, Fixity )
+import BasicTypes ( Version, initialVersion, Fixity )
import HsSyn ( DeprecTxt )
-import RdrHsSyn ( RdrNameHsDecl )
-import RnHsSyn ( RenamedHsDecl )
+import RdrHsSyn ( RdrNameHsDecl, RdrNameTyClDecl )
+import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
-import CoreSyn ( CoreRule )
+import CoreSyn ( CoreRule, IdCoreRule )
import Type ( Type )
import FiniteMap ( FiniteMap, emptyFM, addToFM, lookupFM, foldFM )
import Bag ( Bag )
-import UniqFM ( UniqFM )
+import Maybes ( seqMaybe )
+import UniqFM ( UniqFM, emptyUFM )
import Outputable
import SrcLoc ( SrcLoc, isGoodSrcLoc )
import Util ( thenCmp )
+import UniqSupply ( UniqSupply )
\end{code}
%************************************************************************
%* *
-\subsection{The Finder type}
+\subsection{Module locations}
%* *
%************************************************************************
\begin{code}
-type Finder = ModuleName -> IO (Maybe (Module, ModuleLocation))
-
data ModuleLocation
= ModuleLocation {
hs_file :: FilePath,
hi_file :: FilePath,
obj_file :: FilePath
- }
+ }
+ deriving Show
+
+instance Outputable ModuleLocation where
+ ppr = text . show
\end{code}
For a module in another package, the hs_file and obj_file
mi_module :: Module, -- Complete with package info
mi_version :: VersionInfo, -- Module version number
mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans
- mi_usages :: [ImportVersion Name], -- Usages
- mi_exports :: Avails, -- What it exports
+ mi_usages :: [ImportVersion Name], -- Usages; kept sorted so that it's easy
+ -- to decide whether to write a new iface file
+ -- (changing usages doesn't affect the version of
+ -- this module)
+
+ mi_exports :: [(ModuleName,Avails)], -- What it exports
+ -- Kept sorted by (mod,occ),
+ -- to make version comparisons easier
+
mi_globals :: GlobalRdrEnv, -- Its top level environment
mi_fixities :: NameEnv Fixity, -- Fixities
- mi_deprecs :: NameEnv DeprecTxt, -- Deprecations
+ mi_deprecs :: Deprecations, -- Deprecations
- mi_decls :: [RenamedHsDecl] -- types, classes
- -- inst decls, rules, iface sigs
+ mi_decls :: IfaceDecls -- The RnDecls form of ModDetails
}
+data IfaceDecls = IfaceDecls { dcl_tycl :: [RenamedTyClDecl], -- Sorted
+ dcl_rules :: [RenamedRuleDecl], -- Sorted
+ dcl_insts :: [RenamedInstDecl] } -- Unsorted
+
-- typechecker should only look at this, not ModIface
-- Should be able to construct ModDetails from mi_decls in ModIface
data ModDetails
-- The next three fields are created by the typechecker
md_types :: TypeEnv,
md_insts :: [DFunId], -- Dfun-ids for the instances in this module
- md_rules :: RuleEnv -- Domain may include Ids from other modules
+ md_rules :: [IdCoreRule] -- Domain may include Ids from other modules
}
\end{code}
emptyModDetails
= ModDetails { md_types = emptyTypeEnv,
md_insts = [],
- md_rules = emptyRuleEnv
+ md_rules = []
}
emptyModIface :: Module -> ModIface
= ModIface { mi_module = mod,
mi_exports = [],
mi_globals = emptyRdrEnv,
- mi_deprecs = emptyNameEnv,
+ mi_deprecs = NoDeprecs
}
\end{code}
type HomeSymbolTable = SymbolTable -- Domain = modules in the home package
type PackageSymbolTable = SymbolTable -- Domain = modules in the some other package
type GlobalSymbolTable = SymbolTable -- Domain = all modules
+
+emptyIfaceTable :: IfaceTable
+emptyIfaceTable = emptyUFM
\end{code}
Simple lookups in the symbol table.
\begin{code}
-lookupFixityEnv :: IfaceTable -> Name -> Maybe Fixity
-lookupFixityEnv tbl name
- = case lookupModuleEnv tbl (nameModule name) of
- Nothing -> Nothing
- Just details -> lookupNameEnv (mi_fixities details) name
+lookupTable :: ModuleEnv a -> ModuleEnv a -> Name -> Maybe a
+-- We often have two Symbol- or IfaceTables, and want to do a lookup
+lookupTable ht pt name
+ = lookupModuleEnv ht mod `seqMaybe` lookupModuleEnv pt mod
+ where
+ mod = nameModule name
+
+lookupTableByModName :: ModuleEnv a -> ModuleEnv a -> ModuleName -> Maybe a
+-- We often have two Symbol- or IfaceTables, and want to do a lookup
+lookupTableByModName ht pt mod
+ = lookupModuleEnvByName ht mod `seqMaybe` lookupModuleEnvByName pt mod
\end{code}
| ATyCon TyCon
| AClass Class
+isTyClThing :: TyThing -> Bool
+isTyClThing (ATyCon _) = True
+isTyClThing (AClass _) = True
+isTyClThing (AnId _) = False
+
instance NamedThing TyThing where
getName (AnId id) = getName id
getName (ATyCon tc) = getName tc
getName (AClass cl) = getName cl
+
+typeEnvClasses env = [cl | AClass cl <- nameEnvElts env]
+typeEnvTyCons env = [tc | ATyCon tc <- nameEnvElts env]
+
\end{code}
= foldFM add tbl things
where
add mod type_env tbl
- = panic "extendTypeEnv" --extendModuleEnv mod new_details
+ = extendModuleEnv tbl mod new_details
where
new_details
= case lookupModuleEnv tbl mod of
-- the parent class/tycon changes
}
-type DeprecationEnv = NameEnv DeprecTxt -- Give reason for deprecation
+initialVersionInfo :: VersionInfo
+initialVersionInfo = VersionInfo { vers_module = initialVersion,
+ vers_exports = initialVersion,
+ vers_rules = initialVersion,
+ vers_decls = emptyNameEnv }
+
+data Deprecations = NoDeprecs
+ | DeprecAll DeprecTxt -- Whole module deprecated
+ | DeprecSome (NameEnv (Name,DeprecTxt)) -- Some things deprecated
+ -- Just "big" names
+ -- We keep the Name in the range, so we can print them out
+
+lookupDeprec :: ModIface -> Name -> Maybe DeprecTxt
+lookupDeprec iface name
+ = case mi_deprecs iface of
+ NoDeprecs -> Nothing
+ DeprecAll txt -> Just txt
+ DeprecSome env -> 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
-
-type RuleEnv = IdEnv [CoreRule]
-
-emptyRuleEnv = emptyVarEnv
\end{code}
= PCS {
pcs_PIT :: PackageIfaceTable, -- Domain = non-home-package modules
-- the mi_decls component is empty
+
pcs_PST :: PackageSymbolTable, -- Domain = non-home-package modules
-- except that the InstEnv components is empty
- pcs_insts :: InstEnv, -- The total InstEnv accumulated from all
+
+ pcs_insts :: PackageInstEnv, -- The total InstEnv accumulated from all
-- the non-home-package modules
- pcs_rules :: RuleEnv, -- Ditto RuleEnv
+
+ pcs_rules :: PackageRuleBase, -- Ditto RuleEnv
pcs_PRS :: PersistentRenamerState
}
+
\end{code}
The @PersistentRenamerState@ persists across successive calls to the
interface files but not yet sucked in, renamed, and typechecked
\begin{code}
+type PackageRuleBase = RuleBase
+type PackageInstEnv = InstEnv
+
data PersistentRenamerState
= PRS { prsOrig :: OrigNameEnv,
prsDecls :: DeclsMap,
prsInsts :: IfaceInsts,
- prsRules :: IfaceRules
+ prsRules :: IfaceRules,
+ prsNS :: UniqSupply
}
\end{code}
for the 'main' Name.
\begin{code}
-type DeclsMap = NameEnv (AvailInfo, Bool, (Module, RdrNameHsDecl))
+type DeclsMap = NameEnv (AvailInfo, Bool, (Module, RdrNameTyClDecl))
type IfaceInsts = Bag GatedDecl
type IfaceRules = Bag GatedDecl
= (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
-{-
-Moved here from Name.
-pp_prov (LocalDef _ Exported) = char 'x'
-pp_prov (LocalDef _ NotExported) = char 'l'
-pp_prov (NonLocalDef ImplicitImport _) = char 'j'
-pp_prov (NonLocalDef (UserImport _ _ True ) _) = char 'I' -- Imported by name
-pp_prov (NonLocalDef (UserImport _ _ False) _) = char 'i' -- Imported by ..
-pp_prov SystemProv = char 's'
--}
-
data ImportReason
= UserImport Module SrcLoc Bool -- Imported from module M on line L
-- Note the M may well not be the defining module
hasBetterProv _ _ = False
pprNameProvenance :: Name -> Provenance -> SDoc
-pprNameProvenance name LocalDef = ptext SLIT("defined at") <+> ppr (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)))]
projects / ghc-hetmet.git / blobdiff