+mkToArrPRepr :: CoreExpr -> CoreExpr -> [[CoreExpr]] -> VM CoreExpr
+mkToArrPRepr len sel ess
+ = do
+ embed_tc <- builtin embedTyCon
+ (embed_rtc, _) <- parrayReprTyCon (mkTyConApp embed_tc [unitTy])
+ let [embed_rdc] = tyConDataCons embed_rtc
+
+ let mk_sum [(expr, ty)] = return (expr, ty)
+ mk_sum es
+ = do
+ sum_tc <- builtin . sumTyCon $ length es
+ (sum_rtc, _) <- parrayReprTyCon (mkTyConApp sum_tc tys)
+ let [sum_rdc] = tyConDataCons sum_rtc
+
+ return (mkConApp sum_rdc (map Type tys ++ (len : sel : exprs)),
+ mkTyConApp sum_tc tys)
+ where
+ (exprs, tys) = unzip es
+
+ mk_prod [(expr, ty)] = return (expr, ty)
+ mk_prod es
+ = do
+ prod_tc <- builtin . prodTyCon $ length es
+ (prod_rtc, _) <- parrayReprTyCon (mkTyConApp prod_tc tys)
+ let [prod_rdc] = tyConDataCons prod_rtc
+
+ return (mkConApp prod_rdc (map Type tys ++ (len : exprs)),
+ mkTyConApp prod_tc tys)
+ where
+ (exprs, tys) = unzip es
+
+ mk_embed expr = (mkConApp embed_rdc [Type ty, expr],
+ mkTyConApp embed_tc [ty])
+ where ty = splitPArrayTy (exprType expr)
+
+ liftM fst (mk_sum =<< mapM (mk_prod . map mk_embed) ess)
+