+buildPReprType :: TyCon -> VM Type
+buildPReprType = mkPRepr . map dataConRepArgTys . tyConDataCons
+
+buildToPRepr :: Shape -> TyCon -> TyCon -> TyCon -> VM CoreExpr
+buildToPRepr _ vect_tc prepr_tc _
+ = do
+ arg <- newLocalVar FSLIT("x") arg_ty
+ bndrss <- mapM (mapM (newLocalVar FSLIT("x"))) rep_tys
+ (alt_bodies, res_ty) <- mkToPRepr $ map (map Var) bndrss
+
+ return . Lam arg
+ . wrapFamInstBody prepr_tc var_tys
+ . Case (Var arg) (mkWildId arg_ty) res_ty
+ $ zipWith3 mk_alt data_cons bndrss alt_bodies
+ where
+ var_tys = mkTyVarTys $ tyConTyVars vect_tc
+ arg_ty = mkTyConApp vect_tc var_tys
+ data_cons = tyConDataCons vect_tc
+ rep_tys = map dataConRepArgTys data_cons
+
+ mk_alt data_con bndrs body = (DataAlt data_con, bndrs, body)
+
+buildFromPRepr :: Shape -> TyCon -> TyCon -> TyCon -> VM CoreExpr
+buildFromPRepr _ vect_tc prepr_tc _
+ = do
+ arg_ty <- mkPReprType res_ty
+ arg <- newLocalVar FSLIT("x") arg_ty
+ alts <- mapM mk_alt data_cons
+ body <- mkFromPRepr (unwrapFamInstScrut prepr_tc var_tys (Var arg))
+ res_ty alts
+ return $ Lam arg body
+ where
+ var_tys = mkTyVarTys $ tyConTyVars vect_tc
+ res_ty = mkTyConApp vect_tc var_tys
+ data_cons = tyConDataCons vect_tc
+
+ mk_alt dc = do
+ bndrs <- mapM (newLocalVar FSLIT("x")) $ dataConRepArgTys dc
+ return (bndrs, mkConApp dc (map Type var_tys ++ map Var bndrs))
+
+buildPRDict :: Shape -> TyCon -> TyCon -> TyCon -> VM CoreExpr
+buildPRDict _ vect_tc prepr_tc _
+ = prCoerce prepr_tc var_tys
+ =<< prDictOfType (mkTyConApp prepr_tc var_tys)
+ where
+ var_tys = mkTyVarTys $ tyConTyVars vect_tc