This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
130c84c5b6f99e7ec717ce4e19c7b85ea7bc03ed
[perl5.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 && $sv->FLAGS & SVf_POK) {
736             $hr->{svval} .= cstring($sv->PV);
737         } elsif ($sv->FLAGS & SVf_NOK) {
738             $hr->{svval} .= $sv->NV;
739         } elsif ($sv->FLAGS & SVf_IOK) {
740             $hr->{svval} .= $sv->int_value;
741         } elsif ($sv->FLAGS & SVf_POK) {
742             $hr->{svval} .= cstring($sv->PV);
743         } elsif (class($sv) eq "HV") {
744             $hr->{svval} .= 'HASH';
745         }
746
747         $hr->{svval} = 'undef' unless defined $hr->{svval};
748         my $out = $hr->{svclass};
749         return $out .= " $hr->{svval}" ; 
750     }
751 }
752
753 my %srclines;
754
755 sub fill_srclines {
756     my $fullnm = shift;
757     if ($fullnm eq '-e') {
758         $srclines{$fullnm} = [ $fullnm, "-src not supported for -e" ];
759         return;
760     }
761     open (my $fh, '<', $fullnm)
762         or warn "# $fullnm: $!, (chdirs not supported by this feature yet)\n"
763         and return;
764     my @l = <$fh>;
765     chomp @l;
766     unshift @l, $fullnm; # like @{_<$fullnm} in debug, array starts at 1
767     $srclines{$fullnm} = \@l;
768 }
769
770 sub concise_op {
771     my ($op, $level, $format) = @_;
772     my %h;
773     $h{exname} = $h{name} = $op->name;
774     $h{NAME} = uc $h{name};
775     $h{class} = class($op);
776     $h{extarg} = $h{targ} = $op->targ;
777     $h{extarg} = "" unless $h{extarg};
778     if ($h{name} eq "null" and $h{targ}) {
779         # targ holds the old type
780         $h{exname} = "ex-" . substr(ppname($h{targ}), 3);
781         $h{extarg} = "";
782     } elsif ($op->name =~ /^leave(sub(lv)?|write)?$/) {
783         # targ potentially holds a reference count
784         if ($op->private & 64) {
785             my $refs = "ref" . ($h{targ} != 1 ? "s" : "");
786             $h{targarglife} = $h{targarg} = "$h{targ} $refs";
787         }
788     } elsif ($h{targ}) {
789         my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}];
790         if (defined $padname and class($padname) ne "SPECIAL") {
791             $h{targarg}  = $padname->PVX;
792             if ($padname->FLAGS & SVf_FAKE) {
793                 # These changes relate to the jumbo closure fix.
794                 # See changes 19939 and 20005
795                 my $fake = '';
796                 $fake .= 'a'
797                     if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_ANON;
798                 $fake .= 'm'
799                     if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_MULTI;
800                 $fake .= ':' . $padname->PARENT_PAD_INDEX
801                     if $curcv->CvFLAGS & CVf_ANON;
802                 $h{targarglife} = "$h{targarg}:FAKE:$fake";
803             }
804             else {
805                 my $intro = $padname->COP_SEQ_RANGE_LOW - $cop_seq_base;
806                 my $finish = int($padname->COP_SEQ_RANGE_HIGH) - $cop_seq_base;
807                 $finish = "end" if $finish == 999999999 - $cop_seq_base;
808                 $h{targarglife} = "$h{targarg}:$intro,$finish";
809             }
810         } else {
811             $h{targarglife} = $h{targarg} = "t" . $h{targ};
812         }
813     }
814     $h{arg} = "";
815     $h{svclass} = $h{svaddr} = $h{svval} = "";
816     if ($h{class} eq "PMOP") {
817         my $precomp = $op->precomp;
818         if (defined $precomp) {
819             $precomp = cstring($precomp); # Escape literal control sequences
820             $precomp = "/$precomp/";
821         } else {
822             $precomp = "";
823         }
824         my $pmreplroot = $op->pmreplroot;
825         my $pmreplstart;
826         if (ref($pmreplroot) eq "B::GV") {
827             # with C<@stash_array = split(/pat/, str);>,
828             #  *stash_array is stored in /pat/'s pmreplroot.
829             $h{arg} = "($precomp => \@" . $pmreplroot->NAME . ")";
830         } elsif (!ref($pmreplroot) and $pmreplroot) {
831             # same as the last case, except the value is actually a
832             # pad offset for where the GV is kept (this happens under
833             # ithreads)
834             my $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$pmreplroot];
835             $h{arg} = "($precomp => \@" . $gv->NAME . ")";
836         } elsif ($ {$op->pmreplstart}) {
837             undef $lastnext;
838             $pmreplstart = "replstart->" . seq($op->pmreplstart);
839             $h{arg} = "(" . join(" ", $precomp, $pmreplstart) . ")";
840         } else {
841             $h{arg} = "($precomp)";
842         }
843     } elsif ($h{class} eq "PVOP" and $h{name} !~ '^transr?\z') {
844         $h{arg} = '("' . $op->pv . '")';
845         $h{svval} = '"' . $op->pv . '"';
846     } elsif ($h{class} eq "COP") {
847         my $label = $op->label;
848         $h{coplabel} = $label;
849         $label = $label ? "$label: " : "";
850         my $loc = $op->file;
851         my $pathnm = $loc;
852         $loc =~ s[.*/][];
853         my $ln = $op->line;
854         $loc .= ":$ln";
855         my($stash, $cseq) = ($op->stash->NAME, $op->cop_seq - $cop_seq_base);
856         $h{arg} = "($label$stash $cseq $loc)";
857         if ($show_src) {
858             fill_srclines($pathnm) unless exists $srclines{$pathnm};
859             # Would love to retain Jim's use of // but this code needs to be
860             # portable to 5.8.x
861             my $line = $srclines{$pathnm}[$ln];
862             $line = "-src unavailable under -e" unless defined $line;
863             $h{src} = "$ln: $line";
864         }
865     } elsif ($h{class} eq "LOOP") {
866         $h{arg} = "(next->" . seq($op->nextop) . " last->" . seq($op->lastop)
867           . " redo->" . seq($op->redoop) . ")";
868     } elsif ($h{class} eq "LOGOP") {
869         undef $lastnext;
870         $h{arg} = "(other->" . seq($op->other) . ")";
871     }
872     elsif ($h{class} eq "SVOP" or $h{class} eq "PADOP") {
873         unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) {
874             my $idx = ($h{class} eq "SVOP") ? $op->targ : $op->padix;
875             my $preferpv = $h{name} eq "method_named";
876             if ($h{class} eq "PADOP" or !${$op->sv}) {
877                 my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$idx];
878                 $h{arg} = "[" . concise_sv($sv, \%h, $preferpv) . "]";
879                 $h{targarglife} = $h{targarg} = "";
880             } else {
881                 $h{arg} = "(" . concise_sv($op->sv, \%h, $preferpv) . ")";
882             }
883         }
884     }
885     $h{seq} = $h{hyphseq} = seq($op);
886     $h{seq} = "" if $h{seq} eq "-";
887     $h{opt} = $op->opt;
888     $h{label} = $labels{$$op};
889     $h{next} = $op->next;
890     $h{next} = (class($h{next}) eq "NULL") ? "(end)" : seq($h{next});
891     $h{nextaddr} = sprintf("%#x", $ {$op->next});
892     $h{sibaddr} = sprintf("%#x", $ {$op->sibling});
893     $h{firstaddr} = sprintf("%#x", $ {$op->first}) if $op->can("first");
894     $h{lastaddr} = sprintf("%#x", $ {$op->last}) if $op->can("last");
895
896     $h{classsym} = $opclass{$h{class}};
897     $h{flagval} = $op->flags;
898     $h{flags} = op_flags($op->flags);
899     $h{privval} = $op->private;
900     $h{private} = private_flags($h{name}, $op->private);
901     if ($op->can("hints")) {
902       $h{hintsval} = $op->hints;
903       $h{hints} = hints_flags($h{hintsval});
904     } else {
905       $h{hintsval} = $h{hints} = '';
906     }
907     $h{addr} = sprintf("%#x", $$op);
908     $h{typenum} = $op->type;
909     $h{noise} = $linenoise[$op->type];
910
911     return fmt_line(\%h, $op, $format, $level);
912 }
913
914 sub B::OP::concise {
915     my($op, $level) = @_;
916     if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
917         # insert a 'goto' line
918         my $synth = {"seq" => seq($lastnext), "class" => class($lastnext),
919                      "addr" => sprintf("%#x", $$lastnext),
920                      "goto" => seq($lastnext), # simplify goto '-' removal
921              };
922         print $walkHandle fmt_line($synth, $op, $gotofmt, $level+1);
923     }
924     $lastnext = $op->next;
925     print $walkHandle concise_op($op, $level, $format);
926 }
927
928 # B::OP::terse (see Terse.pm) now just calls this
929 sub b_terse {
930     my($op, $level) = @_;
931
932     # This isn't necessarily right, but there's no easy way to get
933     # from an OP to the right CV. This is a limitation of the
934     # ->terse() interface style, and there isn't much to do about
935     # it. In particular, we can die in concise_op if the main pad
936     # isn't long enough, or has the wrong kind of entries, compared to
937     # the pad a sub was compiled with. The fix for that would be to
938     # make a backwards compatible "terse" format that never even
939     # looked at the pad, just like the old B::Terse. I don't think
940     # that's worth the effort, though.
941     $curcv = main_cv unless $curcv;
942
943     if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
944         # insert a 'goto'
945         my $h = {"seq" => seq($lastnext), "class" => class($lastnext),
946                  "addr" => sprintf("%#x", $$lastnext)};
947         print # $walkHandle
948             fmt_line($h, $op, $style{"terse"}[1], $level+1);
949     }
950     $lastnext = $op->next;
951     print # $walkHandle 
952         concise_op($op, $level, $style{"terse"}[0]);
953 }
954
955 sub tree {
956     my $op = shift;
957     my $level = shift;
958     my $style = $tree_decorations[$tree_style];
959     my($space, $single, $kids, $kid, $nokid, $last, $lead, $size) = @$style;
960     my $name = concise_op($op, $level, $treefmt);
961     if (not $op->flags & OPf_KIDS) {
962         return $name . "\n";
963     }
964     my @lines;
965     for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
966         push @lines, tree($kid, $level+1);
967     }
968     my $i;
969     for ($i = $#lines; substr($lines[$i], 0, 1) eq " "; $i--) {
970         $lines[$i] = $space . $lines[$i];
971     }
972     if ($i > 0) {
973         $lines[$i] = $last . $lines[$i];
974         while ($i-- > 1) {
975             if (substr($lines[$i], 0, 1) eq " ") {
976                 $lines[$i] = $nokid . $lines[$i];
977             } else {
978                 $lines[$i] = $kid . $lines[$i];
979             }
980         }
981         $lines[$i] = $kids . $lines[$i];
982     } else {
983         $lines[0] = $single . $lines[0];
984     }
985     return("$name$lead" . shift @lines,
986            map(" " x (length($name)+$size) . $_, @lines));
987 }
988
989 # *** Warning: fragile kludge ahead ***
990 # Because the B::* modules run in the same interpreter as the code
991 # they're compiling, their presence tends to distort the view we have of
992 # the code we're looking at. In particular, perl gives sequence numbers
993 # to COPs. If the program we're looking at were run on its own, this
994 # would start at 1. Because all of B::Concise and all the modules it
995 # uses are compiled first, though, by the time we get to the user's
996 # program the sequence number is already pretty high, which could be
997 # distracting if you're trying to tell OPs apart. Therefore we'd like to
998 # subtract an offset from all the sequence numbers we display, to
999 # restore the simpler view of the world. The trick is to know what that
1000 # offset will be, when we're still compiling B::Concise!  If we
1001 # hardcoded a value, it would have to change every time B::Concise or
1002 # other modules we use do. To help a little, what we do here is compile
1003 # a little code at the end of the module, and compute the base sequence
1004 # number for the user's program as being a small offset later, so all we
1005 # have to worry about are changes in the offset.
1006
1007 # [For 5.8.x and earlier perl is generating sequence numbers for all ops,
1008 #  and using them to reference labels]
1009
1010
1011 # When you say "perl -MO=Concise -e '$a'", the output should look like:
1012
1013 # 4  <@> leave[t1] vKP/REFC ->(end)
1014 # 1     <0> enter ->2
1015  #^ smallest OP sequence number should be 1
1016 # 2     <;> nextstate(main 1 -e:1) v ->3
1017  #                         ^ smallest COP sequence number should be 1
1018 # -     <1> ex-rv2sv vK/1 ->4
1019 # 3        <$> gvsv(*a) s ->4
1020
1021 # If the second of the marked numbers there isn't 1, it means you need
1022 # to update the corresponding magic number in the next line.
1023 # Remember, this needs to stay the last things in the module.
1024
1025 # Why is this different for MacOS?  Does it matter?
1026 my $cop_seq_mnum = $^O eq 'MacOS' ? 12 : 11;
1027 $cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum;
1028
1029 1;
1030
1031 __END__
1032
1033 =head1 NAME
1034
1035 B::Concise - Walk Perl syntax tree, printing concise info about ops
1036
1037 =head1 SYNOPSIS
1038
1039     perl -MO=Concise[,OPTIONS] foo.pl
1040
1041     use B::Concise qw(set_style add_callback);
1042
1043 =head1 DESCRIPTION
1044
1045 This compiler backend prints the internal OPs of a Perl program's syntax
1046 tree in one of several space-efficient text formats suitable for debugging
1047 the inner workings of perl or other compiler backends. It can print OPs in
1048 the order they appear in the OP tree, in the order they will execute, or
1049 in a text approximation to their tree structure, and the format of the
1050 information displayed is customizable. Its function is similar to that of
1051 perl's B<-Dx> debugging flag or the B<B::Terse> module, but it is more
1052 sophisticated and flexible.
1053
1054 =head1 EXAMPLE
1055
1056 Here's two outputs (or 'renderings'), using the -exec and -basic
1057 (i.e. default) formatting conventions on the same code snippet.
1058
1059     % perl -MO=Concise,-exec -e '$a = $b + 42'
1060     1  <0> enter
1061     2  <;> nextstate(main 1 -e:1) v
1062     3  <#> gvsv[*b] s
1063     4  <$> const[IV 42] s
1064  *  5  <2> add[t3] sK/2
1065     6  <#> gvsv[*a] s
1066     7  <2> sassign vKS/2
1067     8  <@> leave[1 ref] vKP/REFC
1068
1069 In this -exec rendering, each opcode is executed in the order shown.
1070 The add opcode, marked with '*', is discussed in more detail.
1071
1072 The 1st column is the op's sequence number, starting at 1, and is
1073 displayed in base 36 by default.  Here they're purely linear; the
1074 sequences are very helpful when looking at code with loops and
1075 branches.
1076
1077 The symbol between angle brackets indicates the op's type, for
1078 example; <2> is a BINOP, <@> a LISTOP, and <#> is a PADOP, which is
1079 used in threaded perls. (see L</"OP class abbreviations">).
1080
1081 The opname, as in B<'add[t1]'>, may be followed by op-specific
1082 information in parentheses or brackets (ex B<'[t1]'>).
1083
1084 The op-flags (ex B<'sK/2'>) are described in (L</"OP flags
1085 abbreviations">).
1086
1087     % perl -MO=Concise -e '$a = $b + 42'
1088     8  <@> leave[1 ref] vKP/REFC ->(end)
1089     1     <0> enter ->2
1090     2     <;> nextstate(main 1 -e:1) v ->3
1091     7     <2> sassign vKS/2 ->8
1092  *  5        <2> add[t1] sK/2 ->6
1093     -           <1> ex-rv2sv sK/1 ->4
1094     3              <$> gvsv(*b) s ->4
1095     4           <$> const(IV 42) s ->5
1096     -        <1> ex-rv2sv sKRM*/1 ->7
1097     6           <$> gvsv(*a) s ->7
1098
1099 The default rendering is top-down, so they're not in execution order.
1100 This form reflects the way the stack is used to parse and evaluate
1101 expressions; the add operates on the two terms below it in the tree.
1102
1103 Nullops appear as C<ex-opname>, where I<opname> is an op that has been
1104 optimized away by perl.  They're displayed with a sequence-number of
1105 '-', because they are not executed (they don't appear in previous
1106 example), they're printed here because they reflect the parse.
1107
1108 The arrow points to the sequence number of the next op; they're not
1109 displayed in -exec mode, for obvious reasons.
1110
1111 Note that because this rendering was done on a non-threaded perl, the
1112 PADOPs in the previous examples are now SVOPs, and some (but not all)
1113 of the square brackets have been replaced by round ones.  This is a
1114 subtle feature to provide some visual distinction between renderings
1115 on threaded and un-threaded perls.
1116
1117
1118 =head1 OPTIONS
1119
1120 Arguments that don't start with a hyphen are taken to be the names of
1121 subroutines or formats to render; if no
1122 such functions are specified, the main
1123 body of the program (outside any subroutines, and not including use'd
1124 or require'd files) is rendered.  Passing C<BEGIN>, C<UNITCHECK>,
1125 C<CHECK>, C<INIT>, or C<END> will cause all of the corresponding
1126 special blocks to be printed.  Arguments must follow options.
1127
1128 Options affect how things are rendered (ie printed).  They're presented
1129 here by their visual effect, 1st being strongest.  They're grouped
1130 according to how they interrelate; within each group the options are
1131 mutually exclusive (unless otherwise stated).
1132
1133 =head2 Options for Opcode Ordering
1134
1135 These options control the 'vertical display' of opcodes.  The display
1136 'order' is also called 'mode' elsewhere in this document.
1137
1138 =over 4
1139
1140 =item B<-basic>
1141
1142 Print OPs in the order they appear in the OP tree (a preorder
1143 traversal, starting at the root). The indentation of each OP shows its
1144 level in the tree, and the '->' at the end of the line indicates the
1145 next opcode in execution order.  This mode is the default, so the flag
1146 is included simply for completeness.
1147
1148 =item B<-exec>
1149
1150 Print OPs in the order they would normally execute (for the majority
1151 of constructs this is a postorder traversal of the tree, ending at the
1152 root). In most cases the OP that usually follows a given OP will
1153 appear directly below it; alternate paths are shown by indentation. In
1154 cases like loops when control jumps out of a linear path, a 'goto'
1155 line is generated.
1156
1157 =item B<-tree>
1158
1159 Print OPs in a text approximation of a tree, with the root of the tree
1160 at the left and 'left-to-right' order of children transformed into
1161 'top-to-bottom'. Because this mode grows both to the right and down,
1162 it isn't suitable for large programs (unless you have a very wide
1163 terminal).
1164
1165 =back
1166
1167 =head2 Options for Line-Style
1168
1169 These options select the line-style (or just style) used to render
1170 each opcode, and dictates what info is actually printed into each line.
1171
1172 =over 4
1173
1174 =item B<-concise>
1175
1176 Use the author's favorite set of formatting conventions. This is the
1177 default, of course.
1178
1179 =item B<-terse>
1180
1181 Use formatting conventions that emulate the output of B<B::Terse>. The
1182 basic mode is almost indistinguishable from the real B<B::Terse>, and the
1183 exec mode looks very similar, but is in a more logical order and lacks
1184 curly brackets. B<B::Terse> doesn't have a tree mode, so the tree mode
1185 is only vaguely reminiscent of B<B::Terse>.
1186
1187 =item B<-linenoise>
1188
1189 Use formatting conventions in which the name of each OP, rather than being
1190 written out in full, is represented by a one- or two-character abbreviation.
1191 This is mainly a joke.
1192
1193 =item B<-debug>
1194
1195 Use formatting conventions reminiscent of B<B::Debug>; these aren't
1196 very concise at all.
1197
1198 =item B<-env>
1199
1200 Use formatting conventions read from the environment variables
1201 C<B_CONCISE_FORMAT>, C<B_CONCISE_GOTO_FORMAT>, and C<B_CONCISE_TREE_FORMAT>.
1202
1203 =back
1204
1205 =head2 Options for tree-specific formatting
1206
1207 =over 4
1208
1209 =item B<-compact>
1210
1211 Use a tree format in which the minimum amount of space is used for the
1212 lines connecting nodes (one character in most cases). This squeezes out
1213 a few precious columns of screen real estate.
1214
1215 =item B<-loose>
1216
1217 Use a tree format that uses longer edges to separate OP nodes. This format
1218 tends to look better than the compact one, especially in ASCII, and is
1219 the default.
1220
1221 =item B<-vt>
1222
1223 Use tree connecting characters drawn from the VT100 line-drawing set.
1224 This looks better if your terminal supports it.
1225
1226 =item B<-ascii>
1227
1228 Draw the tree with standard ASCII characters like C<+> and C<|>. These don't
1229 look as clean as the VT100 characters, but they'll work with almost any
1230 terminal (or the horizontal scrolling mode of less(1)) and are suitable
1231 for text documentation or email. This is the default.
1232
1233 =back
1234
1235 These are pairwise exclusive, i.e. compact or loose, vt or ascii.
1236
1237 =head2 Options controlling sequence numbering
1238
1239 =over 4
1240
1241 =item B<-base>I<n>
1242
1243 Print OP sequence numbers in base I<n>. If I<n> is greater than 10, the
1244 digit for 11 will be 'a', and so on. If I<n> is greater than 36, the digit
1245 for 37 will be 'A', and so on until 62. Values greater than 62 are not
1246 currently supported. The default is 36.
1247
1248 =item B<-bigendian>
1249
1250 Print sequence numbers with the most significant digit first. This is the
1251 usual convention for Arabic numerals, and the default.
1252
1253 =item B<-littleendian>
1254
1255 Print sequence numbers with the least significant digit first.  This is
1256 obviously mutually exclusive with bigendian.
1257
1258 =back
1259
1260 =head2 Other options
1261
1262 =over 4
1263
1264 =item B<-src>
1265
1266 With this option, the rendering of each statement (starting with the
1267 nextstate OP) will be preceded by the 1st line of source code that
1268 generates it.  For example:
1269
1270     1  <0> enter
1271     # 1: my $i;
1272     2  <;> nextstate(main 1 junk.pl:1) v:{
1273     3  <0> padsv[$i:1,10] vM/LVINTRO
1274     # 3: for $i (0..9) {
1275     4  <;> nextstate(main 3 junk.pl:3) v:{
1276     5  <0> pushmark s
1277     6  <$> const[IV 0] s
1278     7  <$> const[IV 9] s
1279     8  <{> enteriter(next->j last->m redo->9)[$i:1,10] lKS
1280     k  <0> iter s
1281     l  <|> and(other->9) vK/1
1282     # 4:     print "line ";
1283     9      <;> nextstate(main 2 junk.pl:4) v
1284     a      <0> pushmark s
1285     b      <$> const[PV "line "] s
1286     c      <@> print vK
1287     # 5:     print "$i\n";
1288     ...
1289
1290 =item B<-stash="somepackage">
1291
1292 With this, "somepackage" will be required, then the stash is
1293 inspected, and each function is rendered.
1294
1295 =back
1296
1297 The following options are pairwise exclusive.
1298
1299 =over 4
1300
1301 =item B<-main>
1302
1303 Include the main program in the output, even if subroutines were also
1304 specified.  This rendering is normally suppressed when a subroutine
1305 name or reference is given.
1306
1307 =item B<-nomain>
1308
1309 This restores the default behavior after you've changed it with '-main'
1310 (it's not normally needed).  If no subroutine name/ref is given, main is
1311 rendered, regardless of this flag.
1312
1313 =item B<-nobanner>
1314
1315 Renderings usually include a banner line identifying the function name
1316 or stringified subref.  This suppresses the printing of the banner.
1317
1318 TBC: Remove the stringified coderef; while it provides a 'cookie' for
1319 each function rendered, the cookies used should be 1,2,3.. not a
1320 random hex-address.  It also complicates string comparison of two
1321 different trees.
1322
1323 =item B<-banner>
1324
1325 restores default banner behavior.
1326
1327 =item B<-banneris> => subref
1328
1329 TBC: a hookpoint (and an option to set it) for a user-supplied
1330 function to produce a banner appropriate for users needs.  It's not
1331 ideal, because the rendering-state variables, which are a natural
1332 candidate for use in concise.t, are unavailable to the user.
1333
1334 =back
1335
1336 =head2 Option Stickiness
1337
1338 If you invoke Concise more than once in a program, you should know that
1339 the options are 'sticky'.  This means that the options you provide in
1340 the first call will be remembered for the 2nd call, unless you
1341 re-specify or change them.
1342
1343 =head1 ABBREVIATIONS
1344
1345 The concise style uses symbols to convey maximum info with minimal
1346 clutter (like hex addresses).  With just a little practice, you can
1347 start to see the flowers, not just the branches, in the trees.
1348
1349 =head2 OP class abbreviations
1350
1351 These symbols appear before the op-name, and indicate the
1352 B:: namespace that represents the ops in your Perl code.
1353
1354     0      OP (aka BASEOP)  An OP with no children
1355     1      UNOP             An OP with one child
1356     2      BINOP            An OP with two children
1357     |      LOGOP            A control branch OP
1358     @      LISTOP           An OP that could have lots of children
1359     /      PMOP             An OP with a regular expression
1360     $      SVOP             An OP with an SV
1361     "      PVOP             An OP with a string
1362     {      LOOP             An OP that holds pointers for a loop
1363     ;      COP              An OP that marks the start of a statement
1364     #      PADOP            An OP with a GV on the pad
1365
1366 =head2 OP flags abbreviations
1367
1368 OP flags are either public or private.  The public flags alter the
1369 behavior of each opcode in consistent ways, and are represented by 0
1370 or more single characters.
1371
1372     v      OPf_WANT_VOID    Want nothing (void context)
1373     s      OPf_WANT_SCALAR  Want single value (scalar context)
1374     l      OPf_WANT_LIST    Want list of any length (list context)
1375                             Want is unknown
1376     K      OPf_KIDS         There is a firstborn child.
1377     P      OPf_PARENS       This operator was parenthesized.
1378                              (Or block needs explicit scope entry.)
1379     R      OPf_REF          Certified reference.
1380                              (Return container, not containee).
1381     M      OPf_MOD          Will modify (lvalue).
1382     S      OPf_STACKED      Some arg is arriving on the stack.
1383     *      OPf_SPECIAL      Do something weird for this op (see op.h)
1384
1385 Private flags, if any are set for an opcode, are displayed after a '/'
1386
1387     8  <@> leave[1 ref] vKP/REFC ->(end)
1388     7     <2> sassign vKS/2 ->8
1389
1390 They're opcode specific, and occur less often than the public ones, so
1391 they're represented by short mnemonics instead of single-chars; see
1392 F<op.h> for gory details, or try this quick 2-liner:
1393
1394   $> perl -MB::Concise -de 1
1395   DB<1> |x \%B::Concise::priv
1396
1397 =head1 FORMATTING SPECIFICATIONS
1398
1399 For each line-style ('concise', 'terse', 'linenoise', etc.) there are
1400 3 format-specs which control how OPs are rendered.
1401
1402 The first is the 'default' format, which is used in both basic and exec
1403 modes to print all opcodes.  The 2nd, goto-format, is used in exec
1404 mode when branches are encountered.  They're not real opcodes, and are
1405 inserted to look like a closing curly brace.  The tree-format is tree
1406 specific.
1407
1408 When a line is rendered, the correct format-spec is copied and scanned
1409 for the following items; data is substituted in, and other
1410 manipulations like basic indenting are done, for each opcode rendered.
1411
1412 There are 3 kinds of items that may be populated; special patterns,
1413 #vars, and literal text, which is copied verbatim.  (Yes, it's a set
1414 of s///g steps.)
1415
1416 =head2 Special Patterns
1417
1418 These items are the primitives used to perform indenting, and to
1419 select text from amongst alternatives.
1420
1421 =over 4
1422
1423 =item B<(x(>I<exec_text>B<;>I<basic_text>B<)x)>
1424
1425 Generates I<exec_text> in exec mode, or I<basic_text> in basic mode.
1426
1427 =item B<(*(>I<text>B<)*)>
1428
1429 Generates one copy of I<text> for each indentation level.
1430
1431 =item B<(*(>I<text1>B<;>I<text2>B<)*)>
1432
1433 Generates one fewer copies of I<text1> than the indentation level, followed
1434 by one copy of I<text2> if the indentation level is more than 0.
1435
1436 =item B<(?(>I<text1>B<#>I<var>I<Text2>B<)?)>
1437
1438 If the value of I<var> is true (not empty or zero), generates the
1439 value of I<var> surrounded by I<text1> and I<Text2>, otherwise
1440 nothing.
1441
1442 =item B<~>
1443
1444 Any number of tildes and surrounding whitespace will be collapsed to
1445 a single space.
1446
1447 =back
1448
1449 =head2 # Variables
1450
1451 These #vars represent opcode properties that you may want as part of
1452 your rendering.  The '#' is intended as a private sigil; a #var's
1453 value is interpolated into the style-line, much like "read $this".
1454
1455 These vars take 3 forms:
1456
1457 =over 4
1458
1459 =item B<#>I<var>
1460
1461 A property named 'var' is assumed to exist for the opcodes, and is
1462 interpolated into the rendering.
1463
1464 =item B<#>I<var>I<N>
1465
1466 Generates the value of I<var>, left justified to fill I<N> spaces.
1467 Note that this means while you can have properties 'foo' and 'foo2',
1468 you cannot render 'foo2', but you could with 'foo2a'.  You would be
1469 wise not to rely on this behavior going forward ;-)
1470
1471 =item B<#>I<Var>
1472
1473 This ucfirst form of #var generates a tag-value form of itself for
1474 display; it converts '#Var' into a 'Var => #var' style, which is then
1475 handled as described above.  (Imp-note: #Vars cannot be used for
1476 conditional-fills, because the => #var transform is done after the check
1477 for #Var's value).
1478
1479 =back
1480
1481 The following variables are 'defined' by B::Concise; when they are
1482 used in a style, their respective values are plugged into the
1483 rendering of each opcode.
1484
1485 Only some of these are used by the standard styles, the others are
1486 provided for you to delve into optree mechanics, should you wish to
1487 add a new style (see L</add_style> below) that uses them.  You can
1488 also add new ones using L</add_callback>.
1489
1490 =over 4
1491
1492 =item B<#addr>
1493
1494 The address of the OP, in hexadecimal.
1495
1496 =item B<#arg>
1497
1498 The OP-specific information of the OP (such as the SV for an SVOP, the
1499 non-local exit pointers for a LOOP, etc.) enclosed in parentheses.
1500
1501 =item B<#class>
1502
1503 The B-determined class of the OP, in all caps.
1504
1505 =item B<#classsym>
1506
1507 A single symbol abbreviating the class of the OP.
1508
1509 =item B<#coplabel>
1510
1511 The label of the statement or block the OP is the start of, if any.
1512
1513 =item B<#exname>
1514
1515 The name of the OP, or 'ex-foo' if the OP is a null that used to be a foo.
1516
1517 =item B<#extarg>
1518
1519 The target of the OP, or nothing for a nulled OP.
1520
1521 =item B<#firstaddr>
1522
1523 The address of the OP's first child, in hexadecimal.
1524
1525 =item B<#flags>
1526
1527 The OP's flags, abbreviated as a series of symbols.
1528
1529 =item B<#flagval>
1530
1531 The numeric value of the OP's flags.
1532
1533 =item B<#hints>
1534
1535 The COP's hint flags, rendered with abbreviated names if possible. An empty
1536 string if this is not a COP. Here are the symbols used:
1537
1538     $ strict refs
1539     & strict subs
1540     * strict vars
1541    x$ explicit use/no strict refs
1542    x& explicit use/no strict subs
1543    x* explicit use/no strict vars
1544     i integers
1545     l locale
1546     b bytes
1547     { block scope
1548     % localise %^H
1549     < open in
1550     > open out
1551     I overload int
1552     F overload float
1553     B overload binary
1554     S overload string
1555     R overload re
1556     T taint
1557     E eval
1558     X filetest access
1559     U utf-8
1560
1561 =item B<#hintsval>
1562
1563 The numeric value of the COP's hint flags, or an empty string if this is not
1564 a COP.
1565
1566 =item B<#hyphseq>
1567
1568 The sequence number of the OP, or a hyphen if it doesn't have one.
1569
1570 =item B<#label>
1571
1572 'NEXT', 'LAST', or 'REDO' if the OP is a target of one of those in exec
1573 mode, or empty otherwise.
1574
1575 =item B<#lastaddr>
1576
1577 The address of the OP's last child, in hexadecimal.
1578
1579 =item B<#name>
1580
1581 The OP's name.
1582
1583 =item B<#NAME>
1584
1585 The OP's name, in all caps.
1586
1587 =item B<#next>
1588
1589 The sequence number of the OP's next OP.
1590
1591 =item B<#nextaddr>
1592
1593 The address of the OP's next OP, in hexadecimal.
1594
1595 =item B<#noise>
1596
1597 A one- or two-character abbreviation for the OP's name.
1598
1599 =item B<#private>
1600
1601 The OP's private flags, rendered with abbreviated names if possible.
1602
1603 =item B<#privval>
1604
1605 The numeric value of the OP's private flags.
1606
1607 =item B<#seq>
1608
1609 The sequence number of the OP. Note that this is a sequence number
1610 generated by B::Concise.
1611
1612 =item B<#seqnum>
1613
1614 5.8.x and earlier only. 5.9 and later do not provide this.
1615
1616 The real sequence number of the OP, as a regular number and not adjusted
1617 to be relative to the start of the real program. (This will generally be
1618 a fairly large number because all of B<B::Concise> is compiled before
1619 your program is).
1620
1621 =item B<#opt>
1622
1623 Whether or not the op has been optimised by the peephole optimiser.
1624
1625 Only available in 5.9 and later.
1626
1627 =item B<#sibaddr>
1628
1629 The address of the OP's next youngest sibling, in hexadecimal.
1630
1631 =item B<#svaddr>
1632
1633 The address of the OP's SV, if it has an SV, in hexadecimal.
1634
1635 =item B<#svclass>
1636
1637 The class of the OP's SV, if it has one, in all caps (e.g., 'IV').
1638
1639 =item B<#svval>
1640
1641 The value of the OP's SV, if it has one, in a short human-readable format.
1642
1643 =item B<#targ>
1644
1645 The numeric value of the OP's targ.
1646
1647 =item B<#targarg>
1648
1649 The name of the variable the OP's targ refers to, if any, otherwise the
1650 letter t followed by the OP's targ in decimal.
1651
1652 =item B<#targarglife>
1653
1654 Same as B<#targarg>, but followed by the COP sequence numbers that delimit
1655 the variable's lifetime (or 'end' for a variable in an open scope) for a
1656 variable.
1657
1658 =item B<#typenum>
1659
1660 The numeric value of the OP's type, in decimal.
1661
1662 =back
1663
1664 =head1 One-Liner Command tips
1665
1666 =over 4
1667
1668 =item perl -MO=Concise,bar foo.pl
1669
1670 Renders only bar() from foo.pl.  To see main, drop the ',bar'.  To see
1671 both, add ',-main'
1672
1673 =item perl -MDigest::MD5=md5 -MO=Concise,md5 -e1
1674
1675 Identifies md5 as an XS function.  The export is needed so that BC can
1676 find it in main.
1677
1678 =item perl -MPOSIX -MO=Concise,_POSIX_ARG_MAX -e1
1679
1680 Identifies _POSIX_ARG_MAX as a constant sub, optimized to an IV.
1681 Although POSIX isn't entirely consistent across platforms, this is
1682 likely to be present in virtually all of them.
1683
1684 =item perl -MPOSIX -MO=Concise,a -e 'print _POSIX_SAVED_IDS'
1685
1686 This renders a print statement, which includes a call to the function.
1687 It's identical to rendering a file with a use call and that single
1688 statement, except for the filename which appears in the nextstate ops.
1689
1690 =item perl -MPOSIX -MO=Concise,a -e 'sub a{_POSIX_SAVED_IDS}'
1691
1692 This is B<very> similar to previous, only the first two ops differ.  This
1693 subroutine rendering is more representative, insofar as a single main
1694 program will have many subs.
1695
1696 =item perl -MB::Concise -e 'B::Concise::compile("-exec","-src", \%B::Concise::)->()'
1697
1698 This renders all functions in the B::Concise package with the source
1699 lines.  It eschews the O framework so that the stashref can be passed
1700 directly to B::Concise::compile().  See -stash option for a more
1701 convenient way to render a package.
1702
1703 =back
1704
1705 =head1 Using B::Concise outside of the O framework
1706
1707 The common (and original) usage of B::Concise was for command-line
1708 renderings of simple code, as given in EXAMPLE.  But you can also use
1709 B<B::Concise> from your code, and call compile() directly, and
1710 repeatedly.  By doing so, you can avoid the compile-time only
1711 operation of O.pm, and even use the debugger to step through
1712 B::Concise::compile() itself.
1713
1714 Once you're doing this, you may alter Concise output by adding new
1715 rendering styles, and by optionally adding callback routines which
1716 populate new variables, if such were referenced from those (just
1717 added) styles.  
1718
1719 =head2 Example: Altering Concise Renderings
1720
1721     use B::Concise qw(set_style add_callback);
1722     add_style($yourStyleName => $defaultfmt, $gotofmt, $treefmt);
1723     add_callback
1724       ( sub {
1725             my ($h, $op, $format, $level, $stylename) = @_;
1726             $h->{variable} = some_func($op);
1727         });
1728     $walker = B::Concise::compile(@options,@subnames,@subrefs);
1729     $walker->();
1730
1731 =head2 set_style()
1732
1733 B<set_style> accepts 3 arguments, and updates the three format-specs
1734 comprising a line-style (basic-exec, goto, tree).  It has one minor
1735 drawback though; it doesn't register the style under a new name.  This
1736 can become an issue if you render more than once and switch styles.
1737 Thus you may prefer to use add_style() and/or set_style_standard()
1738 instead.
1739
1740 =head2 set_style_standard($name)
1741
1742 This restores one of the standard line-styles: C<terse>, C<concise>,
1743 C<linenoise>, C<debug>, C<env>, into effect.  It also accepts style
1744 names previously defined with add_style().
1745
1746 =head2 add_style ()
1747
1748 This subroutine accepts a new style name and three style arguments as
1749 above, and creates, registers, and selects the newly named style.  It is
1750 an error to re-add a style; call set_style_standard() to switch between
1751 several styles.
1752
1753 =head2 add_callback ()
1754
1755 If your newly minted styles refer to any new #variables, you'll need
1756 to define a callback subroutine that will populate (or modify) those
1757 variables.  They are then available for use in the style you've
1758 chosen.
1759
1760 The callbacks are called for each opcode visited by Concise, in the
1761 same order as they are added.  Each subroutine is passed five
1762 parameters.
1763
1764   1. A hashref, containing the variable names and values which are
1765      populated into the report-line for the op
1766   2. the op, as a B<B::OP> object
1767   3. a reference to the format string
1768   4. the formatting (indent) level
1769   5. the selected stylename
1770
1771 To define your own variables, simply add them to the hash, or change
1772 existing values if you need to.  The level and format are passed in as
1773 references to scalars, but it is unlikely that they will need to be
1774 changed or even used.
1775
1776 =head2 Running B::Concise::compile()
1777
1778 B<compile> accepts options as described above in L</OPTIONS>, and
1779 arguments, which are either coderefs, or subroutine names.
1780
1781 It constructs and returns a $treewalker coderef, which when invoked,
1782 traverses, or walks, and renders the optrees of the given arguments to
1783 STDOUT.  You can reuse this, and can change the rendering style used
1784 each time; thereafter the coderef renders in the new style.
1785
1786 B<walk_output> lets you change the print destination from STDOUT to
1787 another open filehandle, or into a string passed as a ref (unless
1788 you've built perl with -Uuseperlio).
1789
1790     my $walker = B::Concise::compile('-terse','aFuncName', \&aSubRef);  # 1
1791     walk_output(\my $buf);
1792     $walker->();                        # 1 renders -terse
1793     set_style_standard('concise');      # 2
1794     $walker->();                        # 2 renders -concise
1795     $walker->(@new);                    # 3 renders whatever
1796     print "3 different renderings: terse, concise, and @new: $buf\n";
1797
1798 When $walker is called, it traverses the subroutines supplied when it
1799 was created, and renders them using the current style.  You can change
1800 the style afterwards in several different ways:
1801
1802   1. call C<compile>, altering style or mode/order
1803   2. call C<set_style_standard>
1804   3. call $walker, passing @new options
1805
1806 Passing new options to the $walker is the easiest way to change
1807 amongst any pre-defined styles (the ones you add are automatically
1808 recognized as options), and is the only way to alter rendering order
1809 without calling compile again.  Note however that rendering state is
1810 still shared amongst multiple $walker objects, so they must still be
1811 used in a coordinated manner.
1812
1813 =head2 B::Concise::reset_sequence()
1814
1815 This function (not exported) lets you reset the sequence numbers (note
1816 that they're numbered arbitrarily, their goal being to be human
1817 readable).  Its purpose is mostly to support testing, i.e. to compare
1818 the concise output from two identical anonymous subroutines (but
1819 different instances).  Without the reset, B::Concise, seeing that
1820 they're separate optrees, generates different sequence numbers in
1821 the output.
1822
1823 =head2 Errors
1824
1825 Errors in rendering (non-existent function-name, non-existent coderef)
1826 are written to the STDOUT, or wherever you've set it via
1827 walk_output().
1828
1829 Errors using the various *style* calls, and bad args to walk_output(),
1830 result in die().  Use an eval if you wish to catch these errors and
1831 continue processing.
1832
1833 =head1 AUTHOR
1834
1835 Stephen McCamant, E<lt>smcc@CSUA.Berkeley.EDUE<gt>.
1836
1837 =cut