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:
d322953
)
Fix vectorisation of binders in case expressions
author
Roman Leshchinskiy
<rl@cse.unsw.edu.au>
Fri, 16 Nov 2007 02:18:33 +0000
(
02:18
+0000)
committer
Roman Leshchinskiy
<rl@cse.unsw.edu.au>
Fri, 16 Nov 2007 02:18:33 +0000
(
02:18
+0000)
compiler/vectorise/Vectorise.hs
patch
|
blob
|
history
diff --git
a/compiler/vectorise/Vectorise.hs
b/compiler/vectorise/Vectorise.hs
index
d4b970f
..
c1d4e19
100644
(file)
--- a/
compiler/vectorise/Vectorise.hs
+++ b/
compiler/vectorise/Vectorise.hs
@@
-133,6
+133,16
@@
vectBndr v
where
mapTo vv lv env = env { local_vars = extendVarEnv (local_vars env) v (vv, lv) }
where
mapTo vv lv env = env { local_vars = extendVarEnv (local_vars env) v (vv, lv) }
+vectBndrNew :: Var -> FastString -> VM VVar
+vectBndrNew v fs
+ = do
+ vty <- vectType (idType v)
+ vv <- newLocalVVar fs vty
+ updLEnv (upd vv)
+ return vv
+ where
+ upd vv env = env { local_vars = extendVarEnv (local_vars env) v vv }
+
vectBndrIn :: Var -> VM a -> VM (VVar, a)
vectBndrIn v p
= localV
vectBndrIn :: Var -> VM a -> VM (VVar, a)
vectBndrIn v p
= localV
@@
-141,6
+151,14
@@
vectBndrIn v p
x <- p
return (vv, x)
x <- p
return (vv, x)
+vectBndrNewIn :: Var -> FastString -> VM a -> VM (VVar, a)
+vectBndrNewIn v fs p
+ = localV
+ $ do
+ vv <- vectBndrNew v fs
+ x <- p
+ return (vv, x)
+
vectBndrIn' :: Var -> (VVar -> VM a) -> VM (VVar, a)
vectBndrIn' v p
= localV
vectBndrIn' :: Var -> (VVar -> VM a) -> VM (VVar, a)
vectBndrIn' v p
= localV
@@
-292,11
+310,12
@@
type CoreAltWithFVs = AnnAlt Id VarSet
--
-- to
--
--
-- to
--
--- V: let v = e in case v of _ { ... }
--- L: let v = e in case v `cast` ... of _ { ... }
+-- V: let v' = e in case v' of _ { ... }
+-- L: let v' = e in case v' `cast` ... of _ { ... }
--
-- When lifting, we have to do it this way because v must have the type
--
-- When lifting, we have to do it this way because v must have the type
--- [:V(T):] but the scrutinee must be cast to the representation type.
+-- [:V(T):] but the scrutinee must be cast to the representation type. We also
+-- have to handle the case where v is a wild var correctly.
--
-- FIXME: this is too lazy
--
-- FIXME: this is too lazy
@@
-313,7
+332,7
@@
vectAlgCase scrut bndr ty [(DataAlt dc, bndrs, body)]
vty <- vectType ty
lty <- mkPArrayType vty
vexpr <- vectExpr scrut
vty <- vectType ty
lty <- mkPArrayType vty
vexpr <- vectExpr scrut
- (vbndr, (vbndrs, vbody)) <- vectBndrIn bndr
+ (vbndr, (vbndrs, vbody)) <- vect_scrut_bndr
. vectBndrsIn bndrs
$ vectExpr body
. vectBndrsIn bndrs
$ vectExpr body
@@
-325,3
+344,7
@@
vectAlgCase scrut bndr ty [(DataAlt dc, bndrs, body)]
shape_bndrs <- mapM (newLocalVar FSLIT("s")) shape_tys
return . vLet (vNonRec vbndr vexpr)
$ vCaseProd vscrut vty lty vect_dc arr_dc shape_bndrs vbndrs vbody
shape_bndrs <- mapM (newLocalVar FSLIT("s")) shape_tys
return . vLet (vNonRec vbndr vexpr)
$ vCaseProd vscrut vty lty vect_dc arr_dc shape_bndrs vbndrs vbody
+ where
+ vect_scrut_bndr | isDeadBinder bndr = vectBndrNewIn bndr FSLIT("scrut")
+ | otherwise = vectBndrIn bndr
+