+mkPlusAlts :: [CoreExpr] -> VM [CoreExpr]
+mkPlusAlts [] = return []
+mkPlusAlts exprs
+ = do
+ plus_tc <- builtin plusTyCon
+ left_dc <- builtin leftDataCon
+ right_dc <- builtin rightDataCon
+
+ let go [expr] = ([expr], exprType expr)
+ go (expr : exprs)
+ | (alts, right_ty) <- go exprs
+ = (mkConApp left_dc [Type left_ty, Type right_ty, expr]
+ : [mkConApp right_dc [Type left_ty, Type right_ty, alt]
+ | alt <- alts],
+ mkTyConApp plus_tc [left_ty, right_ty])
+ where
+ left_ty = exprType expr
+
+ return . fst $ go exprs
+