Vectorise Case on products

[ghc-hetmet.git] / compiler / vectorise / VectUtils.hs

diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs
index eec57d7..46766ea 100644 (file)
--- a/compiler/vectorise/VectUtils.hs
+++ b/compiler/vectorise/VectUtils.hs
@@ -4,7 +4,7 @@ module VectUtils (
   mkDataConTag,
   splitClosureTy,
   mkPADictType, mkPArrayType,
-  parrayReprTyCon, parrayReprDataCon,
+  parrayReprTyCon, parrayReprDataCon, mkVScrut,
   paDictArgType, paDictOfType, paDFunType,
   paMethod, lengthPA, replicatePA, emptyPA, liftPA,
   polyAbstract, polyApply, polyVApply,
@@ -120,6 +120,12 @@ parrayReprDataCon ty
       let [dc] = tyConDataCons tc
       return (dc, arg_tys)
 
+mkVScrut :: VExpr -> VM (VExpr, TyCon, [Type])
+mkVScrut (ve, le)
+  = do
+      (tc, arg_tys) <- parrayReprTyCon (exprType ve)
+      return ((ve, unwrapFamInstScrut tc arg_tys le), tc, arg_tys)
+
 paDictArgType :: TyVar -> VM (Maybe Type)
 paDictArgType tv = go (TyVarTy tv) (tyVarKind tv)
   where