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