X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fvectorise%2FVectUtils.hs;h=46766ea8d13062a2b1fa259cc2780904398eb45b;hp=eec57d7538ff16af914726225d10723d7991d990;hb=f363bf9a76bcaddc1bfea61135f4f4d2fbcfd955;hpb=5eec4625961ca9064216f0161288e0d46628c10f

diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs
index eec57d7..46766ea 100644
--- 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