Allow regexp-to-pvlv assignment
[perl.git] / ext / B / B / Concise.pm
1 package B::Concise;
2 # Copyright (C) 2000-2003 Stephen McCamant. All rights reserved.
3 # This program is free software; you can redistribute and/or modify it
4 # under the same terms as Perl itself.
5
6 # Note: we need to keep track of how many use declarations/BEGIN
7 # blocks this module uses, so we can avoid printing them when user
8 # asks for the BEGIN blocks in her program. Update the comments and
9 # the count in concise_specials if you add or delete one. The
10 # -MO=Concise counts as use #1.
11
12 use strict; # use #2
13 use warnings; # uses #3 and #4, since warnings uses Carp
14
15 use Exporter (); # use #5
16
17 our $VERSION   = "0.94";
18 our @ISA       = qw(Exporter);
19 our @EXPORT_OK = qw( set_style set_style_standard add_callback
20                      concise_subref concise_cv concise_main
21                      add_style walk_output compile reset_sequence );
22 our %EXPORT_TAGS =
23     ( io        => [qw( walk_output compile reset_sequence )],
24       style     => [qw( add_style set_style_standard )],
25       cb        => [qw( add_callback )],
26       mech      => [qw( concise_subref concise_cv concise_main )],  );
27
28 # use #6
29 use B qw(class ppname main_start main_root main_cv cstring svref_2object
30          SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL
31          CVf_ANON PAD_FAKELEX_ANON PAD_FAKELEX_MULTI SVf_ROK);
32
33 my %style =
34   ("terse" =>
35    ["(?(#label =>\n)?)(*(    )*)#class (#addr) #name (?([#targ])?) "
36     . "#svclass~(?((#svaddr))?)~#svval~(?(label \"#coplabel\")?)\n",
37     "(*(    )*)goto #class (#addr)\n",
38     "#class pp_#name"],
39    "concise" =>
40    ["#hyphseq2 (*(   (x( ;)x))*)<#classsym> #exname#arg(?([#targarglife])?)"
41     . "~#flags(?(/#private)?)(?(:#hints)?)(x(;~->#next)x)\n"
42     , "  (*(    )*)     goto #seq\n",
43     "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"],
44    "linenoise" =>
45    ["(x(;(*( )*))x)#noise#arg(?([#targarg])?)(x( ;\n)x)",
46     "gt_#seq ",
47     "(?(#seq)?)#noise#arg(?([#targarg])?)"],
48    "debug" =>
49    ["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t"
50     . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n"
51     . "\top_flags\t#flagval\n\top_private\t#privval\t#hintsval\n"
52     . "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)"
53     . "(?(\top_sv\t\t#svaddr\n)?)",
54     "    GOTO #addr\n",
55     "#addr"],
56    "env" => [$ENV{B_CONCISE_FORMAT}, $ENV{B_CONCISE_GOTO_FORMAT},
57              $ENV{B_CONCISE_TREE_FORMAT}],
58   );
59
60 # Renderings, ie how Concise prints, is controlled by these vars
61 # primary:
62 our $stylename;         # selects current style from %style
63 my $order = "basic";    # how optree is walked & printed: basic, exec, tree
64
65 # rendering mechanics:
66 # these 'formats' are the line-rendering templates
67 # they're updated from %style when $stylename changes
68 my ($format, $gotofmt, $treefmt);
69
70 # lesser players:
71 my $base = 36;          # how <sequence#> is displayed
72 my $big_endian = 1;     # more <sequence#> display
73 my $tree_style = 0;     # tree-order details
74 my $banner = 1;         # print banner before optree is traversed
75 my $do_main = 0;        # force printing of main routine
76 my $show_src;           # show source code
77
78 # another factor: can affect all styles!
79 our @callbacks;         # allow external management
80
81 set_style_standard("concise");
82
83 my $curcv;
84 my $cop_seq_base;
85
86 sub set_style {
87     ($format, $gotofmt, $treefmt) = @_;
88     #warn "set_style: deprecated, use set_style_standard instead\n"; # someday
89     die "expecting 3 style-format args\n" unless @_ == 3;
90 }
91
92 sub add_style {
93     my ($newstyle,@args) = @_;
94     die "style '$newstyle' already exists, choose a new name\n"
95         if exists $style{$newstyle};
96     die "expecting 3 style-format args\n" unless @args == 3;
97     $style{$newstyle} = [@args];
98     $stylename = $newstyle; # update rendering state
99 }
100
101 sub set_style_standard {
102     ($stylename) = @_; # update rendering state
103     die "err: style '$stylename' unknown\n" unless exists $style{$stylename};
104     set_style(@{$style{$stylename}});
105 }
106
107 sub add_callback {
108     push @callbacks, @_;
109 }
110
111 # output handle, used with all Concise-output printing
112 our $walkHandle;        # public for your convenience
113 BEGIN { $walkHandle = \*STDOUT }
114
115 sub walk_output { # updates $walkHandle
116     my $handle = shift;
117     return $walkHandle unless $handle; # allow use as accessor
118
119     if (ref $handle eq 'SCALAR') {
120         require Config;
121         die "no perlio in this build, can't call walk_output (\\\$scalar)\n"
122             unless $Config::Config{useperlio};
123         # in 5.8+, open(FILEHANDLE,MODE,REFERENCE) writes to string
124         open my $tmp, '>', $handle;     # but cant re-set existing STDOUT
125         $walkHandle = $tmp;             # so use my $tmp as intermediate var
126         return $walkHandle;
127     }
128     my $iotype = ref $handle;
129     die "expecting argument/object that can print\n"
130         unless $iotype eq 'GLOB' or $iotype and $handle->can('print');
131     $walkHandle = $handle;
132 }
133
134 sub concise_subref {
135     my($order, $coderef, $name) = @_;
136     my $codeobj = svref_2object($coderef);
137
138     return concise_stashref(@_)
139         unless ref($codeobj) =~ '^B::(?:CV|FM)\z';
140     concise_cv_obj($order, $codeobj, $name);
141 }
142
143 sub concise_stashref {
144     my($order, $h) = @_;
145     local *s;
146     foreach my $k (sort keys %$h) {
147         next unless defined $h->{$k};
148         *s = $h->{$k};
149         my $coderef = *s{CODE} or next;
150         reset_sequence();
151         print "FUNC: ", *s, "\n";
152         my $codeobj = svref_2object($coderef);
153         next unless ref $codeobj eq 'B::CV';
154         eval { concise_cv_obj($order, $codeobj, $k) };
155         warn "err $@ on $codeobj" if $@;
156     }
157 }
158
159 # This should have been called concise_subref, but it was exported
160 # under this name in versions before 0.56
161 *concise_cv = \&concise_subref;
162
163 sub concise_cv_obj {
164     my ($order, $cv, $name) = @_;
165     # name is either a string, or a CODE ref (copy of $cv arg??)
166
167     $curcv = $cv;
168
169     if (ref($cv->XSUBANY) =~ /B::(\w+)/) {
170         print $walkHandle "$name is a constant sub, optimized to a $1\n";
171         return;
172     }
173     if ($cv->XSUB) {
174         print $walkHandle "$name is XS code\n";
175         return;
176     }
177     if (class($cv->START) eq "NULL") {
178         no strict 'refs';
179         if (ref $name eq 'CODE') {
180             print $walkHandle "coderef $name has no START\n";
181         }
182         elsif (exists &$name) {
183             print $walkHandle "$name exists in stash, but has no START\n";
184         }
185         else {
186             print $walkHandle "$name not in symbol table\n";
187         }
188         return;
189     }
190     sequence($cv->START);
191     if ($order eq "exec") {
192         walk_exec($cv->START);
193     }
194     elsif ($order eq "basic") {
195         # walk_topdown($cv->ROOT, sub { $_[0]->concise($_[1]) }, 0);
196         my $root = $cv->ROOT;
197         unless (ref $root eq 'B::NULL') {
198             walk_topdown($root, sub { $_[0]->concise($_[1]) }, 0);
199         } else {
200             print $walkHandle "B::NULL encountered doing ROOT on $cv. avoiding disaster\n";
201         }
202     } else {
203         print $walkHandle tree($cv->ROOT, 0);
204     }
205 }
206
207 sub concise_main {
208     my($order) = @_;
209     sequence(main_start);
210     $curcv = main_cv;
211     if ($order eq "exec") {
212         return if class(main_start) eq "NULL";
213         walk_exec(main_start);
214     } elsif ($order eq "tree") {
215         return if class(main_root) eq "NULL";
216         print $walkHandle tree(main_root, 0);
217     } elsif ($order eq "basic") {
218         return if class(main_root) eq "NULL";
219         walk_topdown(main_root,
220                      sub { $_[0]->concise($_[1]) }, 0);
221     }
222 }
223
224 sub concise_specials {
225     my($name, $order, @cv_s) = @_;
226     my $i = 1;
227     if ($name eq "BEGIN") {
228         splice(@cv_s, 0, 8); # skip 7 BEGIN blocks in this file. NOW 8 ??
229     } elsif ($name eq "CHECK") {
230         pop @cv_s; # skip the CHECK block that calls us
231     }
232     for my $cv (@cv_s) {
233         print $walkHandle "$name $i:\n";
234         $i++;
235         concise_cv_obj($order, $cv, $name);
236     }
237 }
238
239 my $start_sym = "\e(0"; # "\cN" sometimes also works
240 my $end_sym   = "\e(B"; # "\cO" respectively
241
242 my @tree_decorations =
243   (["  ", "--", "+-", "|-", "| ", "`-", "-", 1],
244    [" ", "-", "+", "+", "|", "`", "", 0],
245    ["  ", map("$start_sym$_$end_sym", "qq", "wq", "tq", "x ", "mq", "q"), 1],
246    [" ", map("$start_sym$_$end_sym", "q", "w", "t", "x", "m"), "", 0],
247   );
248
249 my @render_packs; # collect -stash=<packages>
250
251 sub compileOpts {
252     # set rendering state from options and args
253     my (@options,@args);
254     if (@_) {
255         @options = grep(/^-/, @_);
256         @args = grep(!/^-/, @_);
257     }
258     for my $o (@options) {
259         # mode/order
260         if ($o eq "-basic") {
261             $order = "basic";
262         } elsif ($o eq "-exec") {
263             $order = "exec";
264         } elsif ($o eq "-tree") {
265             $order = "tree";
266         }
267         # tree-specific
268         elsif ($o eq "-compact") {
269             $tree_style |= 1;
270         } elsif ($o eq "-loose") {
271             $tree_style &= ~1;
272         } elsif ($o eq "-vt") {
273             $tree_style |= 2;
274         } elsif ($o eq "-ascii") {
275             $tree_style &= ~2;
276         }
277         # sequence numbering
278         elsif ($o =~ /^-base(\d+)$/) {
279             $base = $1;
280         } elsif ($o eq "-bigendian") {
281             $big_endian = 1;
282         } elsif ($o eq "-littleendian") {
283             $big_endian = 0;
284         }
285         # miscellaneous, presentation
286         elsif ($o eq "-nobanner") {
287             $banner = 0;
288         } elsif ($o eq "-banner") {
289             $banner = 1;
290         }
291         elsif ($o eq "-main") {
292             $do_main = 1;
293         } elsif ($o eq "-nomain") {
294             $do_main = 0;
295         } elsif ($o eq "-src") {
296             $show_src = 1;
297         }
298         elsif ($o =~ /^-stash=(.*)/) {
299             my $pkg = $1;
300             no strict 'refs';
301             if (! %{$pkg.'::'}) {
302                 eval "require $pkg";
303             } else {
304                 require Config;
305                 if (!$Config::Config{usedl}
306                     && keys %{$pkg.'::'} == 1
307                     && $pkg->can('bootstrap')) {
308                     # It is something that we're statically linked to, but hasn't
309                     # yet been used.
310                     eval "require $pkg";
311                 }
312             }
313             push @render_packs, $pkg;
314         }
315         # line-style options
316         elsif (exists $style{substr($o, 1)}) {
317             $stylename = substr($o, 1);
318             set_style_standard($stylename);
319         } else {
320             warn "Option $o unrecognized";
321         }
322     }
323     return (@args);
324 }
325
326 sub compile {
327     my (@args) = compileOpts(@_);
328     return sub {
329         my @newargs = compileOpts(@_); # accept new rendering options
330         warn "disregarding non-options: @newargs\n" if @newargs;
331
332         for my $objname (@args) {
333             next unless $objname; # skip null args to avoid noisy responses
334
335             if ($objname eq "BEGIN") {
336                 concise_specials("BEGIN", $order,
337                                  B::begin_av->isa("B::AV") ?
338                                  B::begin_av->ARRAY : ());
339             } elsif ($objname eq "INIT") {
340                 concise_specials("INIT", $order,
341                                  B::init_av->isa("B::AV") ?
342                                  B::init_av->ARRAY : ());
343             } elsif ($objname eq "CHECK") {
344                 concise_specials("CHECK", $order,
345                                  B::check_av->isa("B::AV") ?
346                                  B::check_av->ARRAY : ());
347             } elsif ($objname eq "UNITCHECK") {
348                 concise_specials("UNITCHECK", $order,
349                                  B::unitcheck_av->isa("B::AV") ?
350                                  B::unitcheck_av->ARRAY : ());
351             } elsif ($objname eq "END") {
352                 concise_specials("END", $order,
353                                  B::end_av->isa("B::AV") ?
354                                  B::end_av->ARRAY : ());
355             }
356             else {
357                 # convert function names to subrefs
358                 if (ref $objname) {
359                     print $walkHandle "B::Concise::compile($objname)\n"
360                         if $banner;
361                     concise_subref($order, ($objname)x2);
362                     next;
363                 } else {
364                     $objname = "main::" . $objname unless $objname =~ /::/;
365                     no strict 'refs';
366                     my $glob = \*$objname;
367                     unless (*$glob{CODE} || *$glob{FORMAT}) {
368                         print $walkHandle "$objname:\n" if $banner;
369                         print $walkHandle "err: unknown function ($objname)\n";
370                         return;
371                     }
372                     if (my $objref = *$glob{CODE}) {
373                         print $walkHandle "$objname:\n" if $banner;
374                         concise_subref($order, $objref, $objname);
375                     }
376                     if (my $objref = *$glob{FORMAT}) {
377                         print $walkHandle "$objname (FORMAT):\n"
378                             if $banner;
379                         concise_subref($order, $objref, $objname);
380                     }
381                 }
382             }
383         }
384         for my $pkg (@render_packs) {
385             no strict 'refs';
386             concise_stashref($order, \%{$pkg.'::'});
387         }
388
389         if (!@args or $do_main or @render_packs) {
390             print $walkHandle "main program:\n" if $do_main;
391             concise_main($order);
392         }
393         return @args;   # something
394     }
395 }
396
397 my %labels;
398 my $lastnext;   # remembers op-chain, used to insert gotos
399
400 my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|",
401                'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*",
402                'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#");
403
404 no warnings 'qw'; # "Possible attempt to put comments..."; use #7
405 my @linenoise =
406   qw'#  () sc (  @? 1  $* gv *{ m$ m@ m% m? p/ *$ $  $# & a& pt \\ s\\ rf bl
407      `  *? <> ?? ?/ r/ c/ // qr s/ /c y/ =  @= C  sC Cp sp df un BM po +1 +I
408      -1 -I 1+ I+ 1- I- ** *  i* /  i/ %$ i% x  +  i+ -  i- .  "  << >> <  i<
409      >  i> <= i, >= i. == i= != i! <? i? s< s> s, s. s= s! s? b& b^ b| -0 -i
410      !  ~  a2 si cs rd sr e^ lg sq in %x %o ab le ss ve ix ri sf FL od ch cy
411      uf lf uc lc qm @  [f [  @[ eh vl ky dl ex %  ${ @{ uk pk st jn )  )[ a@
412      a% sl +] -] [- [+ so rv GS GW MS MW .. f. .f && || ^^ ?: &= |= -> s{ s}
413      v} ca wa di rs ;; ;  ;d }{ {  }  {} f{ it {l l} rt }l }n }r dm }g }e ^o
414      ^c ^| ^# um bm t~ u~ ~d DB db ^s se ^g ^r {w }w pf pr ^O ^K ^R ^W ^d ^v
415      ^e ^t ^k t. fc ic fl .s .p .b .c .l .a .h g1 s1 g2 s2 ?. l? -R -W -X -r
416      -w -x -e -o -O -z -s -M -A -C -S -c -b -f -d -p -l -u -g -k -t -T -B cd
417      co cr u. cm ut r. l@ s@ r@ mD uD oD rD tD sD wD cD f$ w$ p$ sh e$ k$ g3
418      g4 s4 g5 s5 T@ C@ L@ G@ A@ S@ Hg Hc Hr Hw Mg Mc Ms Mr Sg Sc So rq do {e
419      e} {t t} g6 G6 6e g7 G7 7e g8 G8 8e g9 G9 9e 6s 7s 8s 9s 6E 7E 8E 9E Pn
420      Pu GP SP EP Gn Gg GG SG EG g0 c$ lk t$ ;s n> // /= CO';
421
422 my $chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
423
424 sub op_flags { # common flags (see BASOP.op_flags in op.h)
425     my($x) = @_;
426     my(@v);
427     push @v, "v" if ($x & 3) == 1;
428     push @v, "s" if ($x & 3) == 2;
429     push @v, "l" if ($x & 3) == 3;
430     push @v, "K" if $x & 4;
431     push @v, "P" if $x & 8;
432     push @v, "R" if $x & 16;
433     push @v, "M" if $x & 32;
434     push @v, "S" if $x & 64;
435     push @v, "*" if $x & 128;
436     return join("", @v);
437 }
438
439 sub base_n {
440     my $x = shift;
441     return "-" . base_n(-$x) if $x < 0;
442     my $str = "";
443     do { $str .= substr($chars, $x % $base, 1) } while $x = int($x / $base);
444     $str = reverse $str if $big_endian;
445     return $str;
446 }
447
448 my %sequence_num;
449 my $seq_max = 1;
450
451 sub reset_sequence {
452     # reset the sequence
453     %sequence_num = ();
454     $seq_max = 1;
455     $lastnext = 0;
456 }
457
458 sub seq {
459     my($op) = @_;
460     return "-" if not exists $sequence_num{$$op};
461     return base_n($sequence_num{$$op});
462 }
463
464 sub walk_topdown {
465     my($op, $sub, $level) = @_;
466     $sub->($op, $level);
467     if ($op->flags & OPf_KIDS) {
468         for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
469             walk_topdown($kid, $sub, $level + 1);
470         }
471     }
472     if (class($op) eq "PMOP") {
473         my $maybe_root = $op->pmreplroot;
474         if (ref($maybe_root) and $maybe_root->isa("B::OP")) {
475             # It really is the root of the replacement, not something
476             # else stored here for lack of space elsewhere
477             walk_topdown($maybe_root, $sub, $level + 1);
478         }
479     }
480 }
481
482 sub walklines {
483     my($ar, $level) = @_;
484     for my $l (@$ar) {
485         if (ref($l) eq "ARRAY") {
486             walklines($l, $level + 1);
487         } else {
488             $l->concise($level);
489         }
490     }
491 }
492
493 sub walk_exec {
494     my($top, $level) = @_;
495     my %opsseen;
496     my @lines;
497     my @todo = ([$top, \@lines]);
498     while (@todo and my($op, $targ) = @{shift @todo}) {
499         for (; $$op; $op = $op->next) {
500             last if $opsseen{$$op}++;
501             push @$targ, $op;
502             my $name = $op->name;
503             if (class($op) eq "LOGOP") {
504                 my $ar = [];
505                 push @$targ, $ar;
506                 push @todo, [$op->other, $ar];
507             } elsif ($name eq "subst" and $ {$op->pmreplstart}) {
508                 my $ar = [];
509                 push @$targ, $ar;
510                 push @todo, [$op->pmreplstart, $ar];
511             } elsif ($name =~ /^enter(loop|iter)$/) {
512                 $labels{${$op->nextop}} = "NEXT";
513                 $labels{${$op->lastop}} = "LAST";
514                 $labels{${$op->redoop}} = "REDO";
515             }
516         }
517     }
518     walklines(\@lines, 0);
519 }
520
521 # The structure of this routine is purposely modeled after op.c's peep()
522 sub sequence {
523     my($op) = @_;
524     my $oldop = 0;
525     return if class($op) eq "NULL" or exists $sequence_num{$$op};
526     for (; $$op; $op = $op->next) {
527         last if exists $sequence_num{$$op};
528         my $name = $op->name;
529         if ($name =~ /^(null|scalar|lineseq|scope)$/) {
530             next if $oldop and $ {$op->next};
531         } else {
532             $sequence_num{$$op} = $seq_max++;
533             if (class($op) eq "LOGOP") {
534                 my $other = $op->other;
535                 $other = $other->next while $other->name eq "null";
536                 sequence($other);
537             } elsif (class($op) eq "LOOP") {
538                 my $redoop = $op->redoop;
539                 $redoop = $redoop->next while $redoop->name eq "null";
540                 sequence($redoop);
541                 my $nextop = $op->nextop;
542                 $nextop = $nextop->next while $nextop->name eq "null";
543                 sequence($nextop);
544                 my $lastop = $op->lastop;
545                 $lastop = $lastop->next while $lastop->name eq "null";
546                 sequence($lastop);
547             } elsif ($name eq "subst" and $ {$op->pmreplstart}) {
548                 my $replstart = $op->pmreplstart;
549                 $replstart = $replstart->next while $replstart->name eq "null";
550                 sequence($replstart);
551             }
552         }
553         $oldop = $op;
554     }
555 }
556
557 sub fmt_line {    # generate text-line for op.
558     my($hr, $op, $text, $level) = @_;
559
560     $_->($hr, $op, \$text, \$level, $stylename) for @callbacks;
561
562     return '' if $hr->{SKIP};   # suppress line if a callback said so
563     return '' if $hr->{goto} and $hr->{goto} eq '-';    # no goto nowhere
564
565     # spec: (?(text1#varText2)?)
566     $text =~ s/\(\?\(([^\#]*?)\#(\w+)([^\#]*?)\)\?\)/
567         $hr->{$2} ? $1.$hr->{$2}.$3 : ""/eg;
568
569     # spec: (x(exec_text;basic_text)x)
570     $text =~ s/\(x\((.*?);(.*?)\)x\)/$order eq "exec" ? $1 : $2/egs;
571
572     # spec: (*(text)*)
573     $text =~ s/\(\*\(([^;]*?)\)\*\)/$1 x $level/egs;
574
575     # spec: (*(text1;text2)*)
576     $text =~ s/\(\*\((.*?);(.*?)\)\*\)/$1 x ($level - 1) . $2 x ($level>0)/egs;
577
578     # convert #Var to tag=>val form: Var\t#var
579     $text =~ s/\#([A-Z][a-z]+)(\d+)?/\t\u$1\t\L#$1$2/gs;
580
581     # spec: #varN
582     $text =~ s/\#([a-zA-Z]+)(\d+)/sprintf("%-$2s", $hr->{$1})/eg;
583
584     $text =~ s/\#([a-zA-Z]+)/$hr->{$1}/eg;      # populate #var's
585     $text =~ s/[ \t]*~+[ \t]*/ /g;              # squeeze tildes
586
587     $text = "# $hr->{src}\n$text" if $show_src and $hr->{src};
588
589     chomp $text;
590     return "$text\n" if $text ne "" and $order ne "tree";
591     return $text; # suppress empty lines
592 }
593
594 our %priv; # used to display each opcode's BASEOP.op_private values
595
596 $priv{$_}{128} = "LVINTRO"
597   for ("pos", "substr", "vec", "threadsv", "gvsv", "rv2sv", "rv2hv", "rv2gv",
598        "rv2av", "rv2arylen", "aelem", "helem", "aslice", "hslice", "padsv",
599        "padav", "padhv", "enteriter", "entersub");
600 $priv{$_}{64} = "REFC" for ("leave", "leavesub", "leavesublv", "leavewrite");
601 $priv{"aassign"}{64} = "COMMON";
602 $priv{"aassign"}{32} = "STATE";
603 $priv{"sassign"}{32} = "STATE";
604 $priv{"sassign"}{64} = "BKWARD";
605 $priv{"sassign"}{128}= "CV2GV";
606 $priv{$_}{64} = "RTIME" for ("match", "subst", "substcont", "qr");
607 @{$priv{"trans"}}{1,2,4,8,16,64} = ("<UTF", ">UTF", "IDENT", "SQUASH", "DEL",
608                                     "COMPL", "GROWS");
609 $priv{transr} = $priv{trans};
610 $priv{"repeat"}{64} = "DOLIST";
611 $priv{"leaveloop"}{64} = "CONT";
612 $priv{$_}{4} = "DREFed" for (qw(rv2sv rv2av rv2hv));
613 @{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV")
614   for (qw(rv2gv rv2sv padsv aelem helem));
615 $priv{$_}{16} = "STATE" for ("padav", "padhv", "padsv");
616 @{$priv{rv2gv}}{4,16} = qw "NOINIT FAKE";
617 @{$priv{"entersub"}}{1,4,16,32,64} = qw( INARGS TARG DBG DEREF );
618 @{$priv{rv2cv}}{1,8,128} = ("CONST","AMPER","NO()");
619 $priv{"gv"}{32} = "EARLYCV";
620 $priv{"aelem"}{16} = $priv{"helem"}{16} = "LVDEFER";
621 $priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv",
622         "enteriter");
623 $priv{$_}{8} = 'LVSUB' for qw(rv2av rv2gv rv2hv padav padhv aelem helem
624                         aslice hslice av2arylen keys rkeys substr pos vec);
625 @{$priv{$_}}{32,64} = ('BOOL','BOOL?') for 'rv2hv', 'padhv';
626 $priv{substr}{16} = 'REPL1ST';
627 $priv{$_}{16} = "TARGMY"
628   for (map(($_,"s$_"),"chop", "chomp"),
629        map(($_,"i_$_"), "postinc", "postdec", "multiply", "divide", "modulo",
630            "add", "subtract", "negate"), "pow", "concat", "stringify",
631        "left_shift", "right_shift", "bit_and", "bit_xor", "bit_or",
632        "complement", "atan2", "sin", "cos", "rand", "exp", "log", "sqrt",
633        "int", "hex", "oct", "abs", "length", "index", "rindex", "sprintf",
634        "ord", "chr", "crypt", "quotemeta", "join", "push", "unshift", "flock",
635        "chdir", "chown", "chroot", "unlink", "chmod", "utime", "rename",
636        "link", "symlink", "mkdir", "rmdir", "wait", "waitpid", "system",
637        "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority",
638        "setpriority", "time", "sleep");
639 $priv{$_}{4} = "REVERSED" for ("enteriter", "iter");
640 @{$priv{"const"}}{2,4,8,16,64,128} =
641     ("NOVER","SHORT","STRICT","ENTERED","BARE","FOLD");
642 $priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM";
643 $priv{"list"}{64} = "GUESSED";
644 $priv{"delete"}{64} = "SLICE";
645 $priv{"exists"}{64} = "SUB";
646 @{$priv{"sort"}}{1,2,4,8,16,32,64} = ("NUM", "INT", "REV", "INPLACE","DESC","QSORT","STABLE");
647 $priv{"reverse"}{8} = "INPLACE";
648 $priv{"threadsv"}{64} = "SVREFd";
649 @{$priv{$_}}{16,32,64,128} = ("INBIN","INCR","OUTBIN","OUTCR")
650   for ("open", "backtick");
651 $priv{"exit"}{128} = "VMS";
652 $priv{$_}{2} = "FTACCESS"
653   for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec");
654 @{$priv{"entereval"}}{2,4,8,16} = qw "HAS_HH UNI BYTES COPHH";
655 @{$priv{$_}}{4,8,16} = ("FTSTACKED","FTSTACKING","FTAFTERt")
656 for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec",
657      "ftis", "fteowned", "ftrowned", "ftzero", "ftsize", "ftmtime",
658      "ftatime", "ftctime", "ftsock", "ftchr", "ftblk", "ftfile", "ftdir",
659      "ftpipe", "ftlink", "ftsuid", "ftsgid", "ftsvtx", "fttty", "fttext",
660      "ftbinary");
661 $priv{$_}{2} = "GREPLEX"
662 for ("mapwhile", "mapstart", "grepwhile", "grepstart");
663 $priv{$_}{128} = '+1' for qw "caller wantarray runcv";
664 @{$priv{coreargs}}{1,2,64,128} = ('DREF1','DREF2','$MOD','MARK');
665 $priv{$_}{128} = 'UTF' for qw "last redo next goto dump";
666
667 our %hints; # used to display each COP's op_hints values
668
669 # strict refs, subs, vars
670 @hints{2,512,1024,32,64,128} = ('$', '&', '*', 'x$', 'x&', 'x*');
671 # integers, locale, bytes
672 @hints{1,4,8,16} = ('i', 'l', 'b');
673 # block scope, localise %^H, $^OPEN (in), $^OPEN (out)
674 @hints{256,131072,262144,524288} = ('{','%','<','>');
675 # overload new integer, float, binary, string, re
676 @hints{4096,8192,16384,32768,65536} = ('I', 'F', 'B', 'S', 'R');
677 # taint and eval
678 @hints{1048576,2097152} = ('T', 'E');
679 # filetest access, UTF-8
680 @hints{4194304,8388608} = ('X', 'U');
681
682 sub _flags {
683     my($hash, $x) = @_;
684     my @s;
685     for my $flag (sort {$b <=> $a} keys %$hash) {
686         if ($hash->{$flag} and $x & $flag and $x >= $flag) {
687             $x -= $flag;
688             push @s, $hash->{$flag};
689         }
690     }
691     push @s, $x if $x;
692     return join(",", @s);
693 }
694
695 sub private_flags {
696     my($name, $x) = @_;
697     _flags($priv{$name}, $x);
698 }
699
700 sub hints_flags {
701     my($x) = @_;
702     _flags(\%hints, $x);
703 }
704
705 sub concise_sv {
706     my($sv, $hr, $preferpv) = @_;
707     $hr->{svclass} = class($sv);
708     $hr->{svclass} = "UV"
709       if $hr->{svclass} eq "IV" and $sv->FLAGS & SVf_IVisUV;
710     Carp::cluck("bad concise_sv: $sv") unless $sv and $$sv;
711     $hr->{svaddr} = sprintf("%#x", $$sv);
712     if ($hr->{svclass} eq "GV" && $sv->isGV_with_GP()) {
713         my $gv = $sv;
714         my $stash = $gv->STASH->NAME; if ($stash eq "main") {
715             $stash = "";
716         } else {
717             $stash = $stash . "::";
718         }
719         $hr->{svval} = "*$stash" . $gv->SAFENAME;
720         return "*$stash" . $gv->SAFENAME;
721     } else {
722         if ($] >= 5.011) {
723             while (class($sv) eq "IV" && $sv->FLAGS & SVf_ROK) {
724                 $hr->{svval} .= "\\";
725                 $sv = $sv->RV;
726             }
727         } else {
728             while (class($sv) eq "RV") {
729                 $hr->{svval} .= "\\";
730                 $sv = $sv->RV;
731             }
732         }
733         if (class($sv) eq "SPECIAL") {
734             $hr->{svval} .= ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv];
735         } elsif ($preferpv
736               && ($sv->FLAGS & SVf_POK || class($sv) eq "REGEXP")) {
737             $hr->{svval} .= cstring($sv->PV);
738         } elsif ($sv->FLAGS & SVf_NOK) {
739             $hr->{svval} .= $sv->NV;
740         } elsif ($sv->FLAGS & SVf_IOK) {
741             $hr->{svval} .= $sv->int_value;
742         } elsif ($sv->FLAGS & SVf_POK || class($sv) eq "REGEXP") {
743             $hr->{svval} .= cstring($sv->PV);
744         } elsif (class($sv) eq "HV") {
745             $hr->{svval} .= 'HASH';
746         }
747
748         $hr->{svval} = 'undef' unless defined $hr->{svval};
749         my $out = $hr->{svclass};
750         return $out .= " $hr->{svval}" ; 
751     }
752 }
753
754 my %srclines;
755
756 sub fill_srclines {
757     my $fullnm = shift;
758     if ($fullnm eq '-e') {
759         $srclines{$fullnm} = [ $fullnm, "-src not supported for -e" ];
760         return;
761     }
762     open (my $fh, '<', $fullnm)
763         or warn "# $fullnm: $!, (chdirs not supported by this feature yet)\n"
764         and return;
765     my @l = <$fh>;
766     chomp @l;
767     unshift @l, $fullnm; # like @{_<$fullnm} in debug, array starts at 1
768     $srclines{$fullnm} = \@l;
769 }
770
771 sub concise_op {
772     my ($op, $level, $format) = @_;
773     my %h;
774     $h{exname} = $h{name} = $op->name;
775     $h{NAME} = uc $h{name};
776     $h{class} = class($op);
777     $h{extarg} = $h{targ} = $op->targ;
778     $h{extarg} = "" unless $h{extarg};
779     if ($h{name} eq "null" and $h{targ}) {
780         # targ holds the old type
781         $h{exname} = "ex-" . substr(ppname($h{targ}), 3);
782         $h{extarg} = "";
783     } elsif ($op->name =~ /^leave(sub(lv)?|write)?$/) {
784         # targ potentially holds a reference count
785         if ($op->private & 64) {
786             my $refs = "ref" . ($h{targ} != 1 ? "s" : "");
787             $h{targarglife} = $h{targarg} = "$h{targ} $refs";
788         }
789     } elsif ($h{targ}) {
790         my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}];
791         if (defined $padname and class($padname) ne "SPECIAL") {
792             $h{targarg}  = $padname->PVX;
793             if ($padname->FLAGS & SVf_FAKE) {
794                 # These changes relate to the jumbo closure fix.
795                 # See changes 19939 and 20005
796                 my $fake = '';
797                 $fake .= 'a'
798                     if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_ANON;
799                 $fake .= 'm'
800                     if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_MULTI;
801                 $fake .= ':' . $padname->PARENT_PAD_INDEX
802                     if $curcv->CvFLAGS & CVf_ANON;
803                 $h{targarglife} = "$h{targarg}:FAKE:$fake";
804             }
805             else {
806                 my $intro = $padname->COP_SEQ_RANGE_LOW - $cop_seq_base;
807                 my $finish = int($padname->COP_SEQ_RANGE_HIGH) - $cop_seq_base;
808                 $finish = "end" if $finish == 999999999 - $cop_seq_base;
809                 $h{targarglife} = "$h{targarg}:$intro,$finish";
810             }
811         } else {
812             $h{targarglife} = $h{targarg} = "t" . $h{targ};
813         }
814     }
815     $h{arg} = "";
816     $h{svclass} = $h{svaddr} = $h{svval} = "";
817     if ($h{class} eq "PMOP") {
818         my $precomp = $op->precomp;
819         if (defined $precomp) {
820             $precomp = cstring($precomp); # Escape literal control sequences
821             $precomp = "/$precomp/";
822         } else {
823             $precomp = "";
824         }
825         my $pmreplroot = $op->pmreplroot;
826         my $pmreplstart;
827         if (ref($pmreplroot) eq "B::GV") {
828             # with C<@stash_array = split(/pat/, str);>,
829             #  *stash_array is stored in /pat/'s pmreplroot.
830             $h{arg} = "($precomp => \@" . $pmreplroot->NAME . ")";
831         } elsif (!ref($pmreplroot) and $pmreplroot) {
832             # same as the last case, except the value is actually a
833             # pad offset for where the GV is kept (this happens under
834             # ithreads)
835             my $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$pmreplroot];
836             $h{arg} = "($precomp => \@" . $gv->NAME . ")";
837         } elsif ($ {$op->pmreplstart}) {
838             undef $lastnext;
839             $pmreplstart = "replstart->" . seq($op->pmreplstart);
840             $h{arg} = "(" . join(" ", $precomp, $pmreplstart) . ")";
841         } else {
842             $h{arg} = "($precomp)";
843         }
844     } elsif ($h{class} eq "PVOP" and $h{name} !~ '^transr?\z') {
845         $h{arg} = '("' . $op->pv . '")';
846         $h{svval} = '"' . $op->pv . '"';
847     } elsif ($h{class} eq "COP") {
848         my $label = $op->label;
849         $h{coplabel} = $label;
850         $label = $label ? "$label: " : "";
851         my $loc = $op->file;
852         my $pathnm = $loc;
853         $loc =~ s[.*/][];
854         my $ln = $op->line;
855         $loc .= ":$ln";
856         my($stash, $cseq) = ($op->stash->NAME, $op->cop_seq - $cop_seq_base);
857         $h{arg} = "($label$stash $cseq $loc)";
858         if ($show_src) {
859             fill_srclines($pathnm) unless exists $srclines{$pathnm};
860             # Would love to retain Jim's use of // but this code needs to be
861             # portable to 5.8.x
862             my $line = $srclines{$pathnm}[$ln];
863             $line = "-src unavailable under -e" unless defined $line;
864             $h{src} = "$ln: $line";
865         }
866     } elsif ($h{class} eq "LOOP") {
867         $h{arg} = "(next->" . seq($op->nextop) . " last->" . seq($op->lastop)
868           . " redo->" . seq($op->redoop) . ")";
869     } elsif ($h{class} eq "LOGOP") {
870         undef $lastnext;
871         $h{arg} = "(other->" . seq($op->other) . ")";
872     }
873     elsif ($h{class} eq "SVOP" or $h{class} eq "PADOP") {
874         unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) {
875             my $idx = ($h{class} eq "SVOP") ? $op->targ : $op->padix;
876             my $preferpv = $h{name} eq "method_named";
877             if ($h{class} eq "PADOP" or !${$op->sv}) {
878                 my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$idx];
879                 $h{arg} = "[" . concise_sv($sv, \%h, $preferpv) . "]";
880                 $h{targarglife} = $h{targarg} = "";
881             } else {
882                 $h{arg} = "(" . concise_sv($op->sv, \%h, $preferpv) . ")";
883             }
884         }
885     }
886     $h{seq} = $h{hyphseq} = seq($op);
887     $h{seq} = "" if $h{seq} eq "-";
888     $h{opt} = $op->opt;
889     $h{label} = $labels{$$op};
890     $h{next} = $op->next;
891     $h{next} = (class($h{next}) eq "NULL") ? "(end)" : seq($h{next});
892     $h{nextaddr} = sprintf("%#x", $ {$op->next});
893     $h{sibaddr} = sprintf("%#x", $ {$op->sibling});
894     $h{firstaddr} = sprintf("%#x", $ {$op->first}) if $op->can("first");
895     $h{lastaddr} = sprintf("%#x", $ {$op->last}) if $op->can("last");
896
897     $h{classsym} = $opclass{$h{class}};
898     $h{flagval} = $op->flags;
899     $h{flags} = op_flags($op->flags);
900     $h{privval} = $op->private;
901     $h{private} = private_flags($h{name}, $op->private);
902     if ($op->can("hints")) {
903       $h{hintsval} = $op->hints;
904       $h{hints} = hints_flags($h{hintsval});
905     } else {
906       $h{hintsval} = $h{hints} = '';
907     }
908     $h{addr} = sprintf("%#x", $$op);
909     $h{typenum} = $op->type;
910     $h{noise} = $linenoise[$op->type];
911
912     return fmt_line(\%h, $op, $format, $level);
913 }
914
915 sub B::OP::concise {
916     my($op, $level) = @_;
917     if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
918         # insert a 'goto' line
919         my $synth = {"seq" => seq($lastnext), "class" => class($lastnext),
920                      "addr" => sprintf("%#x", $$lastnext),
921                      "goto" => seq($lastnext), # simplify goto '-' removal
922              };
923         print $walkHandle fmt_line($synth, $op, $gotofmt, $level+1);
924     }
925     $lastnext = $op->next;
926     print $walkHandle concise_op($op, $level, $format);
927 }
928
929 # B::OP::terse (see Terse.pm) now just calls this
930 sub b_terse {
931     my($op, $level) = @_;
932
933     # This isn't necessarily right, but there's no easy way to get
934     # from an OP to the right CV. This is a limitation of the
935     # ->terse() interface style, and there isn't much to do about
936     # it. In particular, we can die in concise_op if the main pad
937     # isn't long enough, or has the wrong kind of entries, compared to
938     # the pad a sub was compiled with. The fix for that would be to
939     # make a backwards compatible "terse" format that never even
940     # looked at the pad, just like the old B::Terse. I don't think
941     # that's worth the effort, though.
942     $curcv = main_cv unless $curcv;
943
944     if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
945         # insert a 'goto'
946         my $h = {"seq" => seq($lastnext), "class" => class($lastnext),
947                  "addr" => sprintf("%#x", $$lastnext)};
948         print # $walkHandle
949             fmt_line($h, $op, $style{"terse"}[1], $level+1);
950     }
951     $lastnext = $op->next;
952     print # $walkHandle 
953         concise_op($op, $level, $style{"terse"}[0]);
954 }
955
956 sub tree {
957     my $op = shift;
958     my $level = shift;
959     my $style = $tree_decorations[$tree_style];
960     my($space, $single, $kids, $kid, $nokid, $last, $lead, $size) = @$style;
961     my $name = concise_op($op, $level, $treefmt);
962     if (not $op->flags & OPf_KIDS) {
963         return $name . "\n";
964     }
965     my @lines;
966     for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
967         push @lines, tree($kid, $level+1);
968     }
969     my $i;
970     for ($i = $#lines; substr($lines[$i], 0, 1) eq " "; $i--) {
971         $lines[$i] = $space . $lines[$i];
972     }
973     if ($i > 0) {
974         $lines[$i] = $last . $lines[$i];
975         while ($i-- > 1) {
976             if (substr($lines[$i], 0, 1) eq " ") {
977                 $lines[$i] = $nokid . $lines[$i];
978             } else {
979                 $lines[$i] = $kid . $lines[$i];
980             }
981         }
982         $lines[$i] = $kids . $lines[$i];
983     } else {
984         $lines[0] = $single . $lines[0];
985     }
986     return("$name$lead" . shift @lines,
987            map(" " x (length($name)+$size) . $_, @lines));
988 }
989
990 # *** Warning: fragile kludge ahead ***
991 # Because the B::* modules run in the same interpreter as the code
992 # they're compiling, their presence tends to distort the view we have of
993 # the code we're looking at. In particular, perl gives sequence numbers
994 # to COPs. If the program we're looking at were run on its own, this
995 # would start at 1. Because all of B::Concise and all the modules it
996 # uses are compiled first, though, by the time we get to the user's
997 # program the sequence number is already pretty high, which could be
998 # distracting if you're trying to tell OPs apart. Therefore we'd like to
999 # subtract an offset from all the sequence numbers we display, to
1000 # restore the simpler view of the world. The trick is to know what that
1001 # offset will be, when we're still compiling B::Concise!  If we
1002 # hardcoded a value, it would have to change every time B::Concise or
1003 # other modules we use do. To help a little, what we do here is compile
1004 # a little code at the end of the module, and compute the base sequence
1005 # number for the user's program as being a small offset later, so all we
1006 # have to worry about are changes in the offset.
1007
1008 # [For 5.8.x and earlier perl is generating sequence numbers for all ops,
1009 #  and using them to reference labels]
1010
1011
1012 # When you say "perl -MO=Concise -e '$a'", the output should look like:
1013
1014 # 4  <@> leave[t1] vKP/REFC ->(end)
1015 # 1     <0> enter ->2
1016  #^ smallest OP sequence number should be 1
1017 # 2     <;> nextstate(main 1 -e:1) v ->3
1018  #                         ^ smallest COP sequence number should be 1
1019 # -     <1> ex-rv2sv vK/1 ->4
1020 # 3        <$> gvsv(*a) s ->4
1021
1022 # If the second of the marked numbers there isn't 1, it means you need
1023 # to update the corresponding magic number in the next line.
1024 # Remember, this needs to stay the last things in the module.
1025
1026 # Why is this different for MacOS?  Does it matter?
1027 my $cop_seq_mnum = $^O eq 'MacOS' ? 12 : 11;
1028 $cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum;
1029
1030 1;
1031
1032 __END__
1033
1034 =head1 NAME
1035
1036 B::Concise - Walk Perl syntax tree, printing concise info about ops
1037
1038 =head1 SYNOPSIS
1039
1040     perl -MO=Concise[,OPTIONS] foo.pl
1041
1042     use B::Concise qw(set_style add_callback);
1043
1044 =head1 DESCRIPTION
1045
1046 This compiler backend prints the internal OPs of a Perl program's syntax
1047 tree in one of several space-efficient text formats suitable for debugging
1048 the inner workings of perl or other compiler backends. It can print OPs in
1049 the order they appear in the OP tree, in the order they will execute, or
1050 in a text approximation to their tree structure, and the format of the
1051 information displayed is customizable. Its function is similar to that of
1052 perl's B<-Dx> debugging flag or the B<B::Terse> module, but it is more
1053 sophisticated and flexible.
1054
1055 =head1 EXAMPLE
1056
1057 Here's two outputs (or 'renderings'), using the -exec and -basic
1058 (i.e. default) formatting conventions on the same code snippet.
1059
1060     % perl -MO=Concise,-exec -e '$a = $b + 42'
1061     1  <0> enter
1062     2  <;> nextstate(main 1 -e:1) v
1063     3  <#> gvsv[*b] s
1064     4  <$> const[IV 42] s
1065  *  5  <2> add[t3] sK/2
1066     6  <#> gvsv[*a] s
1067     7  <2> sassign vKS/2
1068     8  <@> leave[1 ref] vKP/REFC
1069
1070 In this -exec rendering, each opcode is executed in the order shown.
1071 The add opcode, marked with '*', is discussed in more detail.
1072
1073 The 1st column is the op's sequence number, starting at 1, and is
1074 displayed in base 36 by default.  Here they're purely linear; the
1075 sequences are very helpful when looking at code with loops and
1076 branches.
1077
1078 The symbol between angle brackets indicates the op's type, for
1079 example; <2> is a BINOP, <@> a LISTOP, and <#> is a PADOP, which is
1080 used in threaded perls. (see L</"OP class abbreviations">).
1081
1082 The opname, as in B<'add[t1]'>, may be followed by op-specific
1083 information in parentheses or brackets (ex B<'[t1]'>).
1084
1085 The op-flags (ex B<'sK/2'>) are described in (L</"OP flags
1086 abbreviations">).
1087
1088     % perl -MO=Concise -e '$a = $b + 42'
1089     8  <@> leave[1 ref] vKP/REFC ->(end)
1090     1     <0> enter ->2
1091     2     <;> nextstate(main 1 -e:1) v ->3
1092     7     <2> sassign vKS/2 ->8
1093  *  5        <2> add[t1] sK/2 ->6
1094     -           <1> ex-rv2sv sK/1 ->4
1095     3              <$> gvsv(*b) s ->4
1096     4           <$> const(IV 42) s ->5
1097     -        <1> ex-rv2sv sKRM*/1 ->7
1098     6           <$> gvsv(*a) s ->7
1099
1100 The default rendering is top-down, so they're not in execution order.
1101 This form reflects the way the stack is used to parse and evaluate
1102 expressions; the add operates on the two terms below it in the tree.
1103
1104 Nullops appear as C<ex-opname>, where I<opname> is an op that has been
1105 optimized away by perl.  They're displayed with a sequence-number of
1106 '-', because they are not executed (they don't appear in previous
1107 example), they're printed here because they reflect the parse.
1108
1109 The arrow points to the sequence number of the next op; they're not
1110 displayed in -exec mode, for obvious reasons.
1111
1112 Note that because this rendering was done on a non-threaded perl, the
1113 PADOPs in the previous examples are now SVOPs, and some (but not all)
1114 of the square brackets have been replaced by round ones.  This is a
1115 subtle feature to provide some visual distinction between renderings
1116 on threaded and un-threaded perls.
1117
1118
1119 =head1 OPTIONS
1120
1121 Arguments that don't start with a hyphen are taken to be the names of
1122 subroutines or formats to render; if no
1123 such functions are specified, the main
1124 body of the program (outside any subroutines, and not including use'd
1125 or require'd files) is rendered.  Passing C<BEGIN>, C<UNITCHECK>,
1126 C<CHECK>, C<INIT>, or C<END> will cause all of the corresponding
1127 special blocks to be printed.  Arguments must follow options.
1128
1129 Options affect how things are rendered (ie printed).  They're presented
1130 here by their visual effect, 1st being strongest.  They're grouped
1131 according to how they interrelate; within each group the options are
1132 mutually exclusive (unless otherwise stated).
1133
1134 =head2 Options for Opcode Ordering
1135
1136 These options control the 'vertical display' of opcodes.  The display
1137 'order' is also called 'mode' elsewhere in this document.
1138
1139 =over 4
1140
1141 =item B<-basic>
1142
1143 Print OPs in the order they appear in the OP tree (a preorder
1144 traversal, starting at the root). The indentation of each OP shows its
1145 level in the tree, and the '->' at the end of the line indicates the
1146 next opcode in execution order.  This mode is the default, so the flag
1147 is included simply for completeness.
1148
1149 =item B<-exec>
1150
1151 Print OPs in the order they would normally execute (for the majority
1152 of constructs this is a postorder traversal of the tree, ending at the
1153 root). In most cases the OP that usually follows a given OP will
1154 appear directly below it; alternate paths are shown by indentation. In
1155 cases like loops when control jumps out of a linear path, a 'goto'
1156 line is generated.
1157
1158 =item B<-tree>
1159
1160 Print OPs in a text approximation of a tree, with the root of the tree
1161 at the left and 'left-to-right' order of children transformed into
1162 'top-to-bottom'. Because this mode grows both to the right and down,
1163 it isn't suitable for large programs (unless you have a very wide
1164 terminal).
1165
1166 =back
1167
1168 =head2 Options for Line-Style
1169
1170 These options select the line-style (or just style) used to render
1171 each opcode, and dictates what info is actually printed into each line.
1172
1173 =over 4
1174
1175 =item B<-concise>
1176
1177 Use the author's favorite set of formatting conventions. This is the
1178 default, of course.
1179
1180 =item B<-terse>
1181
1182 Use formatting conventions that emulate the output of B<B::Terse>. The
1183 basic mode is almost indistinguishable from the real B<B::Terse>, and the
1184 exec mode looks very similar, but is in a more logical order and lacks
1185 curly brackets. B<B::Terse> doesn't have a tree mode, so the tree mode
1186 is only vaguely reminiscent of B<B::Terse>.
1187
1188 =item B<-linenoise>
1189
1190 Use formatting conventions in which the name of each OP, rather than being
1191 written out in full, is represented by a one- or two-character abbreviation.
1192 This is mainly a joke.
1193
1194 =item B<-debug>
1195
1196 Use formatting conventions reminiscent of B<B::Debug>; these aren't
1197 very concise at all.
1198
1199 =item B<-env>
1200
1201 Use formatting conventions read from the environment variables
1202 C<B_CONCISE_FORMAT>, C<B_CONCISE_GOTO_FORMAT>, and C<B_CONCISE_TREE_FORMAT>.
1203
1204 =back
1205
1206 =head2 Options for tree-specific formatting
1207
1208 =over 4
1209
1210 =item B<-compact>
1211
1212 Use a tree format in which the minimum amount of space is used for the
1213 lines connecting nodes (one character in most cases). This squeezes out
1214 a few precious columns of screen real estate.
1215
1216 =item B<-loose>
1217
1218 Use a tree format that uses longer edges to separate OP nodes. This format
1219 tends to look better than the compact one, especially in ASCII, and is
1220 the default.
1221
1222 =item B<-vt>
1223
1224 Use tree connecting characters drawn from the VT100 line-drawing set.
1225 This looks better if your terminal supports it.
1226
1227 =item B<-ascii>
1228
1229 Draw the tree with standard ASCII characters like C<+> and C<|>. These don't
1230 look as clean as the VT100 characters, but they'll work with almost any
1231 terminal (or the horizontal scrolling mode of less(1)) and are suitable
1232 for text documentation or email. This is the default.
1233
1234 =back
1235
1236 These are pairwise exclusive, i.e. compact or loose, vt or ascii.
1237
1238 =head2 Options controlling sequence numbering
1239
1240 =over 4
1241
1242 =item B<-base>I<n>
1243
1244 Print OP sequence numbers in base I<n>. If I<n> is greater than 10, the
1245 digit for 11 will be 'a', and so on. If I<n> is greater than 36, the digit
1246 for 37 will be 'A', and so on until 62. Values greater than 62 are not
1247 currently supported. The default is 36.
1248
1249 =item B<-bigendian>
1250
1251 Print sequence numbers with the most significant digit first. This is the
1252 usual convention for Arabic numerals, and the default.
1253
1254 =item B<-littleendian>
1255
1256 Print sequence numbers with the least significant digit first.  This is
1257 obviously mutually exclusive with bigendian.
1258
1259 =back
1260
1261 =head2 Other options
1262
1263 =over 4
1264
1265 =item B<-src>
1266
1267 With this option, the rendering of each statement (starting with the
1268 nextstate OP) will be preceded by the 1st line of source code that
1269 generates it.  For example:
1270
1271     1  <0> enter
1272     # 1: my $i;
1273     2  <;> nextstate(main 1 junk.pl:1) v:{
1274     3  <0> padsv[$i:1,10] vM/LVINTRO
1275     # 3: for $i (0..9) {
1276     4  <;> nextstate(main 3 junk.pl:3) v:{
1277     5  <0> pushmark s
1278     6  <$> const[IV 0] s
1279     7  <$> const[IV 9] s
1280     8  <{> enteriter(next->j last->m redo->9)[$i:1,10] lKS
1281     k  <0> iter s
1282     l  <|> and(other->9) vK/1
1283     # 4:     print "line ";
1284     9      <;> nextstate(main 2 junk.pl:4) v
1285     a      <0> pushmark s
1286     b      <$> const[PV "line "] s
1287     c      <@> print vK
1288     # 5:     print "$i\n";
1289     ...
1290
1291 =item B<-stash="somepackage">
1292
1293 With this, "somepackage" will be required, then the stash is
1294 inspected, and each function is rendered.
1295
1296 =back
1297
1298 The following options are pairwise exclusive.
1299
1300 =over 4
1301
1302 =item B<-main>
1303
1304 Include the main program in the output, even if subroutines were also
1305 specified.  This rendering is normally suppressed when a subroutine
1306 name or reference is given.
1307
1308 =item B<-nomain>
1309
1310 This restores the default behavior after you've changed it with '-main'
1311 (it's not normally needed).  If no subroutine name/ref is given, main is
1312 rendered, regardless of this flag.
1313
1314 =item B<-nobanner>
1315
1316 Renderings usually include a banner line identifying the function name
1317 or stringified subref.  This suppresses the printing of the banner.
1318
1319 TBC: Remove the stringified coderef; while it provides a 'cookie' for
1320 each function rendered, the cookies used should be 1,2,3.. not a
1321 random hex-address.  It also complicates string comparison of two
1322 different trees.
1323
1324 =item B<-banner>
1325
1326 restores default banner behavior.
1327
1328 =item B<-banneris> => subref
1329
1330 TBC: a hookpoint (and an option to set it) for a user-supplied
1331 function to produce a banner appropriate for users needs.  It's not
1332 ideal, because the rendering-state variables, which are a natural
1333 candidate for use in concise.t, are unavailable to the user.
1334
1335 =back
1336
1337 =head2 Option Stickiness
1338
1339 If you invoke Concise more than once in a program, you should know that
1340 the options are 'sticky'.  This means that the options you provide in
1341 the first call will be remembered for the 2nd call, unless you
1342 re-specify or change them.
1343
1344 =head1 ABBREVIATIONS
1345
1346 The concise style uses symbols to convey maximum info with minimal
1347 clutter (like hex addresses).  With just a little practice, you can
1348 start to see the flowers, not just the branches, in the trees.
1349
1350 =head2 OP class abbreviations
1351
1352 These symbols appear before the op-name, and indicate the
1353 B:: namespace that represents the ops in your Perl code.
1354
1355     0      OP (aka BASEOP)  An OP with no children
1356     1      UNOP             An OP with one child
1357     2      BINOP            An OP with two children
1358     |      LOGOP            A control branch OP
1359     @      LISTOP           An OP that could have lots of children
1360     /      PMOP             An OP with a regular expression
1361     $      SVOP             An OP with an SV
1362     "      PVOP             An OP with a string
1363     {      LOOP             An OP that holds pointers for a loop
1364     ;      COP              An OP that marks the start of a statement
1365     #      PADOP            An OP with a GV on the pad
1366
1367 =head2 OP flags abbreviations
1368
1369 OP flags are either public or private.  The public flags alter the
1370 behavior of each opcode in consistent ways, and are represented by 0
1371 or more single characters.
1372
1373     v      OPf_WANT_VOID    Want nothing (void context)
1374     s      OPf_WANT_SCALAR  Want single value (scalar context)
1375     l      OPf_WANT_LIST    Want list of any length (list context)
1376                             Want is unknown
1377     K      OPf_KIDS         There is a firstborn child.
1378     P      OPf_PARENS       This operator was parenthesized.
1379                              (Or block needs explicit scope entry.)
1380     R      OPf_REF          Certified reference.
1381                              (Return container, not containee).
1382     M      OPf_MOD          Will modify (lvalue).
1383     S      OPf_STACKED      Some arg is arriving on the stack.
1384     *      OPf_SPECIAL      Do something weird for this op (see op.h)
1385
1386 Private flags, if any are set for an opcode, are displayed after a '/'
1387
1388     8  <@> leave[1 ref] vKP/REFC ->(end)
1389     7     <2> sassign vKS/2 ->8
1390
1391 They're opcode specific, and occur less often than the public ones, so
1392 they're represented by short mnemonics instead of single-chars; see
1393 F<op.h> for gory details, or try this quick 2-liner:
1394
1395   $> perl -MB::Concise -de 1
1396   DB<1> |x \%B::Concise::priv
1397
1398 =head1 FORMATTING SPECIFICATIONS
1399
1400 For each line-style ('concise', 'terse', 'linenoise', etc.) there are
1401 3 format-specs which control how OPs are rendered.
1402
1403 The first is the 'default' format, which is used in both basic and exec
1404 modes to print all opcodes.  The 2nd, goto-format, is used in exec
1405 mode when branches are encountered.  They're not real opcodes, and are
1406 inserted to look like a closing curly brace.  The tree-format is tree
1407 specific.
1408
1409 When a line is rendered, the correct format-spec is copied and scanned
1410 for the following items; data is substituted in, and other
1411 manipulations like basic indenting are done, for each opcode rendered.
1412
1413 There are 3 kinds of items that may be populated; special patterns,
1414 #vars, and literal text, which is copied verbatim.  (Yes, it's a set
1415 of s///g steps.)
1416
1417 =head2 Special Patterns
1418
1419 These items are the primitives used to perform indenting, and to
1420 select text from amongst alternatives.
1421
1422 =over 4
1423
1424 =item B<(x(>I<exec_text>B<;>I<basic_text>B<)x)>
1425
1426 Generates I<exec_text> in exec mode, or I<basic_text> in basic mode.
1427
1428 =item B<(*(>I<text>B<)*)>
1429
1430 Generates one copy of I<text> for each indentation level.
1431
1432 =item B<(*(>I<text1>B<;>I<text2>B<)*)>
1433
1434 Generates one fewer copies of I<text1> than the indentation level, followed
1435 by one copy of I<text2> if the indentation level is more than 0.
1436
1437 =item B<(?(>I<text1>B<#>I<var>I<Text2>B<)?)>
1438
1439 If the value of I<var> is true (not empty or zero), generates the
1440 value of I<var> surrounded by I<text1> and I<Text2>, otherwise
1441 nothing.
1442
1443 =item B<~>
1444
1445 Any number of tildes and surrounding whitespace will be collapsed to
1446 a single space.
1447
1448 =back
1449
1450 =head2 # Variables
1451
1452 These #vars represent opcode properties that you may want as part of
1453 your rendering.  The '#' is intended as a private sigil; a #var's
1454 value is interpolated into the style-line, much like "read $this".
1455
1456 These vars take 3 forms:
1457
1458 =over 4
1459
1460 =item B<#>I<var>
1461
1462 A property named 'var' is assumed to exist for the opcodes, and is
1463 interpolated into the rendering.
1464
1465 =item B<#>I<var>I<N>
1466
1467 Generates the value of I<var>, left justified to fill I<N> spaces.
1468 Note that this means while you can have properties 'foo' and 'foo2',
1469 you cannot render 'foo2', but you could with 'foo2a'.  You would be
1470 wise not to rely on this behavior going forward ;-)
1471
1472 =item B<#>I<Var>
1473
1474 This ucfirst form of #var generates a tag-value form of itself for
1475 display; it converts '#Var' into a 'Var => #var' style, which is then
1476 handled as described above.  (Imp-note: #Vars cannot be used for
1477 conditional-fills, because the => #var transform is done after the check
1478 for #Var's value).
1479
1480 =back
1481
1482 The following variables are 'defined' by B::Concise; when they are
1483 used in a style, their respective values are plugged into the
1484 rendering of each opcode.
1485
1486 Only some of these are used by the standard styles, the others are
1487 provided for you to delve into optree mechanics, should you wish to
1488 add a new style (see L</add_style> below) that uses them.  You can
1489 also add new ones using L</add_callback>.
1490
1491 =over 4
1492
1493 =item B<#addr>
1494
1495 The address of the OP, in hexadecimal.
1496
1497 =item B<#arg>
1498
1499 The OP-specific information of the OP (such as the SV for an SVOP, the
1500 non-local exit pointers for a LOOP, etc.) enclosed in parentheses.
1501
1502 =item B<#class>
1503
1504 The B-determined class of the OP, in all caps.
1505
1506 =item B<#classsym>
1507
1508 A single symbol abbreviating the class of the OP.
1509
1510 =item B<#coplabel>
1511
1512 The label of the statement or block the OP is the start of, if any.
1513
1514 =item B<#exname>
1515
1516 The name of the OP, or 'ex-foo' if the OP is a null that used to be a foo.
1517
1518 =item B<#extarg>
1519
1520 The target of the OP, or nothing for a nulled OP.
1521
1522 =item B<#firstaddr>
1523
1524 The address of the OP's first child, in hexadecimal.
1525
1526 =item B<#flags>
1527
1528 The OP's flags, abbreviated as a series of symbols.
1529
1530 =item B<#flagval>
1531
1532 The numeric value of the OP's flags.
1533
1534 =item B<#hints>
1535
1536 The COP's hint flags, rendered with abbreviated names if possible. An empty
1537 string if this is not a COP. Here are the symbols used:
1538
1539     $ strict refs
1540     & strict subs
1541     * strict vars
1542    x$ explicit use/no strict refs
1543    x& explicit use/no strict subs
1544    x* explicit use/no strict vars
1545     i integers
1546     l locale
1547     b bytes
1548     { block scope
1549     % localise %^H
1550     < open in
1551     > open out
1552     I overload int
1553     F overload float
1554     B overload binary
1555     S overload string
1556     R overload re
1557     T taint
1558     E eval
1559     X filetest access
1560     U utf-8
1561
1562 =item B<#hintsval>
1563
1564 The numeric value of the COP's hint flags, or an empty string if this is not
1565 a COP.
1566
1567 =item B<#hyphseq>
1568
1569 The sequence number of the OP, or a hyphen if it doesn't have one.
1570
1571 =item B<#label>
1572
1573 'NEXT', 'LAST', or 'REDO' if the OP is a target of one of those in exec
1574 mode, or empty otherwise.
1575
1576 =item B<#lastaddr>
1577
1578 The address of the OP's last child, in hexadecimal.
1579
1580 =item B<#name>
1581
1582 The OP's name.
1583
1584 =item B<#NAME>
1585
1586 The OP's name, in all caps.
1587
1588 =item B<#next>
1589
1590 The sequence number of the OP's next OP.
1591
1592 =item B<#nextaddr>
1593
1594 The address of the OP's next OP, in hexadecimal.
1595
1596 =item B<#noise>
1597
1598 A one- or two-character abbreviation for the OP's name.
1599
1600 =item B<#private>
1601
1602 The OP's private flags, rendered with abbreviated names if possible.
1603
1604 =item B<#privval>
1605
1606 The numeric value of the OP's private flags.
1607
1608 =item B<#seq>
1609
1610 The sequence number of the OP. Note that this is a sequence number
1611 generated by B::Concise.
1612
1613 =item B<#seqnum>
1614
1615 5.8.x and earlier only. 5.9 and later do not provide this.
1616
1617 The real sequence number of the OP, as a regular number and not adjusted
1618 to be relative to the start of the real program. (This will generally be
1619 a fairly large number because all of B<B::Concise> is compiled before
1620 your program is).
1621
1622 =item B<#opt>
1623
1624 Whether or not the op has been optimised by the peephole optimiser.
1625
1626 Only available in 5.9 and later.
1627
1628 =item B<#sibaddr>
1629
1630 The address of the OP's next youngest sibling, in hexadecimal.
1631
1632 =item B<#svaddr>
1633
1634 The address of the OP's SV, if it has an SV, in hexadecimal.
1635
1636 =item B<#svclass>
1637
1638 The class of the OP's SV, if it has one, in all caps (e.g., 'IV').
1639
1640 =item B<#svval>
1641
1642 The value of the OP's SV, if it has one, in a short human-readable format.
1643
1644 =item B<#targ>
1645
1646 The numeric value of the OP's targ.
1647
1648 =item B<#targarg>
1649
1650 The name of the variable the OP's targ refers to, if any, otherwise the
1651 letter t followed by the OP's targ in decimal.
1652
1653 =item B<#targarglife>
1654
1655 Same as B<#targarg>, but followed by the COP sequence numbers that delimit
1656 the variable's lifetime (or 'end' for a variable in an open scope) for a
1657 variable.
1658
1659 =item B<#typenum>
1660
1661 The numeric value of the OP's type, in decimal.
1662
1663 =back
1664
1665 =head1 One-Liner Command tips
1666
1667 =over 4
1668
1669 =item perl -MO=Concise,bar foo.pl
1670
1671 Renders only bar() from foo.pl.  To see main, drop the ',bar'.  To see
1672 both, add ',-main'
1673
1674 =item perl -MDigest::MD5=md5 -MO=Concise,md5 -e1
1675
1676 Identifies md5 as an XS function.  The export is needed so that BC can
1677 find it in main.
1678
1679 =item perl -MPOSIX -MO=Concise,_POSIX_ARG_MAX -e1
1680
1681 Identifies _POSIX_ARG_MAX as a constant sub, optimized to an IV.
1682 Although POSIX isn't entirely consistent across platforms, this is
1683 likely to be present in virtually all of them.
1684
1685 =item perl -MPOSIX -MO=Concise,a -e 'print _POSIX_SAVED_IDS'
1686
1687 This renders a print statement, which includes a call to the function.
1688 It's identical to rendering a file with a use call and that single
1689 statement, except for the filename which appears in the nextstate ops.
1690
1691 =item perl -MPOSIX -MO=Concise,a -e 'sub a{_POSIX_SAVED_IDS}'
1692
1693 This is B<very> similar to previous, only the first two ops differ.  This
1694 subroutine rendering is more representative, insofar as a single main
1695 program will have many subs.
1696
1697 =item perl -MB::Concise -e 'B::Concise::compile("-exec","-src", \%B::Concise::)->()'
1698
1699 This renders all functions in the B::Concise package with the source
1700 lines.  It eschews the O framework so that the stashref can be passed
1701 directly to B::Concise::compile().  See -stash option for a more
1702 convenient way to render a package.
1703
1704 =back
1705
1706 =head1 Using B::Concise outside of the O framework
1707
1708 The common (and original) usage of B::Concise was for command-line
1709 renderings of simple code, as given in EXAMPLE.  But you can also use
1710 B<B::Concise> from your code, and call compile() directly, and
1711 repeatedly.  By doing so, you can avoid the compile-time only
1712 operation of O.pm, and even use the debugger to step through
1713 B::Concise::compile() itself.
1714
1715 Once you're doing this, you may alter Concise output by adding new
1716 rendering styles, and by optionally adding callback routines which
1717 populate new variables, if such were referenced from those (just
1718 added) styles.  
1719
1720 =head2 Example: Altering Concise Renderings
1721
1722     use B::Concise qw(set_style add_callback);
1723     add_style($yourStyleName => $defaultfmt, $gotofmt, $treefmt);
1724     add_callback
1725       ( sub {
1726             my ($h, $op, $format, $level, $stylename) = @_;
1727             $h->{variable} = some_func($op);
1728         });
1729     $walker = B::Concise::compile(@options,@subnames,@subrefs);
1730     $walker->();
1731
1732 =head2 set_style()
1733
1734 B<set_style> accepts 3 arguments, and updates the three format-specs
1735 comprising a line-style (basic-exec, goto, tree).  It has one minor
1736 drawback though; it doesn't register the style under a new name.  This
1737 can become an issue if you render more than once and switch styles.
1738 Thus you may prefer to use add_style() and/or set_style_standard()
1739 instead.
1740
1741 =head2 set_style_standard($name)
1742
1743 This restores one of the standard line-styles: C<terse>, C<concise>,
1744 C<linenoise>, C<debug>, C<env>, into effect.  It also accepts style
1745 names previously defined with add_style().
1746
1747 =head2 add_style ()
1748
1749 This subroutine accepts a new style name and three style arguments as
1750 above, and creates, registers, and selects the newly named style.  It is
1751 an error to re-add a style; call set_style_standard() to switch between
1752 several styles.
1753
1754 =head2 add_callback ()
1755
1756 If your newly minted styles refer to any new #variables, you'll need
1757 to define a callback subroutine that will populate (or modify) those
1758 variables.  They are then available for use in the style you've
1759 chosen.
1760
1761 The callbacks are called for each opcode visited by Concise, in the
1762 same order as they are added.  Each subroutine is passed five
1763 parameters.
1764
1765   1. A hashref, containing the variable names and values which are
1766      populated into the report-line for the op
1767   2. the op, as a B<B::OP> object
1768   3. a reference to the format string
1769   4. the formatting (indent) level
1770   5. the selected stylename
1771
1772 To define your own variables, simply add them to the hash, or change
1773 existing values if you need to.  The level and format are passed in as
1774 references to scalars, but it is unlikely that they will need to be
1775 changed or even used.
1776
1777 =head2 Running B::Concise::compile()
1778
1779 B<compile> accepts options as described above in L</OPTIONS>, and
1780 arguments, which are either coderefs, or subroutine names.
1781
1782 It constructs and returns a $treewalker coderef, which when invoked,
1783 traverses, or walks, and renders the optrees of the given arguments to
1784 STDOUT.  You can reuse this, and can change the rendering style used
1785 each time; thereafter the coderef renders in the new style.
1786
1787 B<walk_output> lets you change the print destination from STDOUT to
1788 another open filehandle, or into a string passed as a ref (unless
1789 you've built perl with -Uuseperlio).
1790
1791     my $walker = B::Concise::compile('-terse','aFuncName', \&aSubRef);  # 1
1792     walk_output(\my $buf);
1793     $walker->();                        # 1 renders -terse
1794     set_style_standard('concise');      # 2
1795     $walker->();                        # 2 renders -concise
1796     $walker->(@new);                    # 3 renders whatever
1797     print "3 different renderings: terse, concise, and @new: $buf\n";
1798
1799 When $walker is called, it traverses the subroutines supplied when it
1800 was created, and renders them using the current style.  You can change
1801 the style afterwards in several different ways:
1802
1803   1. call C<compile>, altering style or mode/order
1804   2. call C<set_style_standard>
1805   3. call $walker, passing @new options
1806
1807 Passing new options to the $walker is the easiest way to change
1808 amongst any pre-defined styles (the ones you add are automatically
1809 recognized as options), and is the only way to alter rendering order
1810 without calling compile again.  Note however that rendering state is
1811 still shared amongst multiple $walker objects, so they must still be
1812 used in a coordinated manner.
1813
1814 =head2 B::Concise::reset_sequence()
1815
1816 This function (not exported) lets you reset the sequence numbers (note
1817 that they're numbered arbitrarily, their goal being to be human
1818 readable).  Its purpose is mostly to support testing, i.e. to compare
1819 the concise output from two identical anonymous subroutines (but
1820 different instances).  Without the reset, B::Concise, seeing that
1821 they're separate optrees, generates different sequence numbers in
1822 the output.
1823
1824 =head2 Errors
1825
1826 Errors in rendering (non-existent function-name, non-existent coderef)
1827 are written to the STDOUT, or wherever you've set it via
1828 walk_output().
1829
1830 Errors using the various *style* calls, and bad args to walk_output(),
1831 result in die().  Use an eval if you wish to catch these errors and
1832 continue processing.
1833
1834 =head1 AUTHOR
1835
1836 Stephen McCamant, E<lt>smcc@CSUA.Berkeley.EDUE<gt>.
1837
1838 =cut