X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=34f655535940b1f667ec5a4ca971a9dcacbd00ed;hb=db375d630cb6e3377e48daaa0388ba5a4f798f7b;hp=a200bf99ca31c01dc883d79d262be71803d7e00f;hpb=61d2625ae2e6a4cdae2ffc92df828905e81c24cc;p=ghc-hetmet.git diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index a200bf9..34f6555 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -30,7 +30,7 @@ module HscTypes ( icPrintUnqual, mkPrintUnqualified, ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache, - emptyIfaceDepCache, + emptyIfaceDepCache, mkIfaceFamInstsCache, mkDetailsFamInstCache, Deprecs(..), IfaceDeprecs, @@ -42,6 +42,7 @@ module HscTypes ( TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv, extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv, typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds, + typeEnvDataCons, WhetherHasOrphans, IsBootInterface, Usage(..), Dependencies(..), noDependencies, @@ -77,14 +78,16 @@ import OccName ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv, extendOccEnv ) import Module import InstEnv ( InstEnv, Instance ) +import FamInstEnv ( FamInst, extractFamInsts ) import Rules ( RuleBase ) import CoreSyn ( CoreBind ) import Id ( Id ) import Type ( TyThing(..) ) -import Class ( Class, classSelIds, classTyCon ) -import TyCon ( TyCon, tyConSelIds, tyConDataCons ) -import DataCon ( dataConImplicitIds ) +import Class ( Class, classSelIds, classATs, classTyCon ) +import TyCon ( TyCon, tyConSelIds, tyConDataCons, + newTyConCo_maybe, tyConFamilyCoercion_maybe ) +import DataCon ( DataCon, dataConImplicitIds ) import PrelNames ( gHC_PRIM ) import Packages ( PackageId ) import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) ) @@ -92,7 +95,8 @@ import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase ) import BasicTypes ( Version, initialVersion, IPName, Fixity, defaultFixity, DeprecTxt ) -import IfaceSyn ( IfaceInst, IfaceRule, IfaceDecl(ifName) ) +import IfaceSyn ( IfaceInst, IfaceFamInst, IfaceRule, + IfaceDecl(ifName), extractIfFamInsts ) import FiniteMap ( FiniteMap ) import CoreSyn ( CoreRule ) @@ -105,6 +109,7 @@ import FastString ( FastString ) import DATA_IOREF ( IORef, readIORef ) import StringBuffer ( StringBuffer ) +import Maybe ( catMaybes ) import Time ( ClockTime ) \end{code} @@ -323,8 +328,8 @@ data FindResult | ModuleHidden PackageId -- for an explicit source import: the package containing the module is -- exposed, but the module itself is hidden. - | NotFound [FilePath] - -- the module was not found, the specified places were searched. + | NotFound [FilePath] (Maybe PackageId) + -- the module was not found, the specified places were searched | NotFoundInPackage PackageId -- the module was not found in this package @@ -405,9 +410,12 @@ data ModIface -- HomeModInfo, but that leads to more plumbing. -- Instance declarations and rules - mi_insts :: [IfaceInst], -- Sorted - mi_rules :: [IfaceRule], -- Sorted - mi_rule_vers :: !Version, -- Version number for rules and instances combined + mi_insts :: [IfaceInst], -- Sorted + mi_fam_insts :: [(IfaceFamInst, IfaceDecl)], -- Cached value + -- ...from mi_decls (not in iface file) + mi_rules :: [IfaceRule], -- Sorted + mi_rule_vers :: !Version, -- Version number for rules and + -- instances combined -- Cached environments for easy lookup -- These are computed (lazily) from other fields @@ -420,20 +428,34 @@ data ModIface -- seeing if we are up to date wrt the old interface } +-- Pre-compute the set of type instances from the declaration list. +mkIfaceFamInstsCache :: [IfaceDecl] -> [(IfaceFamInst, IfaceDecl)] +mkIfaceFamInstsCache = extractIfFamInsts + -- Should be able to construct ModDetails from mi_decls in ModIface data ModDetails = ModDetails { -- The next three fields are created by the typechecker - md_exports :: NameSet, - md_types :: !TypeEnv, - md_insts :: ![Instance], -- Dfun-ids for the instances in this module - md_rules :: ![CoreRule] -- Domain may include Ids from other modules + md_exports :: NameSet, + md_types :: !TypeEnv, + md_fam_insts :: ![FamInst], -- Cached value extracted from md_types + md_insts :: ![Instance], -- Dfun-ids for the instances in this + -- module + + md_rules :: ![CoreRule] -- Domain may include Ids from other + -- modules + } emptyModDetails = ModDetails { md_types = emptyTypeEnv, md_exports = emptyNameSet, - md_insts = [], - md_rules = [] } + md_insts = [], + md_rules = [], + md_fam_insts = [] } + +-- Pre-compute the set of type instances from the type environment. +mkDetailsFamInstCache :: TypeEnv -> [FamInst] +mkDetailsFamInstCache = extractFamInsts . typeEnvElts -- A ModGuts is carried through the compiler, accumulating stuff as it goes -- There is only one ModGuts at any time, the one for the module @@ -537,10 +559,11 @@ emptyModIface mod mi_exp_vers = initialVersion, mi_fixities = [], mi_deprecs = NoDeprecs, - mi_insts = [], - mi_rules = [], - mi_decls = [], - mi_globals = Nothing, + mi_insts = [], + mi_fam_insts = [], + mi_rules = [], + mi_decls = [], + mi_globals = Nothing, mi_rule_vers = initialVersion, mi_dep_fn = emptyIfaceDepCache, mi_fix_fn = emptyIfaceFixCache, @@ -618,24 +641,34 @@ mkPrintUnqualified env = (qual_name, qual_mod) \begin{code} implicitTyThings :: TyThing -> [TyThing] +-- If you change this, make sure you change LoadIface.ifaceDeclSubBndrs in sync + implicitTyThings (AnId id) = [] -- For type constructors, add the data cons (and their extras), -- and the selectors and generic-programming Ids too -- -- Newtypes don't have a worker Id, so don't generate that? -implicitTyThings (ATyCon tc) = map AnId (tyConSelIds tc) ++ - concatMap (extras_plus . ADataCon) (tyConDataCons tc) +implicitTyThings (ATyCon tc) = implicitCoTyCon tc ++ + map AnId (tyConSelIds tc) ++ + concatMap (extras_plus . ADataCon) + (tyConDataCons tc) -- For classes, add the class TyCon too (and its extras) - -- and the class selector Ids + -- and the class selector Ids and the associated types (they don't + -- have extras as these are only the family decls) implicitTyThings (AClass cl) = map AnId (classSelIds cl) ++ + map ATyCon (classATs cl) ++ extras_plus (ATyCon (classTyCon cl)) - -- For data cons add the worker and wrapper (if any) implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc) + -- For newtypes and indexed data types, add the implicit coercion tycon +implicitCoTyCon tc + = map ATyCon . catMaybes $ [newTyConCo_maybe tc, + tyConFamilyCoercion_maybe tc] + extras_plus thing = thing : implicitTyThings thing extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv @@ -652,18 +685,20 @@ extendTypeEnvWithIds env ids \begin{code} type TypeEnv = NameEnv TyThing -emptyTypeEnv :: TypeEnv -typeEnvElts :: TypeEnv -> [TyThing] -typeEnvClasses :: TypeEnv -> [Class] -typeEnvTyCons :: TypeEnv -> [TyCon] -typeEnvIds :: TypeEnv -> [Id] -lookupTypeEnv :: TypeEnv -> Name -> Maybe TyThing - -emptyTypeEnv = emptyNameEnv -typeEnvElts env = nameEnvElts env -typeEnvClasses env = [cl | AClass cl <- typeEnvElts env] -typeEnvTyCons env = [tc | ATyCon tc <- typeEnvElts env] -typeEnvIds env = [id | AnId id <- typeEnvElts env] +emptyTypeEnv :: TypeEnv +typeEnvElts :: TypeEnv -> [TyThing] +typeEnvClasses :: TypeEnv -> [Class] +typeEnvTyCons :: TypeEnv -> [TyCon] +typeEnvIds :: TypeEnv -> [Id] +typeEnvDataCons :: TypeEnv -> [DataCon] +lookupTypeEnv :: TypeEnv -> Name -> Maybe TyThing + +emptyTypeEnv = emptyNameEnv +typeEnvElts env = nameEnvElts env +typeEnvClasses env = [cl | AClass cl <- typeEnvElts env] +typeEnvTyCons env = [tc | ATyCon tc <- typeEnvElts env] +typeEnvIds env = [id | AnId id <- typeEnvElts env] +typeEnvDataCons env = [dc | ADataCon dc <- typeEnvElts env] mkTypeEnv :: [TyThing] -> TypeEnv mkTypeEnv things = extendTypeEnvList emptyTypeEnv things @@ -696,7 +731,6 @@ lookupType dflags hpt pte name this_pkg = thisPackage dflags \end{code} - \begin{code} tyThingTyCon (ATyCon tc) = tc tyThingTyCon other = pprPanic "tyThingTyCon" (ppr other) @@ -1064,7 +1098,7 @@ showModMsg target recomp mod_summary _other -> text (msObjFilePath mod_summary), char ')']) where - mod = ms_mod mod_summary + mod = moduleName (ms_mod mod_summary) mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary) \end{code}