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

Generate lots of __inline_me during vectorisation

parent 7a4a8360
......@@ -8,12 +8,13 @@ module VectCore (
vVar, vType, vNote, vLet,
vLams, vLamsWithoutLC, vVarApps,
vCaseDEFAULT, vCaseProd
vCaseDEFAULT, vCaseProd, vInlineMe
) where
#include "HsVersions.h"
import CoreSyn
import CoreUtils ( mkInlineMe )
import MkCore ( mkWildCase )
import CoreUtils ( exprType )
import DataCon ( DataCon )
......@@ -90,3 +91,7 @@ vCaseProd (vscrut, lscrut) vty lty vdc ldc sh_bndrs bndrs
[(DataAlt ldc, sh_bndrs ++ lbndrs, lbody)])
where
(vbndrs, lbndrs) = unzip bndrs
vInlineMe :: VExpr -> VExpr
vInlineMe (vexpr, lexpr) = (mkInlineMe vexpr, mkInlineMe lexpr)
......@@ -394,12 +394,13 @@ buildClosures :: [TyVar] -> [VVar] -> [Type] -> Type -> VM VExpr -> VM VExpr
buildClosures _ _ [] _ mk_body
= mk_body
buildClosures tvs vars [arg_ty] res_ty mk_body
= buildClosure tvs vars arg_ty res_ty mk_body
= liftM vInlineMe (buildClosure tvs vars arg_ty res_ty mk_body)
buildClosures tvs vars (arg_ty : arg_tys) res_ty mk_body
= do
res_ty' <- mkClosureTypes arg_tys res_ty
arg <- newLocalVVar (fsLit "x") arg_ty
buildClosure tvs vars arg_ty res_ty'
liftM vInlineMe
. buildClosure tvs vars arg_ty res_ty'
. hoistPolyVExpr tvs
$ do
lc <- builtin liftingContext
......@@ -424,7 +425,7 @@ buildClosure tvs vars arg_ty res_ty mk_body
body <- mk_body
body' <- bind (vVar env_bndr)
(vVarApps lc body (vars ++ [arg_bndr]))
return (vLamsWithoutLC [env_bndr, arg_bndr] body')
return . vInlineMe $ vLamsWithoutLC [env_bndr, arg_bndr] body'
mkClosure arg_ty res_ty env_ty fn env
......
......@@ -193,7 +193,7 @@ vectPolyExpr (_, AnnNote note expr)
vectPolyExpr expr
= polyAbstract tvs $ \abstract ->
do
mono' <- vectExpr mono
mono' <- vectFnExpr False mono
return $ mapVect abstract mono'
where
(tvs, mono) = collectAnnTypeBinders expr
......@@ -263,14 +263,26 @@ vectExpr (_, AnnLet (AnnRec bs) body)
. inBind bndr
$ vectExpr rhs
vectExpr e@(fvs, AnnLam bndr _)
| isId bndr = onlyIfV (isEmptyVarSet fvs) (vectScalarLam bs $ deAnnotate body)
`orElseV` vectLam fvs bs body
vectExpr e@(_, AnnLam bndr _)
| isId bndr = vectFnExpr True e
{-
onlyIfV (isEmptyVarSet fvs) (vectScalarLam bs $ deAnnotate body)
`orElseV` vectLam True fvs bs body
where
(bs,body) = collectAnnValBinders e
-}
vectExpr e = cantVectorise "Can't vectorise expression" (ppr $ deAnnotate e)
vectFnExpr :: Bool -> CoreExprWithFVs -> VM VExpr
vectFnExpr inline e@(fvs, AnnLam bndr _)
| isId bndr = onlyIfV (isEmptyVarSet fvs) (vectScalarLam bs $ deAnnotate body)
`orElseV` vectLam inline fvs bs body
where
(bs,body) = collectAnnValBinders e
vectFnExpr _ e = vectExpr e
vectScalarLam :: [Var] -> CoreExpr -> VM VExpr
vectScalarLam args body
= do
......@@ -302,8 +314,8 @@ vectScalarLam args body
is_scalar vs (App e1 e2) = is_scalar vs e1 && is_scalar vs e2
is_scalar _ _ = False
vectLam :: VarSet -> [Var] -> CoreExprWithFVs -> VM VExpr
vectLam fvs bs body
vectLam :: Bool -> VarSet -> [Var] -> CoreExprWithFVs -> VM VExpr
vectLam inline fvs bs body
= do
tyvars <- localTyVars
(vs, vvs) <- readLEnv $ \env ->
......@@ -319,7 +331,9 @@ vectLam fvs bs body
lc <- builtin liftingContext
(vbndrs, vbody) <- vectBndrsIn (vs ++ bs)
(vectExpr body)
return $ vLams lc vbndrs vbody
return . maybe_inline $ vLams lc vbndrs vbody
where
maybe_inline = if inline then vInlineMe else id
vectTyAppExpr :: CoreExprWithFVs -> [Type] -> VM VExpr
vectTyAppExpr (_, AnnVar v) tys = vectPolyVar v tys
......
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