Utility functions for vectorisation
[ghc-hetmet.git] / compiler / vectorise / VectType.hs
index e28b66f..e528aae 100644 (file)
@@ -191,25 +191,6 @@ mk_fam_inst :: TyCon -> TyCon -> (TyCon, [Type])
 mk_fam_inst fam_tc arg_tc
   = (fam_tc, [mkTyConApp arg_tc . mkTyVarTys $ tyConTyVars arg_tc])
 
-mkSumOfProdRepr :: [[Type]] -> VM Type
-mkSumOfProdRepr [] = panic "mkSumOfProdRepr"
-mkSumOfProdRepr tys
-  = do
-      embed <- builtin embedTyCon
-      plus  <- builtin plusTyCon
-      cross <- builtin crossTyCon
-
-      return . foldr1 (mk_bin plus)
-             . map (mkprod cross)
-             . map (map (mk_un embed))
-             $ tys
-  where
-    mkprod cross []  = unitTy
-    mkprod cross tys = foldr1 (mk_bin cross) tys
-
-    mk_un  tc ty      = mkTyConApp tc [ty]
-    mk_bin tc ty1 ty2 = mkTyConApp tc [ty1,ty2]
-
 buildPReprTyCon :: TyCon -> TyCon -> VM TyCon
 buildPReprTyCon orig_tc vect_tc
   = do
@@ -224,7 +205,12 @@ buildPReprTyCon orig_tc vect_tc
     tyvars = tyConTyVars vect_tc
 
 buildPReprRhsTy :: TyCon -> VM Type
-buildPReprRhsTy = mkSumOfProdRepr . map dataConRepArgTys . tyConDataCons
+buildPReprRhsTy = buildPReprTy . map dataConRepArgTys . tyConDataCons
+
+buildPReprTy :: [[Type]] -> VM Type
+buildPReprTy tys = mkPlusTypes unitTy
+               =<< mapM (mkCrossTypes unitTy)
+               =<< mapM (mapM mkEmbedType) tys
 
 buildPArrayTyCon :: TyCon -> TyCon -> VM TyCon
 buildPArrayTyCon orig_tc vect_tc = fixV $ \repr_tc ->