module Vectorise.Type.PRDict (buildPRDict) where import Vectorise.Utils import Vectorise.Monad import Vectorise.Builtins import Vectorise.Type.Repr import CoreSyn import CoreUtils import TyCon import Type import Coercion buildPRDict :: TyCon -> TyCon -> TyCon -> SumRepr -> VM CoreExpr buildPRDict vect_tc prepr_tc _ r = do dict <- sum_dict r pr_co <- mkBuiltinCo prTyCon let co = mkAppCoercion pr_co . mkSymCoercion $ mkTyConApp arg_co ty_args return (mkCoerce co dict) where ty_args = mkTyVarTys (tyConTyVars vect_tc) Just arg_co = tyConFamilyCoercion_maybe prepr_tc sum_dict EmptySum = prDFunOfTyCon =<< builtin voidTyCon sum_dict (UnarySum r) = con_dict r sum_dict (Sum { repr_sum_tc = sum_tc , repr_con_tys = tys , repr_cons = cons }) = do dicts <- mapM con_dict cons dfun <- prDFunOfTyCon sum_tc return $ dfun `mkTyApps` tys `mkApps` dicts con_dict (ConRepr _ r) = prod_dict r prod_dict EmptyProd = prDFunOfTyCon =<< builtin voidTyCon prod_dict (UnaryProd r) = comp_dict r prod_dict (Prod { repr_tup_tc = tup_tc , repr_comp_tys = tys , repr_comps = comps }) = do dicts <- mapM comp_dict comps dfun <- prDFunOfTyCon tup_tc return $ dfun `mkTyApps` tys `mkApps` dicts comp_dict (Keep _ pr) = return pr comp_dict (Wrap ty) = wrapPR ty