Expose op_force_list() as a real API function; use it directly in op.c

4 files changed, 39 insertions, 11 deletions

diff --git a/embed.fnc b/embed.fnc
index 5785e8f304..a45372ec7d 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2354,6 +2354,8 @@ p	|OP *	|sawparens	|NULLOK OP *o
 Apd	|OP *	|op_contextualize					\
 				|NN OP *o				\
 				|I32 context
+; Used in op.c
+Apd	|OP *	|op_force_list	|NULLOK OP *o
 : Used in perly.y
 p	|OP *	|scalar 	|NULLOK OP *o
 : Used in pp_ctl.c
diff --git a/embed.h b/embed.h
index 62c0169963..36ca78e716 100644
--- a/embed.h
+++ b/embed.h
@@ -457,6 +457,7 @@
 # define op_contextualize(a,b)                  Perl_op_contextualize(aTHX_ a,b)
 # define op_convert_list(a,b,c)                 Perl_op_convert_list(aTHX_ a,b,c)
 # define op_dump(a)                             Perl_op_dump(aTHX_ a)
+# define op_force_list(a)                       Perl_op_force_list(aTHX_ a)
 # define op_free(a)                             Perl_op_free(aTHX_ a)
 # define op_linklist(a)                         Perl_op_linklist(aTHX_ a)
 # define op_null(a)                             Perl_op_null(aTHX_ a)
diff --git a/op.c b/op.c
index b73425b344..84a186c4c7 100644
--- a/op.c
+++ b/op.c
@@ -5470,6 +5470,27 @@ S_force_list(pTHX_ OP *o, bool nullit)
 }
 
 /*
+=for apidoc op_force_list
+
+Promotes o and any siblings to be an C<OP_LIST> if it is not already. If
+a new C<OP_LIST> op was created, its first child will be C<OP_PUSHMARK>.
+The returned node itself will be nulled, leaving only its children.
+
+This is often what you want to do before putting the optree into list
+context; as
+
+    o = op_contextualize(op_force_list(o), G_LIST);
+
+=cut
+*/
+
+OP *
+Perl_op_force_list(pTHX_ OP *o)
+{
+    return force_list(o, TRUE);
+}
+
+/*
 =for apidoc newLISTOP
 
 Constructs, checks, and returns an op of any list type.  C<type> is
@@ -5605,7 +5626,7 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
     if (!first)
         first = newOP(OP_STUB, 0);
     if (PL_opargs[type] & OA_MARK)
-        first = force_list(first, TRUE);
+        first = op_force_list(first);
 
     NewOp(1101, unop, 1, UNOP);
     OpTYPE_set(unop, type);
@@ -5680,7 +5701,7 @@ S_newMETHOP_internal(pTHX_ I32 type, I32 flags, OP* dynamic_meth, SV* const_meth
 
     NewOp(1101, methop, 1, METHOP);
     if (dynamic_meth) {
-        if (PL_opargs[type] & OA_MARK) dynamic_meth = force_list(dynamic_meth, TRUE);
+        if (PL_opargs[type] & OA_MARK) dynamic_meth = op_force_list(dynamic_meth);
         methop->op_flags = (U8)(flags | OPf_KIDS);
         methop->op_u.op_first = dynamic_meth;
         methop->op_private = (U8)(1 | (flags >> 8));
@@ -7401,7 +7422,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor)
                     MUTABLE_SV(newATTRSUB(floor, 0, NULL, NULL, expr)));
             cv_targ = expr->op_targ;
 
-            expr = list(force_list(newUNOP(OP_ENTERSUB, 0, scalar(expr)), TRUE));
+            expr = list(op_force_list(newUNOP(OP_ENTERSUB, 0, scalar(expr))));
         }
 
         rcop = alloc_LOGOP(OP_REGCOMP, scalar(expr), o);
@@ -8013,8 +8034,8 @@ OP *
 Perl_newSLICEOP(pTHX_ I32 flags, OP *subscript, OP *listval)
 {
     return newBINOP(OP_LSLICE, flags,
-            list(force_list(subscript, TRUE)),
-            list(force_list(listval,   TRUE)));
+            list(op_force_list(subscript)),
+            list(op_force_list(listval)));
 }
 
 #define ASSIGN_SCALAR 0
@@ -8195,8 +8216,8 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 
         PL_modcount = 0;
         left = op_lvalue(left, OP_AASSIGN);
-        curop = list(force_list(left, TRUE));
-        o = newBINOP(OP_AASSIGN, flags, list(force_list(right, TRUE)), curop);
+        curop = list(op_force_list(left));
+        o = newBINOP(OP_AASSIGN, flags, list(op_force_list(right)), curop);
         o->op_private = (U8)(0 | (flags >> 8));
 
         if (OP_TYPE_IS_OR_WAS(left, OP_LIST))
@@ -9290,7 +9311,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
     }
 
     if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
-        expr = op_lvalue(force_list(scalar(ref(expr, OP_ITER)), TRUE), OP_GREPSTART);
+        expr = op_lvalue(op_force_list(scalar(ref(expr, OP_ITER))), OP_GREPSTART);
         iterflags |= OPf_STACKED;
     }
     else if (expr->op_type == OP_NULL &&
@@ -9323,7 +9344,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
         iterflags |= OPf_STACKED;
     }
     else {
-        expr = op_lvalue(force_list(expr, TRUE), OP_GREPSTART);
+        expr = op_lvalue(op_force_list(expr), OP_GREPSTART);
     }
 
     loop = (LOOP*)op_convert_list(OP_ENTERITER, iterflags,
@@ -12877,7 +12898,7 @@ Perl_ck_listiob(pTHX_ OP *o)
 
     kid = cLISTOPo->op_first;
     if (!kid) {
-        o = force_list(o, TRUE);
+        o = op_force_list(o);
         kid = cLISTOPo->op_first;
     }
     if (kid->op_type == OP_PUSHMARK)
@@ -13230,7 +13251,7 @@ Perl_ck_repeat(pTHX_ OP *o)
         OP* kids;
         o->op_private |= OPpREPEAT_DOLIST;
         kids = op_sibling_splice(o, NULL, 1, NULL); /* detach first kid */
-        kids = force_list(kids, TRUE); /* promote it to a list */
+        kids = op_force_list(kids); /* promote it to a list */
         op_sibling_splice(o, NULL, 0, kids); /* and add back */
     }
     else
diff --git a/proto.h b/proto.h
index bcba9e889c..a834b7867c 100644
--- a/proto.h
+++ b/proto.h
@@ -3202,6 +3202,10 @@ Perl_op_dump(pTHX_ const OP *o);
 #define PERL_ARGS_ASSERT_OP_DUMP                \
         assert(o)
 
+PERL_CALLCONV OP *
+Perl_op_force_list(pTHX_ OP *o);
+#define PERL_ARGS_ASSERT_OP_FORCE_LIST
+
 PERL_CALLCONV void
 Perl_op_free(pTHX_ OP *arg);
 #define PERL_ARGS_ASSERT_OP_FREE