X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=fb8e87edb254d463b778cb955c1c4ce5da6d0f50;hb=2eb04ca0f8d0ec72b417cddc60672c696b4a3daa;hp=f04615a6e1e8a260946d4dce71a59ad521eacd69;hpb=c916244fe9246b4f9d88a9b1c7c9ee8c55b15696;p=ghc-hetmet.git diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index f04615a..fb8e87e 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -21,7 +21,7 @@ module HscTypes ( HscSource(..), isHsBoot, hscSourceString, -- Re-exported from DriverPhases HomePackageTable, HomeModInfo(..), emptyHomePackageTable, - hptInstances, hptRules, + hptInstances, hptRules, hptVectInfo, ExternalPackageState(..), EpsStats(..), addEpsInStats, PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable, @@ -63,7 +63,11 @@ module HscTypes ( HpcInfo(..), noHpcInfo, -- Breakpoints - ModBreaks (..), BreakIndex, emptyModBreaks + ModBreaks (..), BreakIndex, emptyModBreaks, + + -- Vectorisation information + VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo, + noIfaceVectInfo ) where #include "HsVersions.h" @@ -86,7 +90,9 @@ import InstEnv ( InstEnv, Instance ) import FamInstEnv ( FamInstEnv, FamInst ) import Rules ( RuleBase ) import CoreSyn ( CoreBind ) +import VarEnv import VarSet +import Var import Id import Type ( TyThing(..) ) @@ -282,16 +288,19 @@ lookupIfaceByModule dflags hpt pit mod \begin{code} -hptInstances :: HscEnv -> (ModuleName -> Bool) -> [Instance] --- Find all the instance declarations that are in modules imported --- by this one, directly or indirectly, and are in the Home Package Table --- This ensures that we don't see instances from modules --make compiled --- before this one, but which are not below this one +hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([Instance], [FamInst]) +-- Find all the instance declarations (of classes and families) that are in +-- modules imported by this one, directly or indirectly, and are in the Home +-- Package Table. This ensures that we don't see instances from modules --make +-- compiled before this one, but which are not below this one. hptInstances hsc_env want_this_module - = [ ispec - | mod_info <- eltsUFM (hsc_HPT hsc_env) - , want_this_module (moduleName (mi_module (hm_iface mod_info))) - , ispec <- md_insts (hm_details mod_info) ] + = let (insts, famInsts) = unzip + [ (md_insts details, md_fam_insts details) + | mod_info <- eltsUFM (hsc_HPT hsc_env) + , want_this_module (moduleName (mi_module (hm_iface mod_info))) + , let details = hm_details mod_info ] + in + (concat insts, concat famInsts) hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule] -- Get rules from modules "below" this one (in the dependency sense) @@ -323,6 +332,15 @@ hptRules hsc_env deps -- And get its dfuns , rule <- rules ] + +hptVectInfo :: HscEnv -> VectInfo +-- Get the combined VectInfo of all modules in the home package table. In +-- contrast to instances and rules, we don't care whether the modules are +-- "below" or us. The VectInfo of those modules not "below" us does not +-- affect the compilation of the current module. +hptVectInfo hsc_env + = foldr plusVectInfo noVectInfo [ md_vect_info (hm_details mod_info) + | mod_info <- eltsUFM (hsc_HPT hsc_env)] \end{code} %************************************************************************ @@ -446,6 +464,9 @@ data ModIface -- instances (for classes and families) -- combined + -- Vectorisation information + mi_vect_info :: !IfaceVectInfo, + -- Cached environments for easy lookup -- These are computed (lazily) from other fields -- and are not put into the interface file @@ -465,10 +486,11 @@ data ModDetails -- The next two fields are created by the typechecker md_exports :: [AvailInfo], md_types :: !TypeEnv, - md_insts :: ![Instance], -- Dfun-ids for the instances in this module + md_insts :: ![Instance], -- Dfun-ids for the instances in this module md_fam_insts :: ![FamInst], - md_rules :: ![CoreRule], -- Domain may include Ids from other modules - md_modBreaks :: !ModBreaks -- breakpoint information for this module + md_rules :: ![CoreRule], -- Domain may include Ids from other modules + md_modBreaks :: !ModBreaks, -- Breakpoint information for this module + md_vect_info :: !VectInfo -- Vectorisation information } emptyModDetails = ModDetails { md_types = emptyTypeEnv, @@ -476,7 +498,9 @@ emptyModDetails = ModDetails { md_types = emptyTypeEnv, md_insts = [], md_rules = [], md_fam_insts = [], - md_modBreaks = emptyModBreaks } + md_modBreaks = emptyModBreaks, + md_vect_info = noVectInfo + } -- 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 @@ -510,7 +534,8 @@ data ModGuts mg_foreign :: !ForeignStubs, mg_deprecs :: !Deprecations, -- Deprecations declared in the module mg_hpc_info :: !HpcInfo, -- info about coverage tick boxes - mg_modBreaks :: !ModBreaks + mg_modBreaks :: !ModBreaks, + mg_vect_info :: !VectInfo -- Pool of vectorised declarations } -- The ModGuts takes on several slightly different forms: @@ -597,6 +622,7 @@ emptyModIface mod mi_decls = [], mi_globals = Nothing, mi_rule_vers = initialVersion, + mi_vect_info = noIfaceVectInfo, mi_dep_fn = emptyIfaceDepCache, mi_fix_fn = emptyIfaceFixCache, mi_ver_fn = emptyIfaceVerCache @@ -623,8 +649,8 @@ data InteractiveContext -- ic_toplev_scope and ic_exports ic_tmp_ids :: [Id], -- Names bound during interaction. - -- Earlier Ids shadow - -- later ones with the same OccName. + -- Later Ids shadow + -- earlier ones with the same OccName. ic_tyvars :: TyVarSet -- skolem type variables free in -- ic_tmp_ids. These arise at @@ -659,7 +685,9 @@ extendInteractiveContext -> TyVarSet -> InteractiveContext extendInteractiveContext ictxt ids tyvars - = ictxt { ic_tmp_ids = ids ++ ic_tmp_ids ictxt, + = ictxt { ic_tmp_ids = ic_tmp_ids ictxt ++ ids, + -- NB. must be this way around, because we want + -- new ids to shadow existing bindings. ic_tyvars = ic_tyvars ictxt `unionVarSet` tyvars } \end{code} @@ -1021,6 +1049,7 @@ type PackageTypeEnv = TypeEnv type PackageRuleBase = RuleBase type PackageInstEnv = InstEnv type PackageFamInstEnv = FamInstEnv +type PackageVectInfo = VectInfo data ExternalPackageState = EPS { @@ -1057,10 +1086,10 @@ data ExternalPackageState -- modules eps_fam_inst_env :: !PackageFamInstEnv,-- Ditto FamInstEnv eps_rule_base :: !PackageRuleBase, -- Ditto RuleEnv + eps_vect_info :: !PackageVectInfo, -- Ditto VectInfo eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- identifies family - -- instances of each mod - + -- instances of each mod eps_stats :: !EpsStats } @@ -1209,6 +1238,63 @@ noHpcInfo = NoHpcInfo %************************************************************************ %* * +\subsection{Vectorisation Support} +%* * +%************************************************************************ + +The following information is generated and consumed by the vectorisation +subsystem. It communicates the vectorisation status of declarations from one +module to another. + +Why do we need both f and f_CC in the ModGuts/ModDetails/EPS version VectInfo +below? We need to know `f' when converting to IfaceVectInfo. However, during +closure conversion, we need to know `f_CC', whose `Var' we cannot lookup based +on just the OccName easily in a Core pass. + +\begin{code} +-- ModGuts/ModDetails/EPS version +data VectInfo + = VectInfo { + vectInfoCCVar :: VarEnv (Var , Var ), -- (f, f_CC) keyed on f + vectInfoCCTyCon :: NameEnv (TyCon , TyCon), -- (T, T_CC) keyed on T + vectInfoCCDataCon :: NameEnv (DataCon, DataCon), -- (C, C_CC) keyed on C + vectInfoCCIso :: NameEnv (TyCon , Var) -- (T, isoT) keyed on T + } + -- all of this is always tidy, even in ModGuts + +-- ModIface version +data IfaceVectInfo + = IfaceVectInfo { + ifaceVectInfoCCVar :: [Name], + -- all variables in here have a closure-converted variant; + -- the name of the CC'ed variant is determined by `mkCloOcc' + ifaceVectInfoCCTyCon :: [Name], + -- all tycons in here have a closure-converted variant; + -- the name of the CC'ed variant and those of its data constructors are + -- determined by `mkCloTyConOcc' and `mkCloDataConOcc'; the names of + -- the isomorphisms is determined by `mkCloIsoOcc' + ifaceVectInfoCCTyConReuse :: [Name] + -- the closure-converted form of all the tycons in here coincids with + -- the unconverted from; the names of the isomorphisms is determined + -- by `mkCloIsoOcc' + } + +noVectInfo :: VectInfo +noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv + +plusVectInfo :: VectInfo -> VectInfo -> VectInfo +plusVectInfo vi1 vi2 = + VectInfo (vectInfoCCVar vi1 `plusVarEnv` vectInfoCCVar vi2) + (vectInfoCCTyCon vi1 `plusNameEnv` vectInfoCCTyCon vi2) + (vectInfoCCDataCon vi1 `plusNameEnv` vectInfoCCDataCon vi2) + (vectInfoCCIso vi1 `plusNameEnv` vectInfoCCIso vi2) + +noIfaceVectInfo :: IfaceVectInfo +noIfaceVectInfo = IfaceVectInfo [] [] [] +\end{code} + +%************************************************************************ +%* * \subsection{Linkable stuff} %* * %************************************************************************