summaryrefslogtreecommitdiff
path: root/op.c
diff options
context:
space:
mode:
authorPaul "LeoNerd" Evans <leonerd@leonerd.org.uk>2021-07-27 14:55:14 +0100
committerPaul Evans <leonerd@leonerd.org.uk>2021-08-25 13:52:09 +0100
commitf79e2ff95fbb22eaf18e130c7cba8a9d40be3d75 (patch)
tree18bedb48e757671114f8f63c8691677a06b62a1b /op.c
parent4b21956ed64a9303ab72a46be1cd68c22bff2560 (diff)
downloadperl-f79e2ff95fbb22eaf18e130c7cba8a9d40be3d75.tar.gz
Create `defer` syntax and `OP_PUSHDEFER` opcode
Adds syntax `defer { BLOCK }` to create a deferred block; code that is deferred until the scope exits. This syntax is guarded by use feature 'defer'; Adds a new opcode, `OP_PUSHDEFER`, which is a LOGOP whose `op_other` field gives the start of an optree to be deferred until scope exit. That op pointer will be stored on the save stack and invoked as part of scope unwind. Included is support for `B::Deparse` to deparse the optree back into syntax.
Diffstat (limited to 'op.c')
-rw-r--r--op.c38
1 files changed, 38 insertions, 0 deletions
diff --git a/op.c b/op.c
index 0a4f2b803c..d93b62a6d6 100644
--- a/op.c
+++ b/op.c
@@ -10612,6 +10612,43 @@ Perl_newWHENOP(pTHX_ OP *cond, OP *block)
return newGIVWHENOP(cond_op, block, OP_ENTERWHEN, OP_LEAVEWHEN, 0);
}
+/*
+=for apidoc newDEFEROP
+
+Constructs and returns a deferred-block statement that implements the
+C<defer> semantics. The C<block> optree is consumed by this function and
+becomes part of the returned optree.
+
+The C<flags> argument is currently ignored.
+
+=cut
+ */
+
+OP *
+Perl_newDEFEROP(pTHX_ I32 flags, OP *block)
+{
+ OP *o, *start, *blockfirst;
+
+ PERL_ARGS_ASSERT_NEWDEFEROP;
+ PERL_UNUSED_ARG(flags);
+
+ start = LINKLIST(block);
+
+ /* Hide the block inside an OP_NULL with no exection */
+ block = newUNOP(OP_NULL, 0, block);
+ block->op_next = block;
+
+ o = (OP *)alloc_LOGOP(OP_PUSHDEFER, block, start);
+ o->op_flags |= OPf_WANT_VOID;
+
+ /* Terminate the block */
+ blockfirst = cUNOPx(block)->op_first;
+ assert(blockfirst->op_type == OP_SCOPE || blockfirst->op_type == OP_LEAVE);
+ blockfirst->op_next = NULL;
+
+ return o;
+}
+
/* must not conflict with SVf_UTF8 */
#define CV_CKPROTO_CURSTASH 0x1
@@ -17748,6 +17785,7 @@ Perl_rpeep(pTHX_ OP *o)
case OP_OR:
case OP_DOR:
case OP_CMPCHAIN_AND:
+ case OP_PUSHDEFER:
while (cLOGOP->op_other->op_type == OP_NULL)
cLOGOP->op_other = cLOGOP->op_other->op_next;
while (o->op_next && ( o->op_type == o->op_next->op_type