Commit b0c46848 authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au
Browse files

Adapt interface file code for vectorisation

For the most part, this patch simply renames functions which had been used
for closure conversion and hence have CC in their name. It also changes the
OccNames generated by vectorisation.
parent 35380dd8
......@@ -32,7 +32,7 @@ module OccName (
mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
mkInstTyCoOcc, mkEqPredCoOcc,
mkCloOcc, mkCloTyConOcc, mkCloDataConOcc, mkCloIsoOcc,
mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
-- ** Deconstruction
occNameFS, occNameString, occNameSpace,
......@@ -458,11 +458,11 @@ mkGenOcc2 = mk_simple_deriv varName "$gto"
mkDataTOcc = mk_simple_deriv varName "$t"
mkDataCOcc = mk_simple_deriv varName "$c"
-- Closure conversion
mkCloOcc = mk_simple_deriv varName "$CC_"
mkCloTyConOcc = mk_simple_deriv tcName ":CC_"
mkCloDataConOcc = mk_simple_deriv dataName ":CD_"
mkCloIsoOcc = mk_simple_deriv varName "$CCiso_"
-- Vectorisation
mkVectOcc = mk_simple_deriv varName "$v_"
mkVectTyConOcc = mk_simple_deriv tcName ":V_"
mkVectDataConOcc = mk_simple_deriv dataName ":VD_"
mkVectIsoOcc = mk_simple_deriv varName "$VI_"
mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
......
......@@ -677,14 +677,14 @@ pprFixities fixes = ptext SLIT("fixities") <+> pprWithCommas pprFix fixes
pprFix (occ,fix) = ppr fix <+> ppr occ
pprVectInfo :: IfaceVectInfo -> SDoc
pprVectInfo (IfaceVectInfo { ifaceVectInfoCCVar = vars
, ifaceVectInfoCCTyCon = tycons
, ifaceVectInfoCCTyConReuse = tyconsReuse
pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars
, ifaceVectInfoTyCon = tycons
, ifaceVectInfoTyConReuse = tyconsReuse
}) =
vcat
[ ptext SLIT("CC'ed variables:") <+> hsep (map ppr vars)
, ptext SLIT("CC'ed tycons:") <+> hsep (map ppr tycons)
, ptext SLIT("CC reused tycons:") <+> hsep (map ppr tyconsReuse)
[ ptext SLIT("vectorised variables:") <+> hsep (map ppr vars)
, ptext SLIT("vectorised tycons:") <+> hsep (map ppr tycons)
, ptext SLIT("vectorised reused tycons:") <+> hsep (map ppr tyconsReuse)
]
pprDeprecs NoDeprecs = empty
......
......@@ -339,18 +339,18 @@ mkIface hsc_env maybe_old_iface
deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
flattenVectInfo (VectInfo { vectInfoCCVar = ccVar
, vectInfoCCTyCon = ccTyCon
flattenVectInfo (VectInfo { vectInfoVar = vVar
, vectInfoTyCon = vTyCon
}) =
IfaceVectInfo {
ifaceVectInfoCCVar = [ Var.varName v
| (v, _) <- varEnvElts ccVar],
ifaceVectInfoCCTyCon = [ tyConName t
| (t, t_CC) <- nameEnvElts ccTyCon
, t /= t_CC],
ifaceVectInfoCCTyConReuse = [ tyConName t
| (t, t_CC) <- nameEnvElts ccTyCon
, t == t_CC]
ifaceVectInfoVar = [ Var.varName v
| (v, _) <- varEnvElts vVar],
ifaceVectInfoTyCon = [ tyConName t
| (t, t_v) <- nameEnvElts vTyCon
, t /= t_v],
ifaceVectInfoTyConReuse = [ tyConName t
| (t, t_v) <- nameEnvElts vTyCon
, t == t_v]
}
-----------------------------
......
......@@ -593,57 +593,57 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
\begin{code}
tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
tcIfaceVectInfo mod typeEnv (IfaceVectInfo
{ ifaceVectInfoCCVar = vars
, ifaceVectInfoCCTyCon = tycons
, ifaceVectInfoCCTyConReuse = tyconsReuse
{ ifaceVectInfoVar = vars
, ifaceVectInfoTyCon = tycons
, ifaceVectInfoTyConReuse = tyconsReuse
})
= do { ccVars <- mapM ccVarMapping vars
; tyConRes1 <- mapM ccTyConMapping tycons
; tyConRes2 <- mapM ccTyConReuseMapping tycons
; let (ccTyCons, ccDataCons, ccIsos) = unzip3 (tyConRes1 ++ tyConRes2)
= do { vVars <- mapM vectVarMapping vars
; tyConRes1 <- mapM vectTyConMapping tycons
; tyConRes2 <- mapM vectTyConReuseMapping tycons
; let (vTyCons, vDataCons, vIsos) = unzip3 (tyConRes1 ++ tyConRes2)
; return $ VectInfo
{ vectInfoCCVar = mkVarEnv ccVars
, vectInfoCCTyCon = mkNameEnv ccTyCons
, vectInfoCCDataCon = mkNameEnv (concat ccDataCons)
, vectInfoCCIso = mkNameEnv ccIsos
{ vectInfoVar = mkVarEnv vVars
, vectInfoTyCon = mkNameEnv vTyCons
, vectInfoDataCon = mkNameEnv (concat vDataCons)
, vectInfoIso = mkNameEnv vIsos
}
}
where
ccVarMapping name
= do { ccName <- lookupOrig mod (mkCloOcc (nameOccName name))
; let { var = lookupVar name
; ccVar = lookupVar ccName
vectVarMapping name
= do { vName <- lookupOrig mod (mkVectOcc (nameOccName name))
; let { var = lookupVar name
; vVar = lookupVar vName
}
; return (var, (var, ccVar))
; return (var, (var, vVar))
}
ccTyConMapping name
= do { ccName <- lookupOrig mod (mkCloTyConOcc (nameOccName name))
; isoName <- lookupOrig mod (mkCloIsoOcc (nameOccName name))
vectTyConMapping name
= do { vName <- lookupOrig mod (mkVectTyConOcc (nameOccName name))
; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
; let { tycon = lookupTyCon name
; ccTycon = lookupTyCon ccName
; vTycon = lookupTyCon vName
; isoTycon = lookupVar isoName
}
; ccDataCons <- mapM ccDataConMapping (tyConDataCons tycon)
; return ((name, (tycon, ccTycon)), -- (T, T_CC)
ccDataCons, -- list of (Ci, Ci_CC)
; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon)
; return ((name, (tycon, vTycon)), -- (T, T_v)
vDataCons, -- list of (Ci, Ci_v)
(name, (tycon, isoTycon))) -- (T, isoT)
}
ccTyConReuseMapping name
= do { isoName <- lookupOrig mod (mkCloIsoOcc (nameOccName name))
vectTyConReuseMapping name
= do { isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
; let { tycon = lookupTyCon name
; isoTycon = lookupVar isoName
; ccDataCons = [ (dataConName dc, (dc, dc))
; vDataCons = [ (dataConName dc, (dc, dc))
| dc <- tyConDataCons tycon]
}
; return ((name, (tycon, tycon)), -- (T, T)
ccDataCons, -- list of (Ci, Ci)
vDataCons, -- list of (Ci, Ci)
(name, (tycon, isoTycon))) -- (T, isoT)
}
ccDataConMapping datacon
vectDataConMapping datacon
= do { let name = dataConName datacon
; ccName <- lookupOrig mod (mkCloDataConOcc (nameOccName name))
; let ccDataCon = lookupDataCon ccName
; return (name, (datacon, ccDataCon))
; vName <- lookupOrig mod (mkVectDataConOcc (nameOccName name))
; let vDataCon = lookupDataCon vName
; return (name, (datacon, vDataCon))
}
--
lookupVar name = case lookupTypeEnv typeEnv name of
......
......@@ -1275,37 +1275,38 @@ 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
Why do we need both f and f_v 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
vectorisation, we need to know `f_v', 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
vectInfoVar :: VarEnv (Var , Var ), -- (f, f_v) keyed on f
vectInfoTyCon :: NameEnv (TyCon , TyCon), -- (T, T_v) keyed on T
vectInfoDataCon :: NameEnv (DataCon, DataCon), -- (C, C_v) keyed on C
vectInfoIso :: 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
ifaceVectInfoVar :: [Name],
-- all variables in here have a vectorised variant;
-- the name of the vectorised variant is determined by `mkCloVect'
ifaceVectInfoTyCon :: [Name],
-- all tycons in here have a vectorised variant;
-- the name of the vectorised variant and those of its
-- data constructors are determined by `mkVectTyConOcc'
-- and `mkVectDataConOcc'; the names of
-- the isomorphisms is determined by `mkVectIsoOcc'
ifaceVectInfoTyConReuse :: [Name]
-- the vectorised form of all the tycons in here coincids with
-- the unconverted from; the names of the isomorphisms is determined
-- by `mkCloIsoOcc'
-- by `mkVectIsoOcc'
}
noVectInfo :: VectInfo
......@@ -1313,10 +1314,10 @@ 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)
VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2)
(vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2)
(vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
(vectInfoIso vi1 `plusNameEnv` vectInfoIso vi2)
noIfaceVectInfo :: IfaceVectInfo
noIfaceVectInfo = IfaceVectInfo [] [] []
......
......@@ -133,9 +133,9 @@ data LocalEnv = LocalEnv {
initGlobalEnv :: VectInfo -> (InstEnv, InstEnv) -> FamInstEnvs -> GlobalEnv
initGlobalEnv info instEnvs famInstEnvs
= GlobalEnv {
global_vars = mapVarEnv (Var . snd) $ vectInfoCCVar info
global_vars = mapVarEnv (Var . snd) $ vectInfoVar info
, global_exported_vars = emptyVarEnv
, global_tycons = mapNameEnv snd $ vectInfoCCTyCon info
, global_tycons = mapNameEnv snd $ vectInfoTyCon info
, global_tycon_pa = emptyNameEnv
, global_inst_env = instEnvs
, global_fam_inst_env = famInstEnvs
......@@ -151,8 +151,8 @@ emptyLocalEnv = LocalEnv {
updVectInfo :: GlobalEnv -> TypeEnv -> VectInfo -> VectInfo
updVectInfo env tyenv info
= info {
vectInfoCCVar = global_exported_vars env
, vectInfoCCTyCon = tc_env
vectInfoVar = global_exported_vars env
, vectInfoTyCon = tc_env
}
where
tc_env = mkNameEnv [(tc_name, (tc,tc'))
......
Supports Markdown
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