X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectUtils.hs;h=533a8e769409987e37ee088e1d5642c0df1ffc43;hb=19b44dcc5e5b9f92735fa99aa45dfaa94777177c;hp=a540b4d10c20102fa5c609d376e032ce696cb45d;hpb=7c737416e30137e7053b4bcd0fdd563f07fa43b0;p=ghc-hetmet.git diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs index a540b4d..533a8e7 100644 --- a/compiler/vectorise/VectUtils.hs +++ b/compiler/vectorise/VectUtils.hs @@ -259,7 +259,7 @@ emptyPA :: Type -> VM CoreExpr emptyPA = paMethod pa_empty 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) combinePA :: Type -> CoreExpr -> CoreExpr -> CoreExpr -> [CoreExpr] @@ -451,11 +451,16 @@ mkLiftEnv lc [ty] [v] mkLiftEnv lc tys vs = do (env_tc, env_tyargs) <- parrayReprTyCon vty + + bndrs <- if null vs then do + v <- newDummyVar unitTy + return [v] + else return vs let [env_con] = tyConDataCons env_tc env = Var (dataConWrapId env_con) `mkTyApps` env_tyargs - `mkVarApps` (lc : vs) + `mkApps` (Var lc : args) bind env body = let scrut = unwrapFamInstScrut env_tc env_tyargs env in @@ -466,6 +471,6 @@ mkLiftEnv lc tys vs where vty = mkCoreTupTy tys - bndrs | null vs = [mkWildId unitTy] - | otherwise = vs + args | null vs = [Var unitDataConId] + | otherwise = map Var vs