+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
+ name <- cloneName mkPReprTyConOcc (tyConName orig_tc)
+ rhs_ty <- buildPReprRhsTy vect_tc
+ repr_tc <- builtin reprTyCon
+ liftDs $ buildSynTyCon name
+ tyvars
+ (SynonymTyCon rhs_ty)
+ (Just $ mk_fam_inst repr_tc vect_tc)
+ where
+ tyvars = tyConTyVars vect_tc
+
+buildPReprRhsTy :: TyCon -> VM Type
+buildPReprRhsTy = mkSumOfProdRepr . map dataConRepArgTys . tyConDataCons
+