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

Fix bugs in vectorisation of case expressions

parent 8b3bfd6c
...@@ -1022,7 +1022,7 @@ fromVect (FunTy arg_ty res_ty) expr ...@@ -1022,7 +1022,7 @@ fromVect (FunTy arg_ty res_ty) expr
vres_ty <- vectType res_ty vres_ty <- vectType res_ty
apply <- builtin applyClosureVar apply <- builtin applyClosureVar
body <- fromVect res_ty body <- fromVect res_ty
$ Var apply `mkTyApps` [arg_ty, res_ty] `mkApps` [expr, Var arg] $ Var apply `mkTyApps` [varg_ty, vres_ty] `mkApps` [expr, varg]
return $ Lam arg body return $ Lam arg body
fromVect ty expr fromVect ty expr
= identityConv ty >> return expr = identityConv ty >> return expr
......
...@@ -259,7 +259,7 @@ emptyPA :: Type -> VM CoreExpr ...@@ -259,7 +259,7 @@ emptyPA :: Type -> VM CoreExpr
emptyPA = paMethod pa_empty emptyPA = paMethod pa_empty
packPA :: Type -> CoreExpr -> CoreExpr -> CoreExpr -> VM CoreExpr packPA :: Type -> CoreExpr -> CoreExpr -> CoreExpr -> VM CoreExpr
packPA ty xs len sel = liftM (`mkApps` [len, sel]) packPA ty xs len sel = liftM (`mkApps` [xs, len, sel])
(paMethod pa_pack ty) (paMethod pa_pack ty)
combinePA :: Type -> CoreExpr -> CoreExpr -> CoreExpr -> [CoreExpr] combinePA :: Type -> CoreExpr -> CoreExpr -> CoreExpr -> [CoreExpr]
......
...@@ -446,6 +446,7 @@ packLiftingContext len shape tag fvs res_ty p ...@@ -446,6 +446,7 @@ packLiftingContext len shape tag fvs res_ty p
$ varSetElems fvs $ varSetElems fvs
(vexpr, lexpr) <- p (vexpr, lexpr) <- p
return (vexpr, Let (NonRec sel_var sel_expr) return (vexpr, Let (NonRec sel_var sel_expr)
. mkLets (concat bnds)
$ Case len lc_var res_ty [(DEFAULT, [], lexpr)]) $ Case len lc_var res_ty [(DEFAULT, [], lexpr)])
packFreeVar :: CoreExpr -> CoreExpr -> Var -> VM [CoreBind] packFreeVar :: CoreExpr -> CoreExpr -> Var -> VM [CoreBind]
......
Markdown is supported
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