X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fvectorise%2FVectorise.hs;h=70e69b7e90a0386742baad289a214ccee71ad962;hp=3b6cd8396fc5bb4e2008ed5a9f040d47f846488c;hb=cc67e20f5c6355919b54f82c2620515fa28269a8;hpb=85514ae1d86203212930c4953ae608b53aa9f452 diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs index 3b6cd83..70e69b7 100644 --- a/compiler/vectorise/Vectorise.hs +++ b/compiler/vectorise/Vectorise.hs @@ -8,7 +8,7 @@ import VectType import VectCore import DynFlags -import HscTypes +import HscTypes hiding ( MonadThings(..) ) import Module ( dphSeqPackageId, dphParPackageId ) import CoreLint ( showPass, endPass ) @@ -250,9 +250,6 @@ vectExpr (_, AnnCase scrut bndr ty alts) where scrut_ty = exprType (deAnnotate scrut) -vectExpr (_, AnnCase _ _ _ _) - = panic "vectExpr: case" - vectExpr (_, AnnLet (AnnNonRec bndr rhs) body) = do vrhs <- localV . inBind bndr $ vectPolyExpr rhs @@ -274,12 +271,11 @@ vectExpr (_, AnnLet (AnnRec bs) body) $ vectExpr rhs vectExpr e@(fvs, AnnLam bndr _) - | not (isId bndr) = pprPanic "vectExpr" (ppr $ deAnnotate e) - | otherwise = vectLam fvs bs body + | isId bndr = vectLam fvs bs body where (bs,body) = collectAnnValBinders e -vectExpr e = pprPanic "vectExpr" (ppr $ deAnnotate e) +vectExpr e = traceNoV "vectExpr: can't vectorise" (ppr $ deAnnotate e) vectLam :: VarSet -> [Var] -> CoreExprWithFVs -> VM VExpr vectLam fvs bs body @@ -302,7 +298,7 @@ vectLam fvs bs body vectTyAppExpr :: CoreExprWithFVs -> [Type] -> VM VExpr vectTyAppExpr (_, AnnVar v) tys = vectPolyVar v tys -vectTyAppExpr e _ = pprPanic "vectTyAppExpr" (ppr $ deAnnotate e) +vectTyAppExpr e _ = traceNoV "vectTyAppExpr: can't vectorise" (ppr $ deAnnotate e) -- We convert -- @@ -374,11 +370,13 @@ vectAlgCase tycon _ty_args scrut bndr ty alts let (vect_scrut, lift_scrut) = vscrut (vect_bodies, lift_bodies) = unzip vbodies - let vect_case = Case vect_scrut (mkWildId (exprType vect_scrut)) vty + vdummy <- newDummyVar (exprType vect_scrut) + ldummy <- newDummyVar (exprType lift_scrut) + let vect_case = Case vect_scrut vdummy vty (zipWith3 mk_vect_alt vect_dcs vect_bndrss vect_bodies) lbody <- combinePA vty len sel indices lift_bodies - let lift_case = Case lift_scrut (mkWildId (exprType lift_scrut)) lty + let lift_case = Case lift_scrut ldummy lty [(DataAlt arr_dc, shape_bndrs ++ concat lift_bndrss, lbody)]