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
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 ->