+
+# 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
+# empty list.
+#
+# Normally a bunch of argelem ops will have been generated by the
+# signature parsing, but it's possible that ops have been added manually
+# or altered. In this case we "return ()" and fall back to general
+# deparsing of the individual sigelems as 'my $x = $_[N]' etc.
+#
+# We're only called if the first two ops are nextstate and argcheck.
+
+sub deparse_argops {
+ my ($self, $firstop, $cv) = @_;
+
+ my @sig;
+ my $o = $firstop;
+ return if $o->label; #first nextstate;
+
+ # OP_ARGCHECK
+
+ $o = $o->sibling;
+ my ($params, $opt_params, $slurpy) = $o->aux_list($cv);
+ my $mandatory = $params - $opt_params;
+ my $seen_slurpy = 0;
+ my $last_ix = -1;
+
+ # keep looking for valid nextstate + argelem pairs
+
+ while (1) {
+ # OP_NEXTSTATE
+ $o = $o->sibling;
+ last unless $$o;
+ last unless $o->name =~ /^(next|db)state$/;
+ last if $o->label;
+
+ # OP_ARGELEM
+ my $o2 = $o->sibling;
+ last unless $$o2;
+
+ if ($o2->name eq 'argelem') {
+ my $ix = $o2->string($cv);
+ while (++$last_ix < $ix) {
+ push @sig, $last_ix < $mandatory ? '$' : '$=';
+ }
+ my $var = $self->padname($o2->targ);
+ if ($var =~ /^[@%]/) {
+ return if $seen_slurpy;
+ $seen_slurpy = 1;
+ return if $ix != $params or !$slurpy
+ or substr($var,0,1) ne $slurpy;
+ }
+ else {
+ return if $ix >= $params;
+ }
+ if ($o2->flags & OPf_KIDS) {
+ my $kid = $o2->first;
+ return unless $$kid and $kid->name eq 'argdefelem';
+ my $def = $self->deparse($kid->first, 7);
+ $def = "($def)" if $kid->first->flags & OPf_PARENS;
+ $var .= " = $def";
+ }
+ push @sig, $var;
+ }
+ elsif ($o2->name eq 'null'
+ and ($o2->flags & OPf_KIDS)
+ and $o2->first->name eq 'argdefelem')
+ {
+ # special case - a void context default expression: $ = expr
+
+ my $defop = $o2->first;
+ my $ix = $defop->targ;
+ while (++$last_ix < $ix) {
+ push @sig, $last_ix < $mandatory ? '$' : '$=';
+ }
+ return if $last_ix >= $params
+ or $last_ix < $mandatory;
+ my $def = $self->deparse($defop->first, 7);
+ $def = "($def)" if $defop->first->flags & OPf_PARENS;
+ push @sig, '$ = ' . $def;
+ }
+ else {
+ last;
+ }
+
+ $o = $o2;
+ }
+
+ while (++$last_ix < $params) {
+ push @sig, $last_ix < $mandatory ? '$' : '$=';
+ }
+ push @sig, $slurpy if $slurpy and !$seen_slurpy;
+
+ return ($o, join(', ', @sig));
+}
+
+# Deparse a sub. Returns everything except the 'sub foo',
+# e.g. ($$) : method { ...; }
+# or ($a, $b) : prototype($$) lvalue;
+
https://perl5.git.perl.org / perl5.git / blobdiff