mg_deps = deps,
mg_rdr_env = rdr_env,
mg_fix_env = fix_env,
- mg_deprecs = src_deprecs,
- mg_vect_info = vect_info })
+ mg_deprecs = src_deprecs})
(ModDetails{ md_insts = insts,
md_fam_insts = fam_insts,
md_rules = rules,
+ md_vect_info = vect_info,
md_types = type_env,
md_exports = exports })
; iface_rules = map (coreRuleToIfaceRule this_mod) rules
; iface_insts = map instanceToIfaceInst insts
; iface_fam_insts = map famInstToIfaceFamInst fam_insts
+ ; iface_vect_info = flattenVectInfo vect_info
; intermediate_iface = ModIface {
mi_module = this_mod,
mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
mi_rules = sortLe le_rule iface_rules,
+ mi_vect_info = iface_vect_info,
+
mi_fixities = fixities,
mi_deprecs = deprecs,
mi_globals = Just rdr_env,
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 }
import qualified Var
import Name
import NameEnv
+import NameSet
import OccName
import Module
import UniqFM
; fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
; rules <- tcIfaceRules ignore_prags (mi_rules iface)
+ -- Vectorisation information
+ ; let vect_info = VectInfo
+ (mkNameSet (ifaceVectInfoCCVar (mi_vect_info iface)))
+
-- Exports
; exports <- ifaceExportNames (mi_exports iface)
, md_insts = insts
, md_fam_insts = fam_insts
, md_rules = rules
+ , md_vect_info = vect_info
, md_exports = exports
, md_modBreaks = emptyModBreaks
}
md_insts = tcg_insts tc_result,
md_fam_insts = tcg_fam_insts tc_result,
md_modBreaks = emptyModBreaks,
- md_rules = [panic "no rules"] }
+ md_rules = [panic "no rules"],
-- Rules are CoreRules, not the
-- RuleDecls we get out of the typechecker
+ md_vect_info =
+ panic "HscMain.hscFileCheck: no VectInfo"
+ -- VectInfo is added by the Core
+ -- vectorisation pass
+ }
rnInfo = do decl <- tcg_rn_decls tc_result
imports <- tcg_rn_imports tc_result
let exports = tcg_rn_exports tc_result
HscSource(..), isHsBoot, hscSourceString, -- Re-exported from DriverPhases
HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
- hptInstances, hptRules,
+ hptInstances, hptRules, hptVectInfo,
ExternalPackageState(..), EpsStats(..), addEpsInStats,
PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
-- 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}
%************************************************************************
-- 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,
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
localiseName, isExternalName, nameSrcLoc,
isWiredInName, getName
)
-import NameSet ( NameSet, elemNameSet )
+import NameSet ( NameSet, elemNameSet, filterNameSet )
import IfaceEnv ( allocateGlobalBinder )
import NameEnv ( filterNameEnv, mapNameEnv )
import OccName ( TidyOccEnv, initTidyOccEnv, tidyOccName )
, md_rules = []
, md_exports = exports
, md_modBreaks = modBreaks
+ , md_vect_info = noVectInfo
})
}
where
mg_insts = insts, mg_fam_insts = fam_insts,
mg_binds = binds,
mg_rules = imp_rules,
+ mg_vect_info = vect_info,
mg_dir_imps = dir_imps, mg_deps = deps,
mg_foreign = foreign_stubs,
mg_hpc_info = hpc_info,
; implicit_binds = getImplicitBinds type_env
; all_tidy_binds = implicit_binds ++ tidy_binds
; alg_tycons = filter isAlgTyCon (typeEnvTyCons type_env)
+
+ ; tidy_vect_info = VectInfo
+ (filterNameSet (isElemId type_env)
+ (vectInfoCCVar vect_info))
+ -- filter against `type_env', not `tidy_type_env', as we must
+ -- keep all implicit names
}
; endPass dflags "Tidy Core" Opt_D_dump_simpl all_tidy_binds
md_insts = tidy_insts,
md_fam_insts = fam_insts,
md_exports = exports,
- md_modBreaks = modBreaks })
-
+ md_modBreaks = modBreaks,
+ md_vect_info = tidy_vect_info
+ })
}
lookup_dfun type_env dfun_id
Just (AnId dfun_id') -> dfun_id'
other -> pprPanic "lookup_dfun" (ppr dfun_id)
+isElemId type_env name
+ = case lookupTypeEnv type_env name of
+ Just (AnId _) -> True
+ _ -> False
+
tidyTypeEnv :: Bool -> NameSet -> TypeEnv -> [CoreBind] -> TypeEnv
-- The competed type environment is gotten from