Commit e5f78a4a authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.

Add VectInfo to HPT

  I am putting this patch (as the previous VectInfo patch) straight away
  into the head to avoid the kind of merging disaster we had with the FC
  branch.  The patch does not interfere with any other functionality and
  hence should cause no harm in the head.
parent fb57f87a
......@@ -242,11 +242,11 @@ mkIface hsc_env maybe_old_iface
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 })
......@@ -272,6 +272,7 @@ mkIface hsc_env maybe_old_iface
; 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,
......@@ -286,6 +287,8 @@ mkIface hsc_env maybe_old_iface
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,
......@@ -300,8 +303,6 @@ 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 }
......
......@@ -40,6 +40,7 @@ import Var ( TyVar )
import qualified Var
import Name
import NameEnv
import NameSet
import OccName
import Module
import UniqFM
......@@ -198,6 +199,10 @@ typecheckIface iface
; 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)
......@@ -208,6 +213,7 @@ typecheckIface iface
, md_insts = insts
, md_fam_insts = fam_insts
, md_rules = rules
, md_vect_info = vect_info
, md_exports = exports
, md_modBreaks = emptyModBreaks
}
......
......@@ -682,9 +682,14 @@ hscFileCheck hsc_env mod_summary = do {
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
......
......@@ -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,
......@@ -330,6 +330,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}
%************************************************************************
......@@ -475,10 +484,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,
......@@ -486,7 +496,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
......
......@@ -32,7 +32,7 @@ import Name ( Name, getOccName, nameOccName, mkInternalName,
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 )
......@@ -142,6 +142,7 @@ mkBootModDetails hsc_env (ModGuts { mg_module = mod
, md_rules = []
, md_exports = exports
, md_modBreaks = modBreaks
, md_vect_info = noVectInfo
})
}
where
......@@ -243,6 +244,7 @@ tidyProgram hsc_env
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,
......@@ -285,6 +287,12 @@ tidyProgram hsc_env
; 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
......@@ -305,8 +313,9 @@ tidyProgram hsc_env
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
......@@ -314,6 +323,11 @@ 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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment