projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
7246249
)
Use packByTag instead of pack in the vectoriser
author
Roman Leshchinskiy
<rl@cse.unsw.edu.au>
Fri, 30 Oct 2009 00:30:11 +0000
(
00:30
+0000)
committer
Roman Leshchinskiy
<rl@cse.unsw.edu.au>
Fri, 30 Oct 2009 00:30:11 +0000
(
00:30
+0000)
compiler/vectorise/VectBuiltIn.hs
patch
|
blob
|
history
compiler/vectorise/VectMonad.hs
patch
|
blob
|
history
compiler/vectorise/VectUtils.hs
patch
|
blob
|
history
compiler/vectorise/Vectorise.hs
patch
|
blob
|
history
diff --git
a/compiler/vectorise/VectBuiltIn.hs
b/compiler/vectorise/VectBuiltIn.hs
index
77b4243
..
d417898
100644
(file)
--- a/
compiler/vectorise/VectBuiltIn.hs
+++ b/
compiler/vectorise/VectBuiltIn.hs
@@
-1,6
+1,6
@@
module VectBuiltIn (
Builtins(..), sumTyCon, prodTyCon, prodDataCon,
module VectBuiltIn (
Builtins(..), sumTyCon, prodTyCon, prodDataCon,
- selTy, selReplicate, selPick, selElements,
+ selTy, selReplicate, selPick, selTags, selElements,
combinePDVar, scalarZip, closureCtrFun,
initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
initBuiltinPAs, initBuiltinPRs,
combinePDVar, scalarZip, closureCtrFun,
initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
initBuiltinPAs, initBuiltinPRs,
@@
-111,6
+111,7
@@
data Builtins = Builtins {
, selTys :: Array Int Type
, selReplicates :: Array Int CoreExpr
, selPicks :: Array Int CoreExpr
, selTys :: Array Int Type
, selReplicates :: Array Int CoreExpr
, selPicks :: Array Int CoreExpr
+ , selTagss :: Array Int CoreExpr
, selEls :: Array (Int, Int) CoreExpr
, sumTyCons :: Array Int TyCon
, closureTyCon :: TyCon
, selEls :: Array (Int, Int) CoreExpr
, sumTyCons :: Array Int TyCon
, closureTyCon :: TyCon
@@
-125,6
+126,7
@@
data Builtins = Builtins {
, replicatePDVar :: Var
, emptyPDVar :: Var
, packPDVar :: Var
, replicatePDVar :: Var
, emptyPDVar :: Var
, packPDVar :: Var
+ , packByTagPDVar :: Var
, combinePDVars :: Array Int Var
, scalarClass :: Class
, scalarZips :: Array Int Var
, combinePDVars :: Array Int Var
, scalarClass :: Class
, scalarZips :: Array Int Var
@@
-149,6
+151,9
@@
selReplicate = indexBuiltin "selReplicate" selReplicates
selPick :: Int -> Builtins -> CoreExpr
selPick = indexBuiltin "selPick" selPicks
selPick :: Int -> Builtins -> CoreExpr
selPick = indexBuiltin "selPick" selPicks
+selTags :: Int -> Builtins -> CoreExpr
+selTags = indexBuiltin "selTags" selTagss
+
selElements :: Int -> Int -> Builtins -> CoreExpr
selElements i j = indexBuiltin "selElements" selEls (i,j)
selElements :: Int -> Int -> Builtins -> CoreExpr
selElements i j = indexBuiltin "selElements" selEls (i,j)
@@
-196,6
+201,8
@@
initBuiltins pkg
(numbered "replicate" 2 mAX_DPH_SUM)
sel_picks <- mapM (externalFun dph_Selector)
(numbered "pick" 2 mAX_DPH_SUM)
(numbered "replicate" 2 mAX_DPH_SUM)
sel_picks <- mapM (externalFun dph_Selector)
(numbered "pick" 2 mAX_DPH_SUM)
+ sel_tags <- mapM (externalFun dph_Selector)
+ (numbered "tagsSel" 2 mAX_DPH_SUM)
sel_els <- mapM mk_elements
[(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]]
sum_tcs <- mapM (externalTyCon dph_Repr)
sel_els <- mapM mk_elements
[(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]]
sum_tcs <- mapM (externalTyCon dph_Repr)
@@
-204,6
+211,7
@@
initBuiltins pkg
let selTys = listArray (2, mAX_DPH_SUM) sel_tys
selReplicates = listArray (2, mAX_DPH_SUM) sel_replicates
selPicks = listArray (2, mAX_DPH_SUM) sel_picks
let selTys = listArray (2, mAX_DPH_SUM) sel_tys
selReplicates = listArray (2, mAX_DPH_SUM) sel_replicates
selPicks = listArray (2, mAX_DPH_SUM) sel_picks
+ selTagss = listArray (2, mAX_DPH_SUM) sel_tags
selEls = array ((2,0), (mAX_DPH_SUM, mAX_DPH_SUM)) sel_els
sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs
selEls = array ((2,0), (mAX_DPH_SUM, mAX_DPH_SUM)) sel_els
sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs
@@
-218,6
+226,7
@@
initBuiltins pkg
replicatePDVar <- externalVar dph_PArray (fsLit "replicatePD")
emptyPDVar <- externalVar dph_PArray (fsLit "emptyPD")
packPDVar <- externalVar dph_PArray (fsLit "packPD")
replicatePDVar <- externalVar dph_PArray (fsLit "replicatePD")
emptyPDVar <- externalVar dph_PArray (fsLit "emptyPD")
packPDVar <- externalVar dph_PArray (fsLit "packPD")
+ packByTagPDVar <- externalVar dph_PArray (fsLit "packByTagPD")
combines <- mapM (externalVar dph_PArray)
[mkFastString ("combine" ++ show i ++ "PD")
combines <- mapM (externalVar dph_PArray)
[mkFastString ("combine" ++ show i ++ "PD")
@@
-253,6
+262,7
@@
initBuiltins pkg
, selTys = selTys
, selReplicates = selReplicates
, selPicks = selPicks
, selTys = selTys
, selReplicates = selReplicates
, selPicks = selPicks
+ , selTagss = selTagss
, selEls = selEls
, sumTyCons = sumTyCons
, closureTyCon = closureTyCon
, selEls = selEls
, sumTyCons = sumTyCons
, closureTyCon = closureTyCon
@@
-267,6
+277,7
@@
initBuiltins pkg
, replicatePDVar = replicatePDVar
, emptyPDVar = emptyPDVar
, packPDVar = packPDVar
, replicatePDVar = replicatePDVar
, emptyPDVar = emptyPDVar
, packPDVar = packPDVar
+ , packByTagPDVar = packByTagPDVar
, combinePDVars = combinePDVars
, scalarClass = scalarClass
, scalarZips = scalarZips
, combinePDVars = combinePDVars
, scalarClass = scalarClass
, scalarZips = scalarZips
diff --git
a/compiler/vectorise/VectMonad.hs
b/compiler/vectorise/VectMonad.hs
index
a8c84ac
..
98701f0
100644
(file)
--- a/
compiler/vectorise/VectMonad.hs
+++ b/
compiler/vectorise/VectMonad.hs
@@
-10,7
+10,7
@@
module VectMonad (
newExportedVar, newLocalVar, newLocalVars, newDummyVar, newTyVar,
Builtins(..), sumTyCon, prodTyCon, prodDataCon,
newExportedVar, newLocalVar, newLocalVars, newDummyVar, newTyVar,
Builtins(..), sumTyCon, prodTyCon, prodDataCon,
- selTy, selReplicate, selPick, selElements,
+ selTy, selReplicate, selPick, selTags, selElements,
combinePDVar, scalarZip, closureCtrFun,
builtin, builtins,
combinePDVar, scalarZip, closureCtrFun,
builtin, builtins,
diff --git
a/compiler/vectorise/VectUtils.hs
b/compiler/vectorise/VectUtils.hs
index
9ff5b5a
..
e508424
100644
(file)
--- a/
compiler/vectorise/VectUtils.hs
+++ b/
compiler/vectorise/VectUtils.hs
@@
-11,7
+11,7
@@
module VectUtils (
pdataReprTyCon, pdataReprDataCon, mkVScrut,
prDictOfType, prDFunOfTyCon,
paDictArgType, paDictOfType, paDFunType,
pdataReprTyCon, pdataReprDataCon, mkVScrut,
prDictOfType, prDFunOfTyCon,
paDictArgType, paDictOfType, paDFunType,
- paMethod, wrapPR, replicatePD, emptyPD, packPD,
+ paMethod, wrapPR, replicatePD, emptyPD, packPD, packByTagPD,
combinePD,
liftPD,
zipScalars, scalarClosure,
combinePD,
liftPD,
zipScalars, scalarClosure,
@@
-269,6
+269,12
@@
packPD :: Type -> CoreExpr -> CoreExpr -> CoreExpr -> VM CoreExpr
packPD ty xs len sel = liftM (`mkApps` [xs, len, sel])
(paMethod packPDVar "packPD" ty)
packPD ty xs len sel = liftM (`mkApps` [xs, len, sel])
(paMethod packPDVar "packPD" ty)
+packByTagPD :: Type -> CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr
+ -> VM CoreExpr
+packByTagPD ty xs len tags t
+ = liftM (`mkApps` [xs, len, tags, t])
+ (paMethod packByTagPDVar "packByTagPD" ty)
+
combinePD :: Type -> CoreExpr -> CoreExpr -> [CoreExpr]
-> VM CoreExpr
combinePD ty len sel xs
combinePD :: Type -> CoreExpr -> CoreExpr -> [CoreExpr]
-> VM CoreExpr
combinePD ty len sel xs
diff --git
a/compiler/vectorise/Vectorise.hs
b/compiler/vectorise/Vectorise.hs
index
36ee7b7
..
2bce391
100644
(file)
--- a/
compiler/vectorise/Vectorise.hs
+++ b/
compiler/vectorise/Vectorise.hs
@@
-27,6
+27,7
@@
import OccName
import Literal ( Literal, mkMachInt )
import TysWiredIn
import Literal ( Literal, mkMachInt )
import TysWiredIn
+import TysPrim ( intPrimTy )
import Outputable
import FastString
import Outputable
import FastString
@@
-447,9
+448,7
@@
vectAlgCase tycon _ty_args scrut bndr ty alts
tag = mkDataConTag vect_dc
fvs = freeVarsOf body `delVarSetList` bndrs
tag = mkDataConTag vect_dc
fvs = freeVarsOf body `delVarSetList` bndrs
- pick <- builtin (selPick arity)
- let flags_expr = mkApps pick [sel, tag]
- flags_var <- newLocalVar (fsLit "flags") (exprType flags_expr)
+ sel_tags <- liftM (`App` sel) (builtin (selTags arity))
lc <- builtin liftingContext
elems <- builtin (selElements arity ntag)
lc <- builtin liftingContext
elems <- builtin (selElements arity ntag)
@@
-457,15
+456,17
@@
vectAlgCase tycon _ty_args scrut bndr ty alts
<- vectBndrsIn bndrs
. localV
$ do
<- vectBndrsIn bndrs
. localV
$ do
- binds <- mapM (pack_var (Var lc) (Var flags_var))
+ binds <- mapM (pack_var (Var lc) sel_tags tag)
. filter isLocalId
$ varSetElems fvs
(ve, le) <- vectExpr body
. filter isLocalId
$ varSetElems fvs
(ve, le) <- vectExpr body
- empty <- emptyPD vty
return (ve, Case (elems `App` sel) lc lty
return (ve, Case (elems `App` sel) lc lty
- [(DEFAULT, [], Let (NonRec flags_var flags_expr)
- $ mkLets (concat binds) le),
- (LitAlt (mkMachInt 0), [], empty)])
+ [(DEFAULT, [], (mkLets (concat binds) le))])
+ -- empty <- emptyPD vty
+ -- return (ve, Case (elems `App` sel) lc lty
+ -- [(DEFAULT, [], Let (NonRec flags_var flags_expr)
+ -- $ mkLets (concat binds) le),
+ -- (LitAlt (mkMachInt 0), [], empty)])
let (vect_bndrs, lift_bndrs) = unzip vbndrs
return (vect_dc, vect_bndrs, lift_bndrs, vbody)
let (vect_bndrs, lift_bndrs) = unzip vbndrs
return (vect_dc, vect_bndrs, lift_bndrs, vbody)
@@
-473,14
+474,14
@@
vectAlgCase tycon _ty_args scrut bndr ty alts
mk_vect_alt vect_dc bndrs body = (DataAlt vect_dc, bndrs, body)
mk_vect_alt vect_dc bndrs body = (DataAlt vect_dc, bndrs, body)
- pack_var len flags v
+ pack_var len tags t v
= do
r <- lookupVar v
case r of
Local (vv, lv) ->
do
lv' <- cloneVar lv
= do
r <- lookupVar v
case r of
Local (vv, lv) ->
do
lv' <- cloneVar lv
- expr <- packPD (idType vv) (Var lv) len flags
+ expr <- packByTagPD (idType vv) (Var lv) len tags t
updLEnv (\env -> env { local_vars = extendVarEnv
(local_vars env) v (vv, lv') })
return [(NonRec lv' expr)]
updLEnv (\env -> env { local_vars = extendVarEnv
(local_vars env) v (vv, lv') })
return [(NonRec lv' expr)]