From 7fa861d23122d4d6a3053c09b5c636bad0478ad3 Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Fri, 4 May 2007 07:37:34 +0000 Subject: [PATCH] IfaceVectInfo and propagation through EPS --- compiler/iface/BinIface.hs | 13 ++++++++++++- compiler/iface/LoadIface.lhs | 14 ++++++++++++-- compiler/iface/MkIface.lhs | 7 ++++++- compiler/main/HscTypes.lhs | 35 +++++++++++++++++++++++++++++------ 4 files changed, 59 insertions(+), 10 deletions(-) diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 9bdb7b6..3c62db9 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -293,7 +293,8 @@ instance Binary ModIface where mi_insts = insts, mi_fam_insts = fam_insts, mi_rules = rules, - mi_rule_vers = rule_vers }) = do + mi_rule_vers = rule_vers, + mi_vect_info = vect_info }) = do put_ bh mod put_ bh is_boot put_ bh mod_vers @@ -310,6 +311,7 @@ instance Binary ModIface where put_ bh fam_insts lazyPut bh rules put_ bh rule_vers + put_ bh vect_info get bh = do mod_name <- get bh @@ -328,6 +330,7 @@ instance Binary ModIface where fam_insts <- {-# SCC "bin_fam_insts" #-} get bh rules <- {-# SCC "bin_rules" #-} lazyGet bh rule_vers <- get bh + vect_info <- get bh return (ModIface { mi_module = mod_name, mi_boot = is_boot, @@ -346,6 +349,7 @@ instance Binary ModIface where mi_fam_insts = fam_insts, mi_rules = rules, mi_rule_vers = rule_vers, + mi_vect_info = vect_info, -- And build the cached values mi_dep_fn = mkIfaceDepCache deprecs, mi_fix_fn = mkIfaceFixCache fixities, @@ -1217,4 +1221,11 @@ instance Binary IfaceRule where a7 <- get bh return (IfaceRule a1 a2 a3 a4 a5 a6 a7) +instance Binary IfaceVectInfo where + put_ bh (IfaceVectInfo a1) = do + put_ bh a1 + get bh = do + a1 <- get bh + return (IfaceVectInfo a1) + diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 571f96b..00e9e7a 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -38,6 +38,7 @@ import InstEnv import FamInstEnv import Name import NameEnv +import NameSet import MkId import Module import OccName @@ -225,7 +226,7 @@ loadInterface doc_str mod from -- -- The main thing is to add the ModIface to the PIT, but -- we also take the - -- IfaceDecls, IfaceInst, IfaceRules + -- IfaceDecls, IfaceInst, IfaceFamInst, IfaceRules, IfaceVectInfo -- out of the ModIface and put them into the big EPS pools -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined @@ -244,7 +245,13 @@ loadInterface doc_str mod from mi_insts = panic "No mi_insts in PIT", mi_fam_insts = panic "No mi_fam_insts in PIT", mi_rules = panic "No mi_rules in PIT" - } } + } + ; new_eps_vect_info = + VectInfo { + vectInfoCCVar = mkNameSet + (ifaceVectInfoCCVar . mi_vect_info $ iface) + } + } ; updateEps_ $ \ eps -> eps { @@ -256,6 +263,8 @@ loadInterface doc_str mod from new_eps_insts, eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps) new_eps_fam_insts, + eps_vect_info = plusVectInfo (eps_vect_info eps) + new_eps_vect_info, eps_mod_fam_inst_env = let fam_inst_env = @@ -490,6 +499,7 @@ initExternalPackageState -- Initialise the EPS rule pool with the built-in rules eps_mod_fam_inst_env = emptyModuleEnv, + eps_vect_info = noVectInfo, eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0 , n_insts_in = 0, n_insts_out = 0 , n_rules_in = length builtinRules, n_rules_out = 0 } diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 6f3e336..df5bc08 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -242,7 +242,8 @@ mkIface hsc_env maybe_old_iface mg_deps = deps, mg_rdr_env = rdr_env, mg_fix_env = fix_env, - mg_deprecs = src_deprecs }) + mg_deprecs = src_deprecs, + mg_vect_info = vect_info }) (ModDetails{ md_insts = insts, md_fam_insts = fam_insts, md_rules = rules, @@ -299,6 +300,8 @@ mkIface hsc_env maybe_old_iface mi_decls = deliberatelyOmitted "decls", mi_ver_fn = deliberatelyOmitted "ver_fn", + mi_vect_info = flattenVectInfo vect_info, + -- And build the cached values mi_dep_fn = mkIfaceDepCache deprecs, mi_fix_fn = mkIfaceFixCache fixities } @@ -333,6 +336,8 @@ mkIface hsc_env maybe_old_iface deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x) ifFamInstTcName = ifaceTyConName . ifFamInstTyCon + flattenVectInfo (VectInfo ccVar) = IfaceVectInfo (nameSetToList ccVar) + ----------------------------- writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO () writeIfaceFile dflags location new_iface diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index cbe09bc..4797770 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -66,7 +66,8 @@ module HscTypes ( ModBreaks (..), BreakIndex, emptyModBreaks, -- Vectorisation information - VectInfo(..), noVectInfo + VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo, + noIfaceVectInfo ) where #include "HsVersions.h" @@ -449,6 +450,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 @@ -601,6 +605,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 @@ -1027,6 +1032,7 @@ type PackageTypeEnv = TypeEnv type PackageRuleBase = RuleBase type PackageInstEnv = InstEnv type PackageFamInstEnv = FamInstEnv +type PackageVectInfo = VectInfo data ExternalPackageState = EPS { @@ -1063,10 +1069,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 } @@ -1219,13 +1225,30 @@ noHpcInfo = NoHpcInfo %* * %************************************************************************ +The following information is generated and consumed by the vectorisation +subsystem. It communicates the vectorisation status of declarations from one +module to another. + \begin{code} -data VectInfo = VectInfo { - vectInfoCCVar :: NameSet - } +-- ModGuts version +data VectInfo = VectInfo { + vectInfoCCVar :: NameSet + } + +-- ModIface version +data IfaceVectInfo = IfaceVectInfo { + ifaceVectInfoCCVar :: [Name] + } noVectInfo :: VectInfo noVectInfo = VectInfo emptyNameSet + +plusVectInfo :: VectInfo -> VectInfo -> VectInfo +plusVectInfo vi1 vi2 = + VectInfo (vectInfoCCVar vi1 `unionNameSets` vectInfoCCVar vi2) + +noIfaceVectInfo :: IfaceVectInfo +noIfaceVectInfo = IfaceVectInfo [] \end{code} %************************************************************************ -- 1.7.10.4