X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectorise.hs;h=8d8bfef119bfeb9c4e4392f92f147956911ea09c;hb=9c966bfa8c0328cb4d2e01806a8eca242b9e6f66;hp=1c8e19ca5d4c2db8761ec901f82847fd5aa55460;hpb=5ac946878d18294ff30e3d9cf152c678c667e37b;p=ghc-hetmet.git

diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs
index 1c8e19c..8d8bfef 100644
--- a/compiler/vectorise/Vectorise.hs
+++ b/compiler/vectorise/Vectorise.hs
@@ -53,6 +53,7 @@ vectorise backend hsc_env _ _ guts
 
     backendPackage DPHSeq  = dphSeqPackageId
     backendPackage DPHPar  = dphParPackageId
+    backendPackage DPHThis = thisPackage dflags
 
 vectModule :: ModGuts -> VM ModGuts
 vectModule guts
@@ -275,7 +276,7 @@ vectExpr e@(fvs, AnnLam bndr _)
   where
     (bs,body) = collectAnnValBinders e
 
-vectExpr e = traceNoV "vectExpr: can't vectorise" (ppr $ deAnnotate e)
+vectExpr e = cantVectorise "Can't vectorise expression" (ppr $ deAnnotate e)
 
 vectLam :: VarSet -> [Var] -> CoreExprWithFVs -> VM VExpr
 vectLam fvs bs body
@@ -298,7 +299,8 @@ vectLam fvs bs body
 
 vectTyAppExpr :: CoreExprWithFVs -> [Type] -> VM VExpr
 vectTyAppExpr (_, AnnVar v) tys = vectPolyVar v tys
-vectTyAppExpr e _ = traceNoV "vectTyAppExpr: can't vectorise" (ppr $ deAnnotate e)
+vectTyAppExpr e tys = cantVectorise "Can't vectorise expression"
+                        (ppr $ deAnnotate e `mkTyApps` tys)
 
 -- We convert
 --
@@ -370,11 +372,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)]