This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
apply patch sent via private mail
[perl5.git] / ext / B / B / Deparse.pm
1 # B::Deparse.pm
2 # Copyright (c) 1998 Stephen McCamant. All rights reserved.
3 # This module is free software; you can redistribute and/or modify
4 # it under the same terms as Perl itself.
5
6 # This is based on the module of the same name by Malcolm Beattie,
7 # but essentially none of his code remains.
8
9 package B::Deparse;
10 use Carp 'cluck';
11 use B qw(class main_root main_start main_cv svref_2object);
12 $VERSION = 0.51;
13 use strict;
14
15 # Changes between 0.50 and 0.51:
16 # - fixed nulled leave with live enter in sort { }
17 # - fixed reference constants (\"str")
18 # - handle empty programs gracefully
19 # - handle infinte loops (for (;;) {}, while (1) {})
20 # - differentiate between `for my $x ...' and `my $x; for $x ...'
21 # - various minor cleanups
22 # - moved globals into an object
23 # - added `-u', like B::C
24 # - package declarations using cop_stash
25 # - subs, formats and code sorted by cop_seq
26
27 # Todo:
28 # - eliminate superfluous parentheses
29 # - 'EXPR1 && EXPR2;' => 'EXPR2 if EXPR1;'
30 # - pp_threadsv (incl. in foreach)
31 # - style options
32 # - '&&' => 'and'?
33 # - ',' => '=>' (auto-unquote?)
34 # - break long lines ("\r" as discretionary break?)
35 # - version using op_next instead of op_first/sibling?
36 # - avoid string copies (pass arrays, one big join?)
37 # - auto-apply `-u'?
38 # - documentation
39
40 # The following OPs don't have functions:
41
42 # pp_threadsv -- see Todo
43
44 # pp_padany -- does not exist after parsing
45 # pp_rcatline -- does not exist
46
47 # pp_leavesub -- see deparse_sub
48 # pp_leavewrite -- see deparse_format
49 # pp_method -- see entersub
50 # pp_regcmaybe -- see regcomp
51 # pp_substcont -- see subst
52 # pp_grepstart -- see grepwhile
53 # pp_mapstart -- see mapwhile
54 # pp_flip -- see flop
55 # pp_iter -- see leaveloop
56 # pp_enterloop -- see leaveloop
57 # pp_leaveeval -- see entereval
58 # pp_entertry -- see leavetry
59
60 # Object fields (were globals):
61 #
62 # avoid_local:
63 # (local($a), local($b)) and local($a, $b) have the same internal
64 # representation but the short form looks better. We notice we can
65 # use a large-scale local when checking the list, but need to prevent
66 # individual locals too. This hash holds the addresses of OPs that 
67 # have already had their local-ness accounted for. The same thing
68 # is done with my().
69 #
70 # curcv:
71 # CV for current sub (or main program) being deparsed
72 #
73 # curstash:
74 # name of the current package for deparsed code
75 #
76 # subs_todo:
77 # array of [cop_seq, GV, is_format?] for subs and formats we still
78 # want to deparse
79 #
80 # subs_done, forms_done:
81 # keys are addresses of GVs for subs and formats we've already
82 # deparsed (or at least put into subs_todo)
83
84 sub null {
85     my $op = shift;
86     return class($op) eq "NULL";
87 }
88
89 sub todo {
90     my $self = shift;
91     my($gv, $cv, $is_form) = @_;
92     my $seq;
93     if (!null($cv->START) and is_state($cv->START)) {
94         $seq = $cv->START->cop_seq;
95     } else {
96         $seq = 0;
97     }
98     push @{$self->{'subs_todo'}}, [$seq, $gv, $is_form];
99 }
100
101 sub next_todo {
102     my $self = shift;
103     my $ent = shift @{$self->{'subs_todo'}};
104     my $name = $self->gv_name($ent->[1]);
105     if ($ent->[2]) {
106         return "format $name =\n"
107             . $self->deparse_format($ent->[1]->FORM). "\n";
108     } else {
109         return "sub $name " .
110             $self->deparse_sub($ent->[1]->CV);
111     }
112 }
113
114 sub OPf_KIDS () { 4 }
115
116 sub walk_tree {
117     my($op, $sub) = @_;
118     $sub->($op);
119     if ($op->flags & OPf_KIDS) {
120         my $kid;
121         for ($kid = $op->first; not null $kid; $kid = $kid->sibling) {
122             walk_tree($kid, $sub);
123         }
124     }
125 }
126
127 sub walk_sub {
128     my $self = shift;
129     my $cv = shift;
130     my $op = $cv->ROOT;
131     $op = shift if null $op;
132     return if !$op or null $op;
133     walk_tree($op, sub {
134         my $op = shift;
135         if ($op->ppaddr eq "pp_gv") {
136             if ($op->next->ppaddr eq "pp_entersub") {
137                 next if $self->{'subs_done'}{$ {$op->gv}}++;
138                 next if class($op->gv->CV) eq "SPECIAL";
139                 $self->todo($op->gv, $op->gv->CV, 0);
140                 $self->walk_sub($op->gv->CV);
141             } elsif ($op->next->ppaddr eq "pp_enterwrite"
142                      or ($op->next->ppaddr eq "pp_rv2gv"
143                          and $op->next->next->ppaddr eq "pp_enterwrite")) {
144                 next if $self->{'forms_done'}{$ {$op->gv}}++;
145                 next if class($op->gv->FORM) eq "SPECIAL";
146                 $self->todo($op->gv, $op->gv->FORM, 1);
147                 $self->walk_sub($op->gv->FORM);
148             }
149         }
150     });
151 }
152
153 sub stash_subs {
154     my $self = shift;
155     my $pack = shift;
156     my(%stash, @ret);
157     { no strict 'refs'; %stash = svref_2object(\%{$pack . "::"})->ARRAY }
158     my($key, $val);
159     while (($key, $val) = each %stash) {
160         next unless class($val) eq "GV";
161         if (class($val->CV) ne "SPECIAL") {
162             next if $self->{'subs_done'}{$$val}++;
163             $self->todo($val, $val->CV, 0);
164             $self->walk_sub($val->CV);
165         }
166         if (class($val->FORM) ne "SPECIAL") {
167             next if $self->{'forms_done'}{$$val}++;
168             $self->todo($val, $val->FORM, 1);
169             $self->walk_sub($val->FORM);
170         }
171     }
172 }
173
174 sub compile {
175     my(@args) = @_;
176     return sub { 
177         my $self = bless {};
178         my $arg;
179         $self->{'subs_todo'} = [];
180         $self->stash_subs("main");
181         $self->{'curcv'} = main_cv;
182         $self->{'curstash'} = "main";
183         while ($arg = shift @args) {
184             if (substr($arg, 0, 2) eq "-u") {
185                 $self->stash_subs(substr($arg, 2));
186             }
187         }
188         $self->walk_sub(main_cv, main_start);
189         @{$self->{'subs_todo'}} =
190             sort {$a->[0] <=> $b->[0]} @{$self->{'subs_todo'}};
191         print indent($self->deparse(main_root)), "\n" unless null main_root;
192         my @text;
193         while (scalar(@{$self->{'subs_todo'}})) {
194             push @text, $self->next_todo;
195         }
196         print indent(join("", @text)), "\n" if @text;
197     }
198 }
199
200 sub deparse {
201     my $self = shift;
202     my $op = shift;
203 #    cluck unless ref $op;
204     my $meth = $op->ppaddr;
205     return $self->$meth($op);
206 }
207
208 sub indent {
209     my $txt = shift;
210     my @lines = split(/\n/, $txt);
211     my $leader = "";
212     my $line;
213     for $line (@lines) {
214         if (substr($line, 0, 1) eq "\t") {
215             $leader = $leader . "    ";
216             $line = substr($line, 1);
217         } elsif (substr($line, 0, 1) eq "\b") {
218             $leader = substr($leader, 0, length($leader) - 4);
219             $line = substr($line, 1);
220         }
221         $line = $leader . $line;
222     }
223     return join("\n", @lines);
224 }
225
226 sub SVf_POK () {0x40000}
227
228 sub deparse_sub {
229     my $self = shift;
230     my $cv = shift;
231     my $proto = "";
232     if ($cv->FLAGS & SVf_POK) {
233         $proto = "(". $cv->PV . ") ";
234     }
235     local($self->{'curcv'}) = $cv;
236     local($self->{'curstash'}) = $self->{'curstash'};
237     if (not null $cv->ROOT) {
238         # skip leavesub
239         return $proto . "{\n\t" . 
240             $self->deparse($cv->ROOT->first) . "\n\b}\n"; 
241     } else { # XSUB?
242         return $proto  . "{}\n";
243     }
244 }
245
246 sub deparse_format {
247     my $self = shift;
248     my $form = shift;
249     my @text;
250     local($self->{'curcv'}) = $form;
251     local($self->{'curstash'}) = $self->{'curstash'};
252     my $op = $form->ROOT;
253     my $kid;
254     $op = $op->first->first; # skip leavewrite, lineseq
255     while (not null $op) {
256         $op = $op->sibling; # skip nextstate
257         my @exprs;
258         $kid = $op->first->sibling; # skip pushmark
259         push @text, $kid->sv->PV;
260         $kid = $kid->sibling;
261         for (; not null $kid; $kid = $kid->sibling) {
262             push @exprs, $self->deparse($kid);
263         }
264         push @text, join(", ", @exprs)."\n" if @exprs;
265         $op = $op->sibling;
266     }
267     return join("", @text) . ".";
268 }
269
270 # the aassign in-common check messes up SvCUR (always setting it
271 # to a value >= 100), but it's probably safe to assume there
272 # won't be any NULs in the names of my() variables. (with
273 # stash variables, I wouldn't be so sure)
274 sub padname_fix {
275     my $str = shift;
276     $str = substr($str, 0, index($str, "\0")) if index($str, "\0") != -1;
277     return $str;
278 }
279
280 sub is_scope {
281     my $op = shift;
282     return $op->ppaddr eq "pp_leave" || $op->ppaddr eq "pp_scope"
283         || ($op->ppaddr eq "pp_null" && class($op) eq "UNOP" 
284             && (is_scope($op->first) || $op->first->ppaddr eq "pp_enter"));
285 }
286
287 sub is_state {
288     my $name = $_[0]->ppaddr;
289     return $name eq "pp_nextstate" || $name eq "pp_dbstate";
290 }
291
292 sub is_miniwhile { # check for one-line loop (`foo() while $y--')
293     my $op = shift;
294     return (!null($op) and null($op->sibling) 
295             and $op->ppaddr eq "pp_null" and class($op) eq "UNOP"
296             and (($op->first->ppaddr =~ /^pp_(and|or)$/
297                   and $op->first->first->sibling->ppaddr eq "pp_lineseq")
298                  or ($op->first->ppaddr eq "pp_lineseq"
299                      and not null $op->first->first->sibling
300                      and $op->first->first->sibling->ppaddr eq "pp_unstack")
301                  ));
302 }
303
304 sub is_scalar {
305     my $op = shift;
306     return ($op->ppaddr eq "pp_rv2sv" or
307             $op->ppaddr eq "pp_padsv" or
308             $op->ppaddr eq "pp_gv" or # only in array/hash constructs
309             !null($op->first) && $op->first->ppaddr eq "pp_gvsv");
310 }
311
312 sub OPp_LVAL_INTRO () { 128 }
313
314 sub maybe_local {
315     my $self = shift;
316     my($op, $text) = @_;
317     if ($op->private & OPp_LVAL_INTRO and not $self->{'avoid_local'}{$$op}) {
318         return "local(" . $text . ")";
319     } else {
320         return $text;
321     }
322 }
323
324 sub padname_sv {
325     my $self = shift;
326     my $targ = shift;
327     return (($self->{'curcv'}->PADLIST->ARRAY)[0]->ARRAY)[$targ];
328 }
329
330 sub maybe_my {
331     my $self = shift;
332     my($op, $text) = @_;
333     if ($op->private & OPp_LVAL_INTRO and not $self->{'avoid_local'}{$$op}) {
334         return "my(" . $text . ")";
335     } else {
336         return $text;
337     }
338 }
339
340 sub pp_enter {cluck "unexpected OP_ENTER"; ""} # see also leave
341
342 # leave, scope, and lineseq should probably share code
343 sub pp_leave {
344     my $self = shift;
345     my $op = shift;
346     my ($kid, $expr);
347     my @exprs;
348     local($self->{'curstash'}) = $self->{'curstash'};
349     $kid = $op->first->sibling; # skip enter
350     if (is_miniwhile($kid)) {
351         my $top = $kid->first;
352         my $name = $top->ppaddr;
353         if ($name eq "pp_and") {
354             $name = "while";
355         } elsif ($name eq "pp_or") {
356             $name = "until";
357         } else { # no conditional -> while 1 or until 0
358             return $self->deparse($top->first) . " while 1";
359         }
360         my $cond = $top->first;
361         my $body = $cond->sibling;
362         $cond = $self->deparse($cond);
363         $body = $self->deparse($body);
364         return "$body $name $cond";
365     }
366     for (; !null($kid); $kid = $kid->sibling) {
367         $expr = "";
368         if (is_state $kid) {
369             $expr = $self->deparse($kid);
370             $kid = $kid->sibling;
371             last if null $kid;
372         }
373         $expr .= $self->deparse($kid);
374         if (is_scope($kid) and not is_miniwhile($kid->first->sibling)) {
375             $expr = "do {$expr}";
376         }
377         push @exprs, $expr if $expr;
378     }
379     return join(";\n", @exprs);
380 }
381
382 sub pp_scope {
383     my $self = shift;
384     my $op = shift;
385     my ($kid, $expr);
386     my @exprs;
387     for ($kid = $op->first; !null($kid); $kid = $kid->sibling) {
388         $expr = "";
389         if (is_state $kid) {
390             $expr = $self->deparse($kid);
391             $kid = $kid->sibling;
392             last if null $kid;
393         }
394         $expr .= $self->deparse($kid);
395         if (is_scope($kid)) {
396             $expr = "do {$expr}";
397         }
398         push @exprs, $expr if $expr;
399     }
400     return join("; ", @exprs);
401 }
402
403 sub pp_lineseq {
404     my $self = shift;
405     my $op = shift;
406     my ($kid, $expr);
407     my @exprs;
408     for ($kid = $op->first; !null($kid); $kid = $kid->sibling) {
409         $expr = "";
410         if (is_state $kid) {
411             $expr = $self->deparse($kid);
412             $kid = $kid->sibling;
413             last if null $kid;
414         }
415         $expr .= $self->deparse($kid);
416         if (is_scope($kid) and not is_miniwhile($kid->first->sibling)) {
417             $expr = "do {$expr}";
418         }
419         push @exprs, $expr if $expr;
420     }
421     return join(";\n", @exprs);
422 }
423
424 # The BEGIN {} is used here because otherwise this code isn't executed
425 # when you run B::Deparse on itself.
426 my %globalnames;
427 BEGIN { map($globalnames{$_}++, "SIG", "STDIN", "STDOUT", "STDERR", "INC",
428             "ENV", "ARGV", "ARGVOUT", "_"); }
429
430 sub gv_name {
431     my $self = shift;
432     my $gv = shift;
433     my $stash = $gv->STASH->NAME;
434     my $name = $gv->NAME;
435     if ($stash eq $self->{'curstash'} or $globalnames{$name}) {
436         $stash = "";
437     } else {
438         $stash = $stash . "::";
439     }
440     if ($name =~ /^([\cA-\cZ])$/) {
441         $name = "^" . chr(64 + ord($1));
442     }
443     return $stash . $name;
444 }
445
446 # Notice how subs and formats are inserted between statements here
447 sub pp_nextstate {
448     my $self = shift;
449     my $op = shift;
450     my @text;
451     @text = $op->label . ": " if $op->label;
452     my $seq = $op->cop_seq;
453     while (scalar(@{$self->{'subs_todo'}})
454            and $seq > $self->{'subs_todo'}[0][0]) {
455         push @text, $self->next_todo;
456     }
457     my $stash = $op->stash->NAME;
458     if ($stash ne $self->{'curstash'}) {
459         push @text, "package $stash;\n";
460         $self->{'curstash'} = $stash;
461     }
462     return join("", @text);
463 }
464
465 sub pp_dbstate { pp_nextstate(@_) }
466
467 sub pp_unstack { return "" } # see also leaveloop
468
469 sub baseop {
470     my $self = shift;
471     my($op, $name) = @_;
472     return $name;
473 }
474
475 sub pp_stub { baseop(@_, "()") }
476 sub pp_wantarray { baseop(@_, "wantarray") }
477 sub pp_fork { baseop(@_, "fork") }
478 sub pp_wait { baseop(@_, "wait") }
479 sub pp_getppid { baseop(@_, "getppid") }
480 sub pp_time { baseop(@_, "time") }
481 sub pp_tms { baseop(@_, "times") }
482 sub pp_ghostent { baseop(@_, "gethostent") }
483 sub pp_gnetent { baseop(@_, "getnetent") }
484 sub pp_gprotoent { baseop(@_, "getprotoent") }
485 sub pp_gservent { baseop(@_, "getservent") }
486 sub pp_ehostent { baseop(@_, "endhostent") }
487 sub pp_enetent { baseop(@_, "endnetent") }
488 sub pp_eprotoent { baseop(@_, "endprotoent") }
489 sub pp_eservent { baseop(@_, "endservent") }
490 sub pp_gpwent { baseop(@_, "getpwent") }
491 sub pp_spwent { baseop(@_, "setpwent") }
492 sub pp_epwent { baseop(@_, "endpwent") }
493 sub pp_ggrent { baseop(@_, "getgrent") }
494 sub pp_sgrent { baseop(@_, "setgrent") }
495 sub pp_egrent { baseop(@_, "endgrent") }
496 sub pp_getlogin { baseop(@_, "getlogin") }
497
498 sub POSTFIX () { 1 }
499
500 sub OPf_SPECIAL () { 128 }
501
502 sub unop {
503     my $self = shift;
504     my($op, $name, $flags) = (@_, 0);
505     my $kid;
506     if (class($op) eq "UNOP") {
507         $kid = $op->first;
508         $kid = "(" . $self->deparse($kid) . ")";
509     } else {
510         $kid = ($op->flags & OPf_SPECIAL ? "()" : "");
511     }
512     return ($flags & POSTFIX) ? "$kid$name" : "$name$kid";
513 }
514
515 sub pp_preinc { unop(@_, "++") }
516 sub pp_predec { unop(@_, "--") }
517 sub pp_postinc { unop(@_, "++", POSTFIX) }
518 sub pp_postdec { unop(@_, "--", POSTFIX) }
519 sub pp_i_preinc { unop(@_, "++") }
520 sub pp_i_predec { unop(@_, "--") }
521 sub pp_i_postinc { unop(@_, "++", POSTFIX) }
522 sub pp_i_postdec { unop(@_, "--", POSTFIX) }
523 sub pp_negate { unop(@_, "-") }
524 sub pp_i_negate { unop(@_, "-") }
525 sub pp_not { unop(@_, "!") }
526 sub pp_complement { unop(@_, "~") }
527
528 sub pp_chop { unop(@_, "chop") }
529 sub pp_chomp { unop(@_, "chomp") }
530 sub pp_schop { unop(@_, "chop") }
531 sub pp_schomp { unop(@_, "chomp") }
532 sub pp_defined { unop(@_, "defined") }
533 sub pp_undef { unop(@_, "undef") }
534 sub pp_study { unop(@_, "study") }
535 sub pp_scalar { unop(@_, "scalar") }
536 sub pp_ref { unop(@_, "ref") }
537 sub pp_pos { maybe_local(@_, unop(@_, "pos")) }
538
539 sub pp_sin { unop(@_, "sin") }
540 sub pp_cos { unop(@_, "cos") }
541 sub pp_rand { unop(@_, "rand") }
542 sub pp_srand { unop(@_, "srand") }
543 sub pp_exp { unop(@_, "exp") }
544 sub pp_log { unop(@_, "log") }
545 sub pp_sqrt { unop(@_, "sqrt") }
546 sub pp_int { unop(@_, "int") }
547 sub pp_hex { unop(@_, "hex") }
548 sub pp_oct { unop(@_, "oct") }
549 sub pp_abs { unop(@_, "abs") }
550
551 sub pp_length { unop(@_, "length") }
552 sub pp_ord { unop(@_, "ord") }
553 sub pp_chr { unop(@_, "chr") }
554 sub pp_ucfirst { unop(@_, "ucfirst") }
555 sub pp_lcfirst { unop(@_, "lcfirst") }
556 sub pp_uc { unop(@_, "uc") }
557 sub pp_lc { unop(@_, "lc") }
558 sub pp_quotemeta { unop(@_, "quotemeta") }
559
560 sub pp_each { unop(@_, "each") }
561 sub pp_values { unop(@_, "values") }
562 sub pp_keys { unop(@_, "keys") }
563 sub pp_pop { unop(@_, "pop") }
564 sub pp_shift { unop(@_, "shift") }
565
566 sub pp_caller { unop(@_, "caller") }
567 sub pp_reset { unop(@_, "reset") }
568 sub pp_exit { unop(@_, "exit") }
569 sub pp_prototype { unop(@_, "prototype") }
570
571 sub pp_close { unop(@_, "close") }
572 sub pp_fileno { unop(@_, "fileno") }
573 sub pp_umask { unop(@_, "umask") }
574 sub pp_binmode { unop(@_, "binmode") }
575 sub pp_untie { unop(@_, "untie") }
576 sub pp_tied { unop(@_, "tied") }
577 sub pp_dbmclose { unop(@_, "dbmclose") }
578 sub pp_getc { unop(@_, "getc") }
579 sub pp_eof { unop(@_, "eof") }
580 sub pp_tell { unop(@_, "tell") }
581 sub pp_getsockname { unop(@_, "getsockname") }
582 sub pp_getpeername { unop(@_, "getpeername") }
583
584 sub pp_chdir { unop(@_, "chdir") }
585 sub pp_chroot { unop(@_, "chroot") }
586 sub pp_readlink { unop(@_, "readlink") }
587 sub pp_rmdir { unop(@_, "rmdir") }
588 sub pp_readdir { unop(@_, "readdir") }
589 sub pp_telldir { unop(@_, "telldir") }
590 sub pp_rewinddir { unop(@_, "rewinddir") }
591 sub pp_closedir { unop(@_, "closedir") }
592 sub pp_getpgrp { unop(@_, "getpgrp") }
593 sub pp_localtime { unop(@_, "localtime") }
594 sub pp_gmtime { unop(@_, "gmtime") }
595 sub pp_alarm { unop(@_, "alarm") }
596 sub pp_sleep { unop(@_, "sleep") }
597
598 sub pp_dofile { unop(@_, "do") }
599 sub pp_entereval { unop(@_, "eval") }
600
601 sub pp_ghbyname { unop(@_, "gethostbyname") }
602 sub pp_gnbyname { unop(@_, "getnetbyname") }
603 sub pp_gpbyname { unop(@_, "getprotobyname") }
604 sub pp_shostent { unop(@_, "sethostent") }
605 sub pp_snetent { unop(@_, "setnetent") }
606 sub pp_sprotoent { unop(@_, "setprotoent") }
607 sub pp_sservent { unop(@_, "setservent") }
608 sub pp_gpwnam { unop(@_, "getpwnam") }
609 sub pp_gpwuid { unop(@_, "getpwuid") }
610 sub pp_ggrnam { unop(@_, "getgrnam") }
611 sub pp_ggrgid { unop(@_, "getgrgid") }
612
613 sub pp_lock { unop(@_, "lock") }
614
615 sub pp_exists {
616     my $self = shift;
617     my $op = shift;
618     return "exists(" . $self->pp_helem($op->first) . ")";
619 }
620
621 sub OPpSLICE () { 64 }
622
623 sub pp_delete {
624     my $self = shift;
625     my $op = shift;
626     my $arg;
627     if ($op->private & OPpSLICE) {
628         $arg = $self->pp_hslice($op->first);
629     } else {
630         $arg = $self->pp_helem($op->first);
631     }
632     return "delete($arg)";
633 }
634
635 sub OPp_CONST_BARE () { 64 }
636
637 sub pp_require {
638     my $self = shift;
639     my $op = shift;
640     if (class($op) eq "UNOP" and $op->first->ppaddr eq "pp_const"
641         and $op->first->private & OPp_CONST_BARE)
642     {
643         my $name = $op->first->sv->PV;
644         $name =~ s[/][::]g;
645         $name =~ s/\.pm//g;
646         return "require($name)";
647     } else {    
648         $self->unop($op, "require");
649     }
650 }
651
652 sub padval {
653     my $self = shift;
654     my $targ = shift;
655     return (($self->{'curcv'}->PADLIST->ARRAY)[1]->ARRAY)[$targ];
656 }
657
658 sub pp_refgen {
659     my $self = shift;   
660     my $op = shift;
661     my $kid = $op->first;
662     if ($kid->ppaddr eq "pp_null") {
663         $kid = $kid->first;
664         if ($kid->ppaddr eq "pp_anonlist" || $kid->ppaddr eq "pp_anonhash") {
665             my($pre, $post) = @{{"pp_anonlist" => ["[","]"],
666                                  "pp_anonhash" => ["{","}"]}->{$kid->ppaddr}};
667             my($expr, @exprs);
668             $kid = $kid->first->sibling; # skip pushmark
669             for (; !null($kid); $kid = $kid->sibling) {
670                 $expr = $self->deparse($kid);
671                 push @exprs, $expr;
672             }
673             return $pre . join(", ", @exprs) . $post;
674         } elsif (!null($kid->sibling) and 
675                  $kid->sibling->ppaddr eq "pp_anoncode") {
676             return "sub " .
677                 $self->deparse_sub($self->padval($kid->sibling->targ));
678         }
679     }
680     $self->unop($op, "\\");
681 }
682
683 sub pp_srefgen { pp_refgen(@_) }
684
685 sub pp_readline {
686     my $self = shift;
687     my $op = shift;
688     my $kid = $op->first;
689     $kid = $kid->first if $kid->ppaddr eq "pp_rv2gv"; # <$fh>
690     if ($kid->ppaddr eq "pp_rv2gv") {
691         $kid = $kid->first;
692     }
693     return "<" . $self->deparse($kid) . ">";
694 }
695
696 sub loopex {
697     my $self = shift;
698     my ($op, $name) = @_;
699     my $kid;
700     if (class($op) eq "PVOP") {
701         $kid = " " . $op->pv;
702     } elsif (class($op) eq "BASEOP") {
703         $kid = "";
704     } elsif (class($op) eq "UNOP") {
705         $kid = "(" . $self->deparse($op->first) . ")";
706     }
707     return "$name$kid";
708 }
709
710 sub pp_last { loopex(@_, "last") }
711 sub pp_next { loopex(@_, "next") }
712 sub pp_redo { loopex(@_, "redo") }
713 sub pp_goto { loopex(@_, "goto") }
714 sub pp_dump { loopex(@_, "dump") }
715
716 sub ftst {
717     my $self = shift;
718     my($op, $name) = @_;
719     my $kid;
720     if (class($op) eq "UNOP") {
721         $kid = $op->first;
722         $kid = "(" . $self->deparse($kid) . ")";
723     } elsif (class($op) eq "GVOP") {
724         $kid = "(" . $self->pp_gv($op) . ")";
725     } else { # I don't think baseop filetests ever survive ck_ftst, but...
726         $kid = "";
727     }
728     return "$name$kid";
729 }
730
731 sub pp_lstat { ftst(@_, "lstat") }
732 sub pp_stat { ftst(@_, "stat") }
733 sub pp_ftrread { ftst(@_, "-R") }
734 sub pp_ftrwrite { ftst(@_, "-W") }
735 sub pp_ftrexec { ftst(@_, "-X") }
736 sub pp_fteread { ftst(@_, "-r") }
737 sub pp_ftewrite { ftst(@_, "-r") }
738 sub pp_fteexec { ftst(@_, "-r") }
739 sub pp_ftis { ftst(@_, "-e") }
740 sub pp_fteowned { ftst(@_, "-O") }
741 sub pp_ftrowned { ftst(@_, "-o") }
742 sub pp_ftzero { ftst(@_, "-z") }
743 sub pp_ftsize { ftst(@_, "-s") }
744 sub pp_ftmtime { ftst(@_, "-M") }
745 sub pp_ftatime { ftst(@_, "-A") }
746 sub pp_ftctime { ftst(@_, "-C") }
747 sub pp_ftsock { ftst(@_, "-S") }
748 sub pp_ftchr { ftst(@_, "-c") }
749 sub pp_ftblk { ftst(@_, "-b") }
750 sub pp_ftfile { ftst(@_, "-f") }
751 sub pp_ftdir { ftst(@_, "-d") }
752 sub pp_ftpipe { ftst(@_, "-p") }
753 sub pp_ftlink { ftst(@_, "-l") }
754 sub pp_ftsuid { ftst(@_, "-u") }
755 sub pp_ftsgid { ftst(@_, "-g") }
756 sub pp_ftsvtx { ftst(@_, "-k") }
757 sub pp_fttty { ftst(@_, "-t") }
758 sub pp_fttext { ftst(@_, "-T") }
759 sub pp_ftbinary { ftst(@_, "-B") }
760
761 sub SWAP_CHILDREN () { 1 }
762 sub ASSIGN () { 2 } # has OP= variant
763
764 sub OPf_STACKED () { 64 }
765
766 sub binop {
767     my $self = shift;
768     my ($op, $opname, $flags) = (@_, 0);
769     my $left = $op->first;
770     my $right = $op->last;
771     my $eq = ($op->flags & OPf_STACKED && $flags & ASSIGN) ? "=" : "";
772     if ($flags & SWAP_CHILDREN) {
773         ($left, $right) = ($right, $left);
774     }
775     $left = $self->deparse($left);
776     $right = $self->deparse($right);
777     return "($left $opname$eq $right)";
778 }
779
780 sub pp_add { binop(@_, "+", ASSIGN) }
781 sub pp_multiply { binop(@_, "*", ASSIGN) }
782 sub pp_subtract { binop(@_, "-", ASSIGN) }
783 sub pp_divide { binop(@_, "/", ASSIGN) }
784 sub pp_modulo { binop(@_, "%", ASSIGN) }
785 sub pp_i_add { binop(@_, "+", ASSIGN) }
786 sub pp_i_multiply { binop(@_, "*", ASSIGN) }
787 sub pp_i_subtract { binop(@_, "-", ASSIGN) }
788 sub pp_i_divide { binop(@_, "/", ASSIGN) }
789 sub pp_i_modulo { binop(@_, "%", ASSIGN) }
790 sub pp_pow { binop(@_, "**", ASSIGN) }
791
792 sub pp_left_shift { binop(@_, "<<", ASSIGN) }
793 sub pp_right_shift { binop(@_, ">>", ASSIGN) }
794 sub pp_bit_and { binop(@_, "&", ASSIGN) }
795 sub pp_bit_or { binop(@_, "|", ASSIGN) }
796 sub pp_bit_xor { binop(@_, "^", ASSIGN) }
797
798 sub pp_eq { binop(@_, "==") }
799 sub pp_ne { binop(@_, "!=") }
800 sub pp_lt { binop(@_, "<") }
801 sub pp_gt { binop(@_, ">") }
802 sub pp_ge { binop(@_, ">=") }
803 sub pp_le { binop(@_, "<=") }
804 sub pp_ncmp { binop(@_, "<=>") }
805 sub pp_i_eq { binop(@_, "==") }
806 sub pp_i_ne { binop(@_, "!=") }
807 sub pp_i_lt { binop(@_, "<") }
808 sub pp_i_gt { binop(@_, ">") }
809 sub pp_i_ge { binop(@_, ">=") }
810 sub pp_i_le { binop(@_, "<=") }
811 sub pp_i_ncmp { binop(@_, "<=>") }
812
813 sub pp_seq { binop(@_, "eq") }
814 sub pp_sne { binop(@_, "ne") }
815 sub pp_slt { binop(@_, "lt") }
816 sub pp_sgt { binop(@_, "gt") }
817 sub pp_sge { binop(@_, "ge") }
818 sub pp_sle { binop(@_, "le") }
819 sub pp_scmp { binop(@_, "cmp") }
820
821 sub pp_sassign { binop(@_, "=", SWAP_CHILDREN) }
822 sub pp_aassign { binop(@_, "=", SWAP_CHILDREN) }
823
824 # `.' is special because concats-of-concats are optimized to save copying
825 # by making all but the first concat stacked. The effect is as if the
826 # programmer had written `($a . $b) .= $c', except legal.
827 sub pp_concat {
828     my $self = shift;
829     my $op = shift;
830     my $left = $op->first;
831     my $right = $op->last;
832     my $eq = "";
833     if ($op->flags & OPf_STACKED and $op->first->ppaddr ne "pp_concat") {
834         $eq = "=";
835     }
836     $left = $self->deparse($left);
837     $right = $self->deparse($right);
838     return "($left .$eq $right)";
839 }
840
841 # `x' is weird when the left arg is a list
842 sub pp_repeat {
843     my $self = shift;
844     my $op = shift;
845     my $left = $op->first;
846     my $right = $op->last;
847     my $eq = ($op->flags & OPf_STACKED) ? "=" : "";
848     if (null($right)) { # list repeat; count is inside left-side ex-list
849         my $kid = $left->first->sibling; # skip pushmark
850         my @exprs;
851         for (; !null($kid->sibling); $kid = $kid->sibling) {
852             push @exprs, $self->deparse($kid);
853         }
854         $right = $kid;
855         $left = "(" . join(", ", @exprs). ")";
856     } else {
857         $left = $self->deparse($left);
858     }
859     $right = $self->deparse($right);
860     return "($left x$eq $right)";
861 }
862
863 sub range {
864     my $self = shift;
865     my ($op, $type) = @_;
866     my $left = $op->first;
867     my $right = $left->sibling;
868     $left = $self->deparse($left);
869     $right = $self->deparse($right);
870     return "($left " . $type . " $right)";
871 }
872
873 sub pp_flop {
874     my $self = shift;
875     my $op = shift;
876     my $flip = $op->first;
877     my $type = ($flip->flags & OPf_SPECIAL) ? "..." : "..";
878     return $self->range($flip->first, $type);
879 }
880
881 # one-line while/until is handled in pp_leave
882
883 sub logop {
884     my $self = shift;
885     my ($op, $opname, $blockname) = @_;
886     my $left = $op->first;
887     my $right = $op->first->sibling;
888     $left = $self->deparse($left);
889     my $scope = is_scope($right);
890     $right = $self->deparse($right);
891     if ($scope) {
892         return "$blockname ($left) {\n\t$right\n\b}";
893     } else {
894         return "($left $opname $right)";
895     }
896 }
897
898 sub pp_and { logop(@_, "&&", "if") }
899 sub pp_or { logop(@_, "||", "unless") }
900 sub pp_xor { logop(@_, "xor", "n/a") }
901
902 sub logassignop {
903     my $self = shift;
904     my ($op, $opname) = @_;
905     my $left = $op->first;
906     my $right = $op->first->sibling->first; # skip sassign
907     $left = $self->deparse($left);
908     $right = $self->deparse($right);
909     return "($left $opname $right)";
910 }
911
912 sub pp_andassign { logassignop(@_, "&&=") }
913 sub pp_orassign { logassignop(@_, "||=") }
914
915 sub listop {
916     my $self = shift;
917     my($op, $name) = @_;
918     my($kid, $expr, @exprs);
919     for ($kid = $op->first->sibling; !null($kid); $kid = $kid->sibling) {
920         $expr = $self->deparse($kid);
921         push @exprs, $expr;
922     }
923     return "$name(" . join(", ", @exprs) . ")";
924 }
925
926 sub pp_bless { listop(@_, "bless") }
927 sub pp_atan2 { listop(@_, "atan2") }
928 sub pp_substr { maybe_local(@_, listop(@_, "substr")) }
929 sub pp_vec { maybe_local(@_, listop(@_, "vec")) }
930 sub pp_index { listop(@_, "index") }
931 sub pp_rindex { listop(@_, "rindex") }
932 sub pp_sprintf { listop(@_, "sprintf") }
933 sub pp_formline { listop(@_, "formline") } # see also deparse_format
934 sub pp_crypt { listop(@_, "crypt") }
935 sub pp_unpack { listop(@_, "unpack") }
936 sub pp_pack { listop(@_, "pack") }
937 sub pp_join { listop(@_, "join") }
938 sub pp_splice { listop(@_, "splice") }
939 sub pp_push { listop(@_, "push") }
940 sub pp_unshift { listop(@_, "unshift") }
941 sub pp_reverse { listop(@_, "reverse") }
942 sub pp_warn { listop(@_, "warn") }
943 sub pp_die { listop(@_, "die") }
944 sub pp_return { listop(@_, "return") }
945 sub pp_open { listop(@_, "open") }
946 sub pp_pipe_op { listop(@_, "pipe") }
947 sub pp_tie { listop(@_, "tie") }
948 sub pp_dbmopen { listop(@_, "dbmopen") }
949 sub pp_sselect { listop(@_, "select") }
950 sub pp_select { listop(@_, "select") }
951 sub pp_read { listop(@_, "read") }
952 sub pp_sysopen { listop(@_, "sysopen") }
953 sub pp_sysseek { listop(@_, "sysseek") }
954 sub pp_sysread { listop(@_, "sysread") }
955 sub pp_syswrite { listop(@_, "syswrite") }
956 sub pp_send { listop(@_, "send") }
957 sub pp_recv { listop(@_, "recv") }
958 sub pp_seek { listop(@_, "seek") }
959 sub pp_truncate { listop(@_, "truncate") }
960 sub pp_fcntl { listop(@_, "fcntl") }
961 sub pp_ioctl { listop(@_, "ioctl") }
962 sub pp_flock { listop(@_, "flock") }
963 sub pp_socket { listop(@_, "socket") }
964 sub pp_sockpair { listop(@_, "sockpair") }
965 sub pp_bind { listop(@_, "bind") }
966 sub pp_connect { listop(@_, "connect") }
967 sub pp_listen { listop(@_, "listen") }
968 sub pp_accept { listop(@_, "accept") }
969 sub pp_shutdown { listop(@_, "shutdown") }
970 sub pp_gsockopt { listop(@_, "getsockopt") }
971 sub pp_ssockopt { listop(@_, "setsockopt") }
972 sub pp_chown { listop(@_, "chown") }
973 sub pp_unlink { listop(@_, "unlink") }
974 sub pp_chmod { listop(@_, "chmod") }
975 sub pp_utime { listop(@_, "utime") }
976 sub pp_rename { listop(@_, "rename") }
977 sub pp_link { listop(@_, "link") }
978 sub pp_symlink { listop(@_, "symlink") }
979 sub pp_mkdir { listop(@_, "mkdir") }
980 sub pp_open_dir { listop(@_, "opendir") }
981 sub pp_seekdir { listop(@_, "seekdir") }
982 sub pp_waitpid { listop(@_, "waitpid") }
983 sub pp_system { listop(@_, "system") }
984 sub pp_exec { listop(@_, "exec") }
985 sub pp_kill { listop(@_, "kill") }
986 sub pp_setpgrp { listop(@_, "setpgrp") }
987 sub pp_getpriority { listop(@_, "getpriority") }
988 sub pp_setpriority { listop(@_, "setpriority") }
989 sub pp_shmget { listop(@_, "shmget") }
990 sub pp_shmctl { listop(@_, "shmctl") }
991 sub pp_shmread { listop(@_, "shmread") }
992 sub pp_shmwrite { listop(@_, "shmwrite") }
993 sub pp_msgget { listop(@_, "msgget") }
994 sub pp_msgctl { listop(@_, "msgctl") }
995 sub pp_msgsnd { listop(@_, "msgsnd") }
996 sub pp_msgrcv { listop(@_, "msgrcv") }
997 sub pp_semget { listop(@_, "semget") }
998 sub pp_semctl { listop(@_, "semctl") }
999 sub pp_semop { listop(@_, "semop") }
1000 sub pp_ghbyaddr { listop(@_, "gethostbyaddr") }
1001 sub pp_gnbyaddr { listop(@_, "getnetbyaddr") }
1002 sub pp_gpbynumber { listop(@_, "getprotobynumber") }
1003 sub pp_gsbyname { listop(@_, "getservbyname") }
1004 sub pp_gsbyport { listop(@_, "getservbyport") }
1005 sub pp_syscall { listop(@_, "syscall") }
1006
1007 sub pp_glob {
1008     my $self = shift;
1009     my $op = shift;
1010     my $text = $self->dq($op->first->sibling);  # skip pushmark
1011     if ($text =~ /^\$?(\w|::|\`)+$/ # could look like a readline
1012         or $text =~ /[<>]/) { 
1013         return 'glob(' . single_delim('qq', '"', $text) . ')';
1014     } else {
1015         return '<' . $text . '>';
1016     }
1017 }
1018
1019 sub indirop {
1020     my $self = shift;
1021     my($op, $name) = (@_, 0);
1022     my($expr, @exprs);
1023     my $kid = $op->first->sibling;
1024     my $indir = "";
1025     if ($op->flags & OPf_STACKED) {
1026         $indir = $kid;
1027         $indir = $indir->first; # skip rv2gv
1028         if (is_scope($indir)) {
1029             $indir = "{" . $self->deparse($indir) . "}";
1030         } else {
1031             $indir = $self->deparse($indir);
1032         }
1033         $indir = $indir . " ";
1034         $kid = $kid->sibling;
1035     }
1036     for (; !null($kid); $kid = $kid->sibling) {
1037         $expr = $self->deparse($kid);
1038         push @exprs, $expr;
1039     }
1040     return "$name($indir" . join(", ", @exprs) . ")";
1041 }
1042
1043 sub pp_prtf { indirop(@_, "printf") }
1044 sub pp_print { indirop(@_, "print") }
1045 sub pp_sort { indirop(@_, "sort") }
1046
1047 sub mapop {
1048     my $self = shift;
1049     my($op, $name) = @_;
1050     my($expr, @exprs);
1051     my $kid = $op->first; # this is the (map|grep)start
1052     $kid = $kid->first->sibling; # skip a pushmark
1053     my $code = $kid->first; # skip a null
1054     if (is_scope $code) {
1055         $code = "{" . $self->deparse($code) . "} ";
1056     } else {
1057         $code = $self->deparse($code) . ", ";
1058     }
1059     $kid = $kid->sibling;
1060     for (; !null($kid); $kid = $kid->sibling) {
1061         $expr = $self->deparse($kid);
1062         push @exprs, $expr if $expr;
1063     }
1064     return "$name($code" . join(", ", @exprs) . ")";
1065 }
1066
1067 sub pp_mapwhile { mapop(@_, "map") }   
1068 sub pp_grepwhile { mapop(@_, "grep") }   
1069
1070 sub pp_list {
1071     my $self = shift;
1072     my $op = shift;
1073     my($expr, @exprs);
1074     my $kid = $op->first->sibling; # skip pushmark
1075     my $lop;
1076     my $local = "either"; # could be local(...) or my(...)
1077     for ($lop = $kid; !null($lop); $lop = $lop->sibling) {
1078         # This assumes that no other private flags equal 128, and that
1079         # OPs that store things other than flags in their op_private,
1080         # like OP_AELEMFAST, won't be immediate children of a list.
1081         unless ($lop->private & OPp_LVAL_INTRO or $lop->ppaddr eq "pp_undef")
1082         {
1083             $local = ""; # or not
1084             last;
1085         }
1086         if ($lop->ppaddr =~ /^pp_pad[ash]v$/) { # my()
1087             ($local = "", last) if $local eq "local";
1088             $local = "my";
1089         } elsif ($lop->ppaddr ne "pp_undef") { # local()
1090             ($local = "", last) if $local eq "my";
1091             $local = "local";
1092         }
1093     }
1094     $local = "" if $local eq "either"; # no point if it's all undefs
1095     for (; !null($kid); $kid = $kid->sibling) {
1096         if ($local) {
1097             if (class($kid) eq "UNOP" and $kid->first->ppaddr eq "pp_gvsv") {
1098                 $lop = $kid->first;
1099             } else {
1100                 $lop = $kid;
1101             }
1102             $self->{'avoid_local'}{$$lop}++;
1103             $expr = $self->deparse($kid);
1104             delete $self->{'avoid_local'}{$$lop};
1105         } else {
1106             $expr = $self->deparse($kid);
1107         }
1108         push @exprs, $expr;
1109     }
1110     return "$local(" . join(", ", @exprs) . ")";
1111 }
1112
1113 sub pp_cond_expr {
1114     my $self = shift;
1115     my $op = shift;
1116     my $cond = $op->first;
1117     my $true = $cond->sibling;
1118     my $false = $true->sibling;
1119     my $braces = 0;
1120     $cond = $self->deparse($cond);
1121     $braces = 1 if is_scope($true) or is_scope($false);
1122     $true = $self->deparse($true);
1123     if ($false->ppaddr eq "pp_lineseq") { # braces w/o scope => elsif
1124         my $head = "if ($cond) {\n\t$true\n\b}";
1125         my @elsifs;
1126         while (!null($false) and $false->ppaddr eq "pp_lineseq") {
1127             my $newop = $false->first->sibling->first;
1128             my $newcond = $newop->first;
1129             my $newtrue = $newcond->sibling;
1130             $false = $newtrue->sibling; # last in chain is OP_AND => no else
1131             $newcond = $self->deparse($newcond);
1132             $newtrue = $self->deparse($newtrue);
1133             push @elsifs, "elsif ($newcond) {\n\t$newtrue\n\b}";
1134         }
1135         if (!null($false)) {        
1136             $false = "\nelse {\n\t" . $self->deparse($false) . "\n\b}";
1137         } else {
1138             $false = "";
1139         }
1140         return $head . join("\n", "", @elsifs) . $false; 
1141     }
1142     $false = $self->deparse($false);
1143     if ($braces) {
1144         return "if ($cond) {\n\t$true\n\b}\nelse {\n\t$false\n\b}";
1145     } else {
1146         return "($cond ? $true : $false)";
1147     }
1148 }
1149
1150 sub pp_leaveloop {
1151     my $self = shift;
1152     my $op = shift;
1153     my $enter = $op->first;
1154     my $kid = $enter->sibling;
1155     local($self->{'curstash'}) = $self->{'curstash'};
1156     my $head = "";
1157     if ($kid->ppaddr eq "pp_lineseq") { # bare or infinite loop 
1158         if (is_state $kid->last) { # infinite
1159             $head = "for (;;) "; # shorter than while (1)
1160         }
1161     } elsif ($enter->ppaddr eq "pp_enteriter") { # foreach
1162         my $ary = $enter->first->sibling; # first was pushmark
1163         my $var = $ary->sibling;
1164         $ary = $self->deparse($ary);
1165         if (null $var) {
1166             $var = $self->pp_padsv($enter);
1167             if ($self->padname_sv($enter->targ)->IVX ==
1168                 $kid->first->first->sibling->last->cop_seq)
1169             {
1170                 # If the scope of this variable closes at the last
1171                 # statement of the loop, it must have been declared here.
1172                 $var = "my " . $var;
1173             }
1174         } elsif ($var->ppaddr eq "pp_rv2gv") {
1175             $var = $self->pp_rv2sv($var);
1176         } elsif ($var->ppaddr eq "pp_gv") {
1177             $var = "\$" . $self->deparse($var);
1178         }
1179         $head = "foreach $var $ary ";
1180         $kid = $kid->first->first->sibling; # skip OP_AND and OP_ITER
1181     } elsif ($kid->ppaddr eq "pp_null") { # while/until
1182         $kid = $kid->first;
1183         my $name = {"pp_and" => "while", "pp_or" => "until"}
1184                     ->{$kid->ppaddr};
1185         $head = "$name (" . $self->deparse($kid->first) . ") ";
1186         $kid = $kid->first->sibling;
1187     }
1188     # The third-to-last kid is the continue block if the pointer used
1189     # by `next BLOCK' points to its nulled-out nextstate, which is its
1190     # first or second kid depending on whether the block was optimized
1191     # to a OP_SCOPE.
1192     my $cont = $kid;
1193     unless ($kid->ppaddr eq "pp_stub") { # empty bare loop
1194         $cont = $kid->first;
1195         unless (null $cont->sibling->sibling) {
1196             while (!null($cont->sibling->sibling->sibling)) {
1197                 $cont = $cont->sibling;
1198             }
1199         }
1200     }
1201     if (is_scope($cont) 
1202         and $ {$enter->nextop} == $ {$cont->first}
1203             || $ {$enter->nextop} == $ {$cont->first->sibling})
1204     {
1205         my $state = $kid->first;
1206         my($expr, @exprs);
1207         for (; $$state != $$cont; $state = $state->sibling) {
1208             $expr = "";
1209             if (is_state $state) {
1210                 $expr = $self->deparse($state);
1211                 $state = $state->sibling;
1212                 last if null $kid;
1213             }
1214             $expr .= $self->deparse($state);
1215             push @exprs, $expr if $expr;
1216         }
1217         $kid = join(";\n", @exprs);
1218         $cont = " continue {\n\t" . $self->deparse($cont) . "\n\b}\n";
1219     } else {
1220         $cont = "";
1221         $kid = $self->deparse($kid);
1222     }
1223     return $head . "{\n\t" . $kid . "\n\b}" . $cont;
1224 }
1225
1226 sub pp_leavetry {
1227     my $self = shift;
1228     return "eval {\n\t" . $self->pp_leave($_[0]) . "\n\b}";
1229 }
1230
1231 sub OP_CONST () { 5 }
1232 sub OP_STRINGIFY () { 65 }
1233
1234 sub pp_null {
1235     my $self = shift;
1236     my $op = shift;
1237     if (class($op) eq "OP") {
1238         return "'???'" if $op->targ == OP_CONST; # old value is lost
1239     } elsif ($op->first->ppaddr eq "pp_pushmark") {
1240         return $self->pp_list($op);
1241     } elsif ($op->first->ppaddr eq "pp_enter") {
1242         return $self->pp_leave($op);
1243     } elsif ($op->targ == OP_STRINGIFY) {
1244         return $self->dquote($op);
1245     } elsif (!null($op->first->sibling) and
1246              $op->first->sibling->ppaddr eq "pp_readline" and
1247              $op->first->sibling->flags & OPf_STACKED) {
1248         return "(" . $self->deparse($op->first) . " = "
1249             . $self->deparse($op->first->sibling) . ")";
1250     } elsif (!null($op->first->sibling) and
1251              $op->first->sibling->ppaddr eq "pp_trans" and
1252              $op->first->sibling->flags & OPf_STACKED) {
1253         return "(" . $self->deparse($op->first) . " =~ "
1254             . $self->deparse($op->first->sibling) . ")";
1255     } else {
1256         return $self->deparse($op->first);
1257     }
1258 }
1259
1260 sub padname {
1261     my $self = shift;
1262     my $targ = shift;
1263     my $str = $self->padname_sv($targ)->PV;
1264     return padname_fix($str);
1265 }
1266
1267 sub padany {
1268     my $self = shift;
1269     my $op = shift;
1270     return substr($self->padname($op->targ), 1); # skip $/@/%
1271 }
1272
1273 sub pp_padsv {
1274     my $self = shift;
1275     my $op = shift;
1276     return $self->maybe_my($op, $self->padname($op->targ));
1277 }
1278
1279 sub pp_padav { pp_padsv(@_) }
1280 sub pp_padhv { pp_padsv(@_) }
1281
1282 sub pp_gvsv {
1283     my $self = shift;
1284     my $op = shift;
1285     return $self->maybe_local($op, "\$" . $self->gv_name($op->gv));
1286 }
1287
1288 sub pp_gv {
1289     my $self = shift;
1290     my $op = shift;
1291     return $self->gv_name($op->gv);
1292 }
1293
1294 sub pp_aelemfast {
1295     my $self = shift;
1296     my $op = shift;
1297     my $gv = $op->gv;
1298     return "\$" . $self->gv_name($gv) . "[" . $op->private . "]";
1299 }
1300
1301 sub rv2x {
1302     my $self = shift;
1303     my($op, $type) = @_;
1304     my $kid = $op->first;
1305     my $scope = is_scope($kid);
1306     $kid = $self->deparse($kid);
1307     return $type . ($scope ? "{$kid}" : $kid);
1308 }
1309
1310 sub pp_rv2sv { maybe_local(@_, rv2x(@_, "\$")) }
1311 sub pp_rv2hv { maybe_local(@_, rv2x(@_, "%")) }
1312 sub pp_rv2gv { maybe_local(@_, rv2x(@_, "*")) }
1313
1314 # skip rv2av
1315 sub pp_av2arylen {
1316     my $self = shift;
1317     my $op = shift;
1318     if ($op->first->ppaddr eq "pp_padav") {
1319         return $self->maybe_local($op, '$#' . $self->padany($op->first));
1320     } else {
1321         return $self->maybe_local($op, $self->rv2x($op->first, '$#'));
1322     }
1323 }
1324
1325 # skip down to the old, ex-rv2cv
1326 sub pp_rv2cv { $_[0]->rv2x($_[1]->first->first->sibling, "&") }
1327
1328 sub pp_rv2av {
1329     my $self = shift;
1330     my $op = shift;
1331     my $kid = $op->first;
1332     if ($kid->ppaddr eq "pp_const") { # constant list
1333         my $av = $kid->sv;
1334         return "(" . join(", ", map(const($_), $av->ARRAY)) . ")";
1335     } else {
1336         return $self->maybe_local($op, $self->rv2x($op, "\@"));
1337     }
1338  }
1339
1340
1341 sub elem {
1342     my $self = shift;
1343     my ($op, $left, $right, $padname) = @_;
1344     my($array, $idx) = ($op->first, $op->first->sibling);
1345     unless ($array->ppaddr eq $padname) { # Maybe this has been fixed   
1346         $array = $array->first; # skip rv2av (or ex-rv2av in _53+)
1347     }
1348     if ($array->ppaddr eq $padname) {
1349         $array = $self->padany($array);
1350     } elsif (is_scope($array)) { # ${expr}[0]
1351         $array = "{" . $self->deparse($array) . "}";
1352     } elsif (is_scalar $array) { # $x[0], $$x[0], ...
1353         $array = $self->deparse($array);
1354     } else {
1355         # $x[20][3]{hi} or expr->[20]
1356         my $arrow;
1357         $arrow = "->" if $array->ppaddr !~ /^pp_[ah]elem$/;
1358         return $self->deparse($array) . $arrow .
1359             $left . $self->deparse($idx) . $right;
1360     }
1361     $idx = $self->deparse($idx);
1362     return "\$" . $array . $left . $idx . $right;
1363 }
1364
1365 sub pp_aelem { maybe_local(@_, elem(@_, "[", "]", "pp_padav")) }
1366 sub pp_helem { maybe_local(@_, elem(@_, "{", "}", "pp_padhv")) }
1367
1368 sub pp_gelem {
1369     my $self = shift;
1370     my $op = shift;
1371     my($glob, $part) = ($op->first, $op->last);
1372     $glob = $glob->first; # skip rv2gv
1373     $glob = $glob->first if $glob->ppaddr eq "pp_rv2gv"; # this one's a bug
1374     my $scope = (is_scope($glob));
1375     $glob = $self->deparse($glob);
1376     $part = $self->deparse($part);
1377     return "*" . ($scope ? "{$glob}" : $glob) . "{$part}";
1378 }
1379
1380 sub slice {
1381     my $self = shift;
1382     my ($op, $left, $right, $regname, $padname) = @_;
1383     my $last;
1384     my(@elems, $kid, $array, $list);
1385     if (class($op) eq "LISTOP") {
1386         $last = $op->last;
1387     } else { # ex-hslice inside delete()
1388         for ($kid = $op->first; !null $kid->sibling; $kid = $kid->sibling) {}
1389         $last = $kid;
1390     }
1391     $array = $last;
1392     $array = $array->first
1393         if $array->ppaddr eq $regname or $array->ppaddr eq "pp_null";
1394     if (is_scope($array)) {
1395         $array = "{" . $self->deparse($array) . "}";
1396     } elsif ($array->ppaddr eq $padname) {
1397         $array = $self->padany($array);
1398     } else {
1399         $array = $self->deparse($array);
1400     }
1401     $kid = $op->first->sibling; # skip pushmark
1402     if ($kid->ppaddr eq "pp_list") {
1403         $kid = $kid->first->sibling; # skip list, pushmark
1404         for (; !null $kid; $kid = $kid->sibling) {
1405             push @elems, $self->deparse($kid);
1406         }
1407         $list = join(", ", @elems);
1408     } else {
1409         $list = $self->deparse($kid);
1410     }
1411     return "\@" . $array . $left . $list . $right;
1412 }
1413
1414 sub pp_aslice { maybe_local(@_, slice(@_, "[", "]", 
1415                                       "pp_rv2av", "pp_padav")) }
1416 sub pp_hslice { maybe_local(@_, slice(@_, "{", "}",
1417                                       "pp_rv2hv", "pp_padhv")) }
1418
1419 sub pp_lslice {
1420     my $self = shift;
1421     my $op = shift;
1422     my $idx = $op->first;
1423     my $list = $op->last;
1424     my(@elems, $kid);
1425     $list = $self->deparse($list); # will always have parens
1426     $idx = $self->deparse($idx);
1427     return $list . "[$idx]";
1428 }
1429
1430 sub OPpENTERSUB_AMPER () { 8 }
1431
1432 sub OPf_WANT () { 3 }
1433 sub OPf_WANT_VOID () { 1 }
1434 sub OPf_WANT_SCALAR () { 2 }
1435 sub OPf_WANT_LIST () { 2 }
1436
1437 sub want_scalar {
1438     my $op = shift;
1439     return ($op->flags & OPf_WANT) == OPf_WANT_SCALAR;
1440 }
1441
1442 sub pp_entersub {
1443     my $self = shift;
1444     my $op = shift;
1445     my $prefix = "";
1446     my $amper = "";
1447     my $proto = undef;
1448     my($kid, $args, @exprs);
1449     if ($op->flags & OPf_SPECIAL) {
1450         $prefix = "do ";
1451     } elsif ($op->private & OPpENTERSUB_AMPER) {
1452         $amper = "&";
1453     }
1454     if (not null $op->first->sibling) {
1455         $kid = $op->first->sibling; # skip pushmark
1456         my $obj = $self->deparse($kid);
1457         $kid = $kid->sibling;
1458         for (; not null $kid->sibling; $kid = $kid->sibling) {
1459             push @exprs, $self->deparse($kid);
1460         }
1461         my $meth = $kid->first;
1462         if ($meth->ppaddr eq "pp_const") {
1463             $meth = $meth->sv->PV; # needs to be bare
1464         } else {
1465             $meth = $self->deparse($meth);
1466         }
1467         $prefix = "";
1468         $args = join(", ", @exprs);     
1469         $kid = $obj . "->" . $meth;
1470     } else {
1471         $kid = $op->first;
1472         $kid = $kid->first->sibling; # skip ex-list, pushmark
1473         for (; not null $kid->sibling; $kid = $kid->sibling) {
1474             push @exprs, $kid;
1475         }
1476         if (is_scope($kid)) {
1477             $kid = "{" . $self->deparse($kid) . "}";
1478         } elsif ($kid->first->ppaddr eq "pp_gv") {
1479             my $gv = $kid->first->gv;
1480             if (class($gv->CV) ne "SPECIAL") {
1481                 $proto = $gv->CV->PV if $gv->CV->FLAGS & SVf_POK;
1482             }
1483             $kid = $self->deparse($kid);
1484         } elsif (is_scalar $kid->first) {
1485             $amper = "&";
1486             $kid = $self->deparse($kid);
1487         } else {
1488             $prefix = "";
1489             $kid = $self->deparse($kid) . "->";
1490         }
1491         if (defined $proto and not $amper) {
1492             my($arg, $real);
1493             my $doneok = 0;
1494             my @args = @exprs;
1495             my @reals;
1496             $proto =~ s/([^\\]|^)([@%])(.*)$/$1$2/;
1497             while ($proto) {
1498                 $proto =~ s/^ *([\\]?[\$\@&%*]|;)//;
1499                 my $chr = $1;
1500                 if ($chr eq "") {
1501                     undef $proto if @args;
1502                 } elsif ($chr eq ";") {
1503                     $doneok = 1;
1504                 } elsif ($chr eq "@" or $chr eq "%") {
1505                     push @reals, map($self->deparse($_), @args);
1506                     @args = ();
1507                 } else {
1508                     $arg = shift @args;
1509                     undef $proto, last unless $arg;
1510                     if ($chr eq "\$") {
1511                         if (want_scalar $arg) {
1512                             push @reals, $self->deparse($arg);
1513                         } else {
1514                             undef $proto;
1515                         }
1516                     } elsif ($chr eq "&") {
1517                         if ($arg->ppaddr =~ /pp_(s?refgen|undef)/) {
1518                             push @reals, $self->deparse($arg);
1519                         } else {
1520                             undef $proto;
1521                         }
1522                     } elsif ($chr eq "*") {
1523                         if ($arg->ppaddr =~ /^pp_s?refgen$/
1524                             and $arg->first->first->ppaddr eq "pp_rv2gv")
1525                         {
1526                             $real = $arg->first->first; # skip refgen, null
1527                             if ($real->first->ppaddr eq "pp_gv") {
1528                                 push @reals, $self->deparse($real);
1529                             } else {
1530                                 push @reals, $self->deparse($real->first);
1531                             }
1532                         } else {
1533                             undef $proto;
1534                         }
1535                     } elsif (substr($chr, 0, 1) eq "\\") {
1536                         $chr = substr($chr, 1);
1537                         if ($arg->ppaddr =~ /^pp_s?refgen$/ and
1538                             !null($real = $arg->first) and
1539                             ($chr eq "\$" && is_scalar($real->first)
1540                              or ($chr eq "\@"
1541                                  && $real->first->sibling->ppaddr 
1542                                  =~ /^pp_(rv2|pad)av$/)
1543                              or ($chr eq "%"
1544                                  && $real->first->sibling->ppaddr
1545                                  =~ /^pp_(rv2|pad)hv$/)
1546                              #or ($chr eq "&" # This doesn't work
1547                              #   && $real->first->ppaddr eq "pp_rv2cv")
1548                              or ($chr eq "*"
1549                                  && $real->first->ppaddr eq "pp_rv2gv")))
1550                         {
1551                             push @reals, $self->deparse($real);
1552                         } else {
1553                             undef $proto;
1554                         }
1555                     }
1556                 }
1557             }
1558             undef $proto if $proto and !$doneok;
1559             undef $proto if @args;
1560             $args = join(", ", @reals);
1561             $amper = "";
1562             unless (defined $proto) {
1563                 $amper = "&";
1564                 $args = join(", ", map($self->deparse($_), @exprs));
1565             }
1566         } else {
1567             $args = join(", ", map($self->deparse($_), @exprs));
1568         }
1569     }
1570     if ($op->flags & OPf_STACKED) {
1571         return $prefix . $amper . $kid . "(" . $args . ")";
1572     } else {
1573         return $prefix . $amper. $kid;
1574     }
1575 }
1576
1577 sub pp_enterwrite { unop(@_, "write") }
1578
1579 # escape things that cause interpolation in double quotes,
1580 # but not character escapes
1581 sub uninterp {
1582     my($str) = @_;
1583     $str =~ s/(^|[^\\])([\$\@]|\\[uUlLQE])/$1\\$2/;
1584     return $str;
1585 }
1586
1587 # character escapes, but not delimiters that might need to be escaped
1588 sub escape_str { # ASCII
1589     my($str) = @_;
1590     $str =~ s/\\/\\\\/g;
1591     $str =~ s/\a/\\a/g;
1592 #    $str =~ s/\cH/\\b/g; # \b means someting different in a regex 
1593     $str =~ s/\t/\\t/g;
1594     $str =~ s/\n/\\n/g;
1595     $str =~ s/\e/\\e/g;
1596     $str =~ s/\f/\\f/g;
1597     $str =~ s/\r/\\r/g;
1598     $str =~ s/([\cA-\cZ])/'\\c' . chr(ord('@') + ord($1))/ge;
1599     $str =~ s/([\0\033-\037\177-\377])/'\\' . sprintf("%03o", ord($1))/ge;
1600     return $str;
1601 }
1602
1603 sub balanced_delim {
1604     my($str) = @_;
1605     my @str = split //, $str;
1606     my($ar, $open, $close, $fail, $c, $cnt);
1607     for $ar (['[',']'], ['(',')'], ['<','>'], ['{','}']) {
1608         ($open, $close) = @$ar;
1609         $fail = 0; $cnt = 0;
1610         for $c (@str) {
1611             if ($c eq $open) {
1612                 $cnt++;
1613             } elsif ($c eq $close) {
1614                 $cnt--;
1615                 if ($cnt < 0) {
1616                     $fail = 1;
1617                     last;
1618                 }
1619             }
1620         }
1621         $fail = 1 if $cnt != 0;
1622         return ($open, "$open$str$close") if not $fail;
1623     }
1624     return ("", $str);
1625 }
1626
1627 sub single_delim {
1628     my($q, $default, $str) = @_;
1629     return "$default$str$default" if index($str, $default) == -1;
1630     my($succeed, $delim);
1631     ($succeed, $str) = balanced_delim($str);
1632     return "$q$str" if $succeed;
1633     for $delim ('/', '"', '#') {
1634         return "$q$delim" . $str . $delim if index($str, $delim) == -1;
1635     }
1636     $str =~ s/$default/\\$default/g;
1637     return "$default$str$default";
1638 }
1639
1640 sub SVf_IOK () {0x10000}
1641 sub SVf_NOK () {0x20000}
1642 sub SVf_ROK () {0x80000}
1643
1644 sub const {
1645     my $sv = shift;
1646     if (class($sv) eq "SPECIAL") {
1647         return ('undef', '1', '+0')[$$sv-1];
1648     } elsif ($sv->FLAGS & SVf_IOK) {
1649         return $sv->IV;
1650     } elsif ($sv->FLAGS & SVf_NOK) {
1651         return "0.0" unless $sv->NV;
1652         return $sv->NV;
1653     } elsif ($sv->FLAGS & SVf_ROK) {
1654         return "\\(" . const($sv->RV) . ")"; # constant folded
1655     } else {
1656         my $str = $sv->PV;
1657         if ($str =~ /[^ -~]/) { # ASCII
1658             return single_delim("qq", '"', uninterp(escape_str($str)));
1659         } else {
1660             $str =~ s/\\/\\\\/g;
1661             return single_delim("q", "'", $str);
1662         }
1663     }
1664 }
1665
1666 sub pp_const {
1667     my $self = shift;
1668     my $op = shift;
1669 #    if ($op->private & OPp_CONST_BARE) { # trouble with `=>' autoquoting 
1670 #       return $op->sv->PV;
1671 #    }
1672     return const($op->sv);
1673 }
1674
1675 sub dq {
1676     my $self = shift;
1677     my $op = shift;
1678     my $type = $op->ppaddr;
1679     if ($type eq "pp_const") {
1680         return uninterp(escape_str($op->sv->PV));
1681     } elsif ($type eq "pp_concat") {
1682         return $self->dq($op->first) . $self->dq($op->last);
1683     } elsif ($type eq "pp_uc") {
1684         return '\U' . $self->dq($op->first->sibling) . '\E';
1685     } elsif ($type eq "pp_lc") {
1686         return '\L' . $self->dq($op->first->sibling) . '\E';
1687     } elsif ($type eq "pp_ucfirst") {
1688         return '\u' . $self->dq($op->first->sibling);
1689     } elsif ($type eq "pp_lcfirst") {
1690         return '\l' . $self->dq($op->first->sibling);
1691     } elsif ($type eq "pp_quotemeta") {
1692         return '\Q' . $self->dq($op->first->sibling) . '\E';
1693     } elsif ($type eq "pp_join") {
1694         return $self->deparse($op->last); # was join($", @ary)
1695     } else {
1696         return $self->deparse($op);
1697     }
1698 }
1699
1700 sub pp_backtick {
1701     my $self = shift;
1702     my $op = shift;
1703     # skip pushmark
1704     return single_delim("qx", '`', $self->dq($op->first->sibling));
1705 }
1706
1707 sub dquote {
1708     my $self = shift;
1709     my $op = shift;
1710     # skip ex-stringify, pushmark
1711     return single_delim("qq", '"', $self->dq($op->first->sibling)); 
1712 }
1713
1714 # OP_STRINGIFY is a listop, but it only ever has one arg (?)
1715 sub pp_stringify { dquote(@_) }
1716
1717 # tr/// and s/// (and tr[][], tr[]//, tr###, etc)
1718 # note that tr(from)/to/ is OK, but not tr/from/(to)
1719 sub double_delim {
1720     my($from, $to) = @_;
1721     my($succeed, $delim);
1722     if ($from !~ m[/] and $to !~ m[/]) {
1723         return "/$from/$to/";
1724     } elsif (($succeed, $from) = balanced_delim($from) and $succeed) {
1725         if (($succeed, $to) = balanced_delim($to) and $succeed) {
1726             return "$from$to";
1727         } else {
1728             for $delim ('/', '"', '#') { # note no `'' -- s''' is special
1729                 return "$from$delim$to$delim" if index($to, $delim) == -1;
1730             }
1731             $to =~ s[/][\\/]g;
1732             return "$from/$to/";
1733         }
1734     } else {
1735         for $delim ('/', '"', '#') { # note no '
1736             return "$delim$from$delim$to$delim"
1737                 if index($to . $from, $delim) == -1;
1738         }
1739         $from =~ s[/][\\/]g;
1740         $to =~ s[/][\\/]g;
1741         return "/$from/$to/";   
1742     }
1743 }
1744
1745 sub pchr { # ASCII
1746     my($n) = @_;
1747     if ($n == ord '\\') {
1748         return '\\\\';
1749     } elsif ($n >= ord(' ') and $n <= ord('~')) {
1750         return chr($n);
1751     } elsif ($n == ord "\a") {
1752         return '\\a';
1753     } elsif ($n == ord "\b") {
1754         return '\\b';
1755     } elsif ($n == ord "\t") {
1756         return '\\t';
1757     } elsif ($n == ord "\n") {
1758         return '\\n';
1759     } elsif ($n == ord "\e") {
1760         return '\\e';
1761     } elsif ($n == ord "\f") {
1762         return '\\f';
1763     } elsif ($n == ord "\r") {
1764         return '\\r';
1765     } elsif ($n >= ord("\cA") and $n <= ord("\cZ")) {
1766         return '\\c' . chr(ord("@") + $n);
1767     } else {
1768 #       return '\x' . sprintf("%02x", $n);
1769         return '\\' . sprintf("%03o", $n);
1770     }
1771 }
1772
1773 sub collapse {
1774     my(@chars) = @_;
1775     my($c, $str, $tr);
1776     for ($c = 0; $c < @chars; $c++) {
1777         $tr = $chars[$c];
1778         $str .= pchr($tr);
1779         if ($c <= $#chars - 2 and $chars[$c + 1] == $tr + 1 and
1780             $chars[$c + 2] == $tr + 2)
1781         {
1782             for (; $c <= $#chars and $chars[$c + 1] == $chars[$c] + 1; $c++) {}
1783             $str .= "-";
1784             $str .= pchr($chars[$c]);
1785         }
1786     }
1787     return $str;
1788 }
1789
1790 sub OPpTRANS_SQUASH () { 16 }
1791 sub OPpTRANS_DELETE () { 32 }
1792 sub OPpTRANS_COMPLEMENT () { 64 }
1793
1794 sub pp_trans {
1795     my $self = shift;
1796     my $op = shift;
1797     my(@table) = unpack("s256", $op->pv);
1798     my($c, $tr, @from, @to, @delfrom, $delhyphen);
1799     if ($table[ord "-"] != -1 and 
1800         $table[ord("-") - 1] == -1 || $table[ord("-") + 1] == -1)
1801     {
1802         $tr = $table[ord "-"];
1803         $table[ord "-"] = -1;
1804         if ($tr >= 0) {
1805             @from = ord("-");
1806             @to = $tr;
1807         } else { # -2 ==> delete
1808             $delhyphen = 1;
1809         }
1810     }
1811     for ($c = 0; $c < 256; $c++) {
1812         $tr = $table[$c];
1813         if ($tr >= 0) {
1814             push @from, $c; push @to, $tr;
1815         } elsif ($tr == -2) {
1816             push @delfrom, $c;
1817         }
1818     }
1819     my $flags;
1820     @from = (@from, @delfrom);
1821     if ($op->private & OPpTRANS_COMPLEMENT) {
1822         $flags .= "c";
1823         my @newfrom = ();
1824         my %from;
1825         @from{@from} = (1) x @from;
1826         for ($c = 0; $c < 256; $c++) {
1827             push @newfrom, $c unless $from{$c};
1828         }
1829         @from = @newfrom;
1830     }
1831     if ($op->private & OPpTRANS_DELETE) {
1832         $flags .= "d";
1833     } else {
1834         pop @to while $#to and $to[$#to] == $to[$#to -1];
1835     }
1836     $flags .= "s" if $op->private & OPpTRANS_SQUASH;
1837     my($from, $to);
1838     $from = collapse(@from);
1839     $to = collapse(@to);
1840     $from .= "-" if $delhyphen;
1841     return "tr" . double_delim($from, $to) . $flags;
1842 }
1843
1844 # Like dq(), but different
1845 sub re_dq {
1846     my $self = shift;
1847     my $op = shift;
1848     my $type = $op->ppaddr;
1849     if ($type eq "pp_const") {
1850         return uninterp($op->sv->PV);
1851     } elsif ($type eq "pp_concat") {
1852         return $self->re_dq($op->first) . $self->re_dq($op->last);
1853     } elsif ($type eq "pp_uc") {
1854         return '\U' . $self->re_dq($op->first->sibling) . '\E';
1855     } elsif ($type eq "pp_lc") {
1856         return '\L' . $self->re_dq($op->first->sibling) . '\E';
1857     } elsif ($type eq "pp_ucfirst") {
1858         return '\u' . $self->re_dq($op->first->sibling);
1859     } elsif ($type eq "pp_lcfirst") {
1860         return '\l' . $self->re_dq($op->first->sibling);
1861     } elsif ($type eq "pp_quotemeta") {
1862         return '\Q' . $self->re_dq($op->first->sibling) . '\E';
1863     } elsif ($type eq "pp_join") {
1864         return $self->deparse($op->last); # was join($", @ary)
1865     } else {
1866         return $self->deparse($op);
1867     }
1868 }
1869
1870 sub pp_regcomp {
1871     my $self = shift;
1872     my $op = shift;
1873     my $kid = $op->first;
1874     $kid = $kid->first if $kid->ppaddr eq "pp_regcmaybe";
1875     return $self->re_dq($kid);
1876 }
1877
1878 sub OPp_RUNTIME () { 64 }
1879
1880 sub PMf_ONCE () { 0x2 }
1881 sub PMf_SKIPWHITE () { 0x10 }
1882 sub PMf_FOLD () { 0x20 }
1883 sub PMf_CONST () { 0x40 }
1884 sub PMf_KEEP () { 0x80 }
1885 sub PMf_GLOBAL () { 0x100 }
1886 sub PMf_CONTINUE () { 0x200 }
1887 sub PMf_EVAL () { 0x400 }
1888 sub PMf_MULTILINE () { 0x1000 }
1889 sub PMf_SINGLELINE () { 0x2000 }
1890 sub PMf_LOCALE () { 0x4000 }
1891 sub PMf_EXTENDED () { 0x8000 }
1892
1893 # osmic acid -- see osmium tetroxide
1894
1895 my %matchwords;
1896 map($matchwords{join "", sort split //, $_} = $_, 'cig', 'cog', 'cos', 'cogs',
1897     'cox', 'go', 'is', 'ism', 'iso', 'mig', 'mix', 'osmic', 'ox', 'sic', 
1898     'sig', 'six', 'smog', 'so', 'soc', 'sog', 'xi'); 
1899
1900 sub pp_match {
1901     my $self = shift;
1902     my $op = shift;
1903     my $kid = $op->first;
1904     my ($pre, $post, $re) = ("", "", "");
1905     if ($op->flags & OPf_STACKED) {
1906         $pre = "(" . $self->deparse($kid) . " =~ ";
1907         $post = ")";
1908         $kid = $kid->sibling;
1909     }
1910     if (null $kid) {
1911         $re = uninterp(escape_str($op->precomp));
1912     } else {
1913         $re = $self->deparse($kid);
1914     }
1915     my $flags = "";
1916     $flags .= "c" if $op->pmflags & PMf_CONTINUE;
1917     $flags .= "g" if $op->pmflags & PMf_GLOBAL;
1918     $flags .= "i" if $op->pmflags & PMf_FOLD;
1919     $flags .= "m" if $op->pmflags & PMf_MULTILINE;
1920     $flags .= "o" if $op->pmflags & PMf_KEEP;
1921     $flags .= "s" if $op->pmflags & PMf_SINGLELINE;
1922     $flags .= "x" if $op->pmflags & PMf_EXTENDED;
1923     $flags = $matchwords{$flags} if $matchwords{$flags};
1924     if ($op->pmflags & PMf_ONCE) { # only one kind of delimiter works here
1925         $re =~ s/\?/\\?/g;
1926         return "$pre?$re?$flags$post";
1927     }
1928     return $pre . single_delim("m", "/", $re) . "$flags$post";
1929 }
1930
1931 sub pp_pushre { pp_match(@_) }
1932
1933 sub pp_split {
1934     my $self = shift;
1935     my $op = shift;
1936     my($kid, @exprs, $ary, $expr);
1937     $kid = $op->first;
1938     if ($ {$kid->pmreplroot}) {
1939         $ary = '@' . $self->gv_name($kid->pmreplroot);
1940     }
1941     for (; !null($kid); $kid = $kid->sibling) {
1942         push @exprs, $self->deparse($kid);
1943     }
1944     $expr = "split(" . join(", ", @exprs) . ")";
1945     if ($ary) {
1946         return "(" . $ary . " = " . $expr . ")";
1947     } else {
1948         return $expr;
1949     }
1950 }
1951
1952 # oxime -- any of various compounds obtained chiefly by the action of
1953 # hydroxylamine on aldehydes and ketones and characterized by the
1954 # bivalent grouping C=NOH [Webster's Tenth]
1955
1956 my %substwords;
1957 map($substwords{join "", sort split //, $_} = $_, 'ego', 'egoism', 'em',
1958     'es', 'ex', 'exes', 'gee', 'go', 'goes', 'ie', 'ism', 'iso', 'me',
1959     'meese', 'meso', 'mig', 'mix', 'os', 'ox', 'oxime', 'see', 'seem',
1960     'seg', 'sex', 'sig', 'six', 'smog', 'sog', 'some', 'xi');
1961
1962 sub pp_subst {
1963     my $self = shift;
1964     my $op = shift;
1965     my $kid = $op->first;
1966     my($pre, $post, $re, $repl) = ("", "", "", "");
1967     if ($op->flags & OPf_STACKED) {
1968         $pre = "(" . $self->deparse($kid) . " =~ ";
1969         $post = ")";
1970         $kid = $kid->sibling;
1971     }
1972     my $flags = "";    
1973     if (null($op->pmreplroot)) {
1974         $repl = $self->dq($kid);
1975         $kid = $kid->sibling;
1976     } else {
1977         $repl = $op->pmreplroot->first; # skip substcont
1978         while ($repl->ppaddr eq "pp_entereval") {
1979             $repl = $repl->first;
1980             $flags .= "e";
1981         }
1982         $repl = $self->deparse($repl);
1983     }
1984     if (null $kid) {
1985         $re = uninterp(escape_str($op->precomp));
1986     } else {
1987         $re = $self->deparse($kid);
1988     }
1989     $flags .= "e" if $op->pmflags & PMf_EVAL;
1990     $flags .= "g" if $op->pmflags & PMf_GLOBAL;
1991     $flags .= "i" if $op->pmflags & PMf_FOLD;
1992     $flags .= "m" if $op->pmflags & PMf_MULTILINE;
1993     $flags .= "o" if $op->pmflags & PMf_KEEP;
1994     $flags .= "s" if $op->pmflags & PMf_SINGLELINE;
1995     $flags .= "x" if $op->pmflags & PMf_EXTENDED;
1996     $flags = $substwords{$flags} if $substwords{$flags};
1997     return $pre . "s". double_delim($re, $repl) . "$flags$post";
1998 }
1999
2000 1;