Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
cfccfa67
Commit
cfccfa67
authored
Oct 30, 2009
by
rl@cse.unsw.edu.au
Browse files
Use packByTag instead of pack in the vectoriser
parent
72462499
Changes
4
Hide whitespace changes
Inline
Side-by-side
compiler/vectorise/VectBuiltIn.hs
View file @
cfccfa67
module
VectBuiltIn
(
Builtins
(
..
),
sumTyCon
,
prodTyCon
,
prodDataCon
,
selTy
,
selReplicate
,
selPick
,
selElements
,
selTy
,
selReplicate
,
selPick
,
selTags
,
selElements
,
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
,
selTagss
::
Array
Int
CoreExpr
,
selEls
::
Array
(
Int
,
Int
)
CoreExpr
,
sumTyCons
::
Array
Int
TyCon
,
closureTyCon
::
TyCon
...
...
@@ -125,6 +126,7 @@ data Builtins = Builtins {
,
replicatePDVar
::
Var
,
emptyPDVar
::
Var
,
packPDVar
::
Var
,
packByTagPDVar
::
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
selTags
::
Int
->
Builtins
->
CoreExpr
selTags
=
indexBuiltin
"selTags"
selTagss
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
)
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
)
...
...
@@ -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
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
...
...
@@ -218,6 +226,7 @@ initBuiltins pkg
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"
)
...
...
@@ -253,6 +262,7 @@ initBuiltins pkg
,
selTys
=
selTys
,
selReplicates
=
selReplicates
,
selPicks
=
selPicks
,
selTagss
=
selTagss
,
selEls
=
selEls
,
sumTyCons
=
sumTyCons
,
closureTyCon
=
closureTyCon
...
...
@@ -267,6 +277,7 @@ initBuiltins pkg
,
replicatePDVar
=
replicatePDVar
,
emptyPDVar
=
emptyPDVar
,
packPDVar
=
packPDVar
,
packByTagPDVar
=
packByTagPDVar
,
combinePDVars
=
combinePDVars
,
scalarClass
=
scalarClass
,
scalarZips
=
scalarZips
...
...
compiler/vectorise/VectMonad.hs
View file @
cfccfa67
...
...
@@ -10,7 +10,7 @@ module VectMonad (
newExportedVar
,
newLocalVar
,
newLocalVars
,
newDummyVar
,
newTyVar
,
Builtins
(
..
),
sumTyCon
,
prodTyCon
,
prodDataCon
,
selTy
,
selReplicate
,
selPick
,
selElements
,
selTy
,
selReplicate
,
selPick
,
selTags
,
selElements
,
combinePDVar
,
scalarZip
,
closureCtrFun
,
builtin
,
builtins
,
...
...
compiler/vectorise/VectUtils.hs
View file @
cfccfa67
...
...
@@ -11,7 +11,7 @@ module VectUtils (
pdataReprTyCon
,
pdataReprDataCon
,
mkVScrut
,
prDictOfType
,
prDFunOfTyCon
,
paDictArgType
,
paDictOfType
,
paDFunType
,
paMethod
,
wrapPR
,
replicatePD
,
emptyPD
,
packPD
,
paMethod
,
wrapPR
,
replicatePD
,
emptyPD
,
packPD
,
packByTagPD
,
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
)
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
...
...
compiler/vectorise/Vectorise.hs
View file @
cfccfa67
...
...
@@ -27,6 +27,7 @@ import OccName
import
Literal
(
Literal
,
mkMachInt
)
import
TysWiredIn
import
TysPrim
(
intPrimTy
)
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
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
)
...
...
@@ -457,15 +456,17 @@ vectAlgCase tycon _ty_args scrut bndr ty alts
<-
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
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
)])
[(
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
)
...
...
@@ -473,14 +474,14 @@ vectAlgCase tycon _ty_args scrut bndr ty alts
mk_vect_alt
vect_dc
bndrs
body
=
(
DataAlt
vect_dc
,
bndrs
,
body
)
pack_var
len
fl
ags
v
pack_var
len
t
ags
t
v
=
do
r
<-
lookupVar
v
case
r
of
Local
(
vv
,
lv
)
->
do
lv'
<-
cloneVar
lv
expr
<-
packPD
(
idType
vv
)
(
Var
lv
)
len
fl
ags
expr
<-
pack
ByTag
PD
(
idType
vv
)
(
Var
lv
)
len
t
ags
t
updLEnv
(
\
env
->
env
{
local_vars
=
extendVarEnv
(
local_vars
env
)
v
(
vv
,
lv'
)
})
return
[(
NonRec
lv'
expr
)]
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment