WIP: partial support OP_MULTIPARAM in for B::Deparse

leonerd · Dec 4, 2024 · 94c494d · 94c494d
1 parent 401d481
commit 94c494d
Show file tree

Hide file tree

Showing 2 changed files with 63 additions and 1 deletion.
diff --git a/ext/B/B.xs b/ext/B/B.xs
@@ -1393,6 +1393,19 @@ aux_list(o, cv)
                 XSRETURN(len);
 
             } /* OP_MULTIDEREF */
+
+        case OP_MULTIPARAM:
+            {
+                struct op_multiparam_aux *p = (struct op_multiparam_aux *)aux;
+                EXTEND(SP, 3 + p->params + 1);
+                mPUSHu(p->params);
+                mPUSHu(p->opt_params);
+                PUSHs(sv_2mortal(p->slurpy ? newSVpvf("%c", p->slurpy) : &PL_sv_no));
+                for(UV parami = 0; parami < p->params; parami++)
+                    mPUSHu(p->param_padix[parami]);
+                mPUSHu(p->slurpy_padix);
+                XSRETURN(3 + p->params + 1);
+            }
         } /* switch */
 
 

diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
@@ -1180,6 +1180,54 @@ sub pad_subs {
 }
 
 
+# deparse_multiparam():
+#   TODO docs
+sub deparse_multiparam {
+    my ($self, $topop, $cv) = @_;
+
+    $topop = $topop->first;
+    return unless $$topop and $topop->name eq 'lineseq';
+
+    # last op should be nextstate
+    my $last = $topop->last;
+    return unless $$last
+                    and (   _op_is_or_was($last, OP_NEXTSTATE)
+                         or _op_is_or_was($last, OP_DBSTATE));
+
+    # first OP_NEXTSTATE
+
+    my $o = $topop->first;
+    return unless $$o;
+    return if $o->label;
+
+    # OP_MULTIPARAM
+
+    $o = $o->sibling;
+    return unless $$o and $o->name eq 'multiparam';
+
+    my ($params, $opt_params, $slurpy, @rest) = $o->aux_list($cv);
+    my $mandatory_params = $params - $opt_params;
+    my @param_padix = splice @rest, 0, $params, ();
+    my ($slurpy_padix) = @rest;
+
+    my @sig;
+
+    # Initial scalars
+    foreach my $parami ( 0 .. $params-1 ) {
+        my $padix = $param_padix[$parami];
+        $sig[$parami] = $padix ? $self->padname($padix) :
+                        $parami < $mandatory_params ? '$' : '$=';
+    }
+
+    # TODO: defaulting exprs of optional params
+
+    if($slurpy) {
+        push @sig, $slurpy_padix ? $self->padname($slurpy_padix) : $slurpy;
+    }
+
+    return join(", ", @sig);
+}
+
 # deparse_argops(): deparse, if possible, a sequence of argcheck + argelem
 # ops into a subroutine signature. If successful, return the first op
 # following the signature ops plus the signature string; else return the
@@ -1372,7 +1420,8 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");
             and $firstop->name eq 'null'
             and $firstop->targ == OP_ARGCHECK
         ) {
-            my ($mysig) = $self->deparse_argops($firstop, $cv);
+            my ($mysig) = $self->deparse_multiparam($firstop, $cv) //
+                          $self->deparse_argops($firstop, $cv);
             if (defined $mysig) {
                 $sig = $mysig;
                 $firstop = $is_list ? $firstop->sibling : undef;