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
7834c4dc
Commit
7834c4dc
authored
Jul 31, 2007
by
rl@cse.unsw.edu.au
Browse files
Use a Var instead of a CoreExpr as the lifting context during vectorisation
parent
d23792e4
Changes
1
Hide whitespace changes
Inline
Side-by-side
compiler/vectorise/Vectorise.hs
View file @
7834c4dc
...
...
@@ -154,7 +154,7 @@ capply (vfn, lfn) (varg, larg)
fn_ty
=
exprType
vfn
(
arg_ty
,
res_ty
)
=
splitClosureTy
fn_ty
vectVar
::
CoreExp
r
->
Var
->
VM
(
CoreExpr
,
CoreExpr
)
vectVar
::
Va
r
->
Var
->
VM
(
CoreExpr
,
CoreExpr
)
vectVar
lc
v
=
do
r
<-
lookupVar
v
...
...
@@ -162,10 +162,10 @@ vectVar lc v
Local
(
vv
,
lv
)
->
return
(
Var
vv
,
Var
lv
)
Global
vv
->
do
let
vexpr
=
Var
vv
lexpr
<-
replicatePA
vexpr
lc
lexpr
<-
replicatePA
vexpr
(
Var
lc
)
return
(
vexpr
,
lexpr
)
vectPolyVar
::
CoreExp
r
->
Var
->
[
Type
]
->
VM
(
CoreExpr
,
CoreExpr
)
vectPolyVar
::
Va
r
->
Var
->
[
Type
]
->
VM
(
CoreExpr
,
CoreExpr
)
vectPolyVar
lc
v
tys
=
do
vtys
<-
mapM
vectType
tys
...
...
@@ -175,10 +175,10 @@ vectPolyVar lc v tys
(
polyApply
(
Var
lv
)
vtys
)
Global
poly
->
do
vexpr
<-
polyApply
(
Var
poly
)
vtys
lexpr
<-
replicatePA
vexpr
lc
lexpr
<-
replicatePA
vexpr
(
Var
lc
)
return
(
vexpr
,
lexpr
)
vectPolyExpr
::
CoreExp
r
->
CoreExprWithFVs
->
VM
(
CoreExpr
,
CoreExpr
)
vectPolyExpr
::
Va
r
->
CoreExprWithFVs
->
VM
(
CoreExpr
,
CoreExpr
)
vectPolyExpr
lc
expr
=
polyAbstract
tvs
$
\
mk_lams
->
-- FIXME: shadowing (tvs in lc)
...
...
@@ -188,18 +188,18 @@ vectPolyExpr lc expr
where
(
tvs
,
mono
)
=
collectAnnTypeBinders
expr
vectExpr
::
CoreExp
r
->
CoreExprWithFVs
->
VM
(
CoreExpr
,
CoreExpr
)
vectExpr
::
Va
r
->
CoreExprWithFVs
->
VM
(
CoreExpr
,
CoreExpr
)
vectExpr
lc
(
_
,
AnnType
ty
)
=
do
vty
<-
vectType
ty
return
(
Type
vty
,
Type
vty
)
vectExpr
lc
(
_
,
AnnVar
v
)
=
vectVar
lc
v
vectExpr
lc
(
_
,
AnnVar
v
)
=
vectVar
lc
v
vectExpr
lc
(
_
,
AnnLit
lit
)
=
do
let
vexpr
=
Lit
lit
lexpr
<-
replicatePA
vexpr
lc
lexpr
<-
replicatePA
vexpr
(
Var
lc
)
return
(
vexpr
,
lexpr
)
vectExpr
lc
(
_
,
AnnNote
note
expr
)
...
...
@@ -254,7 +254,7 @@ vectExpr lc (fvs, AnnLam bndr body)
vfn_var
<-
hoistExpr
FSLIT
(
"vfn"
)
poly_vfn
lfn_var
<-
hoistExpr
FSLIT
(
"lfn"
)
poly_lfn
let
(
venv
,
lenv
)
=
mkClosureEnvs
info
lc
let
(
venv
,
lenv
)
=
mkClosureEnvs
info
(
Var
lc
)
let
env_ty
=
cenv_vty
info
...
...
@@ -359,7 +359,7 @@ mkClosureMonoFns info arg body
lc_bndr
<-
newLocalVar
FSLIT
(
"lc"
)
intPrimTy
(
varg
:
vbndrs
,
larg
:
lbndrs
,
(
vbody
,
lbody
))
<-
vectBndrsIn
(
arg
:
cenv_vars
info
)
(
vectExpr
(
Var
lc_bndr
)
body
)
(
vectExpr
lc_bndr
body
)
venv_bndr
<-
newLocalVar
FSLIT
(
"env"
)
vty
lenv_bndr
<-
newLocalVar
FSLIT
(
"env"
)
lty
...
...
@@ -401,7 +401,7 @@ mkClosureMonoFns info arg body
(
exprType
lbody
)
[(
DataAlt
(
cenv_repr_datacon
info
),
lc_bndr
:
lbndrs'
,
lbody
)]
vectTyAppExpr
::
CoreExp
r
->
CoreExprWithFVs
->
[
Type
]
->
VM
(
CoreExpr
,
CoreExpr
)
vectTyAppExpr
::
Va
r
->
CoreExprWithFVs
->
[
Type
]
->
VM
(
CoreExpr
,
CoreExpr
)
vectTyAppExpr
lc
(
_
,
AnnVar
v
)
tys
=
vectPolyVar
lc
v
tys
vectTyAppExpr
lc
e
tys
=
pprPanic
"vectTyAppExpr"
(
ppr
$
deAnnotate
e
)
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