X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectorise.hs;h=80c896c6cd77a3f4d15bcd697a69afecb1bc6c57;hb=0873e46c2f20a6a168bca71a14d48613b22c94da;hp=d85ef6ab4f751682c714cda5aed6ac8df390acc8;hpb=772810755a8519db4585f54a27dbbdd8b9127419;p=ghc-hetmet.git diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs index d85ef6a..80c896c 100644 --- a/compiler/vectorise/Vectorise.hs +++ b/compiler/vectorise/Vectorise.hs @@ -243,6 +243,17 @@ vectExpr e@(_, AnnApp _ arg) where (fn, tys) = collectAnnTypeArgs e +vectExpr (_, AnnApp (_, AnnVar v) (_, AnnLit lit)) + | Just con <- isDataConId_maybe v + , is_special_con con + = do + let vexpr = App (Var v) (Lit lit) + lexpr <- liftPA vexpr + return (vexpr, lexpr) + where + is_special_con con = con `elem` [intDataCon, floatDataCon, doubleDataCon] + + vectExpr (_, AnnApp fn arg) = do arg_ty' <- vectType arg_ty @@ -337,6 +348,14 @@ vectAlgCase tycon ty_args scrut bndr ty [(DEFAULT, [], body)] (vbndr, vbody) <- vectBndrIn bndr (vectExpr body) return $ vCaseDEFAULT vscrut vbndr vty lty vbody +vectAlgCase tycon ty_args scrut bndr ty [(DataAlt dc, [], body)] + = do + vscrut <- vectExpr scrut + vty <- vectType ty + lty <- mkPArrayType vty + (vbndr, vbody) <- vectBndrIn bndr (vectExpr body) + return $ vCaseDEFAULT vscrut vbndr vty lty vbody + vectAlgCase tycon ty_args scrut bndr ty [(DataAlt dc, bndrs, body)] = do vect_tc <- maybeV (lookupTyCon tycon)