This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add the missing ${^OPEN} hints flag to B::Concise
[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
d5ec2987 17our $VERSION = "0.69";
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
DM
30 SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL
31 CVf_ANON);
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 : ());
cc02ea56
JC
324 } elsif ($objname eq "END") {
325 concise_specials("END", $order,
c0939cee
JC
326 B::end_av->isa("B::AV") ?
327 B::end_av->ARRAY : ());
cc02ea56
JC
328 }
329 else {
330 # convert function names to subrefs
331 my $objref;
332 if (ref $objname) {
333 print $walkHandle "B::Concise::compile($objname)\n"
334 if $banner;
335 $objref = $objname;
8ec8fbef 336 } else {
cc02ea56
JC
337 $objname = "main::" . $objname unless $objname =~ /::/;
338 print $walkHandle "$objname:\n";
339 no strict 'refs';
c0939cee
JC
340 unless (exists &$objname) {
341 print $walkHandle "err: unknown function ($objname)\n";
342 return;
343 }
cc02ea56 344 $objref = \&$objname;
8ec8fbef 345 }
c0939cee 346 concise_subref($order, $objref, $objname);
c99ca59a
SM
347 }
348 }
c27ea44e 349 if (!@args or $do_main) {
f95e3c3c 350 print $walkHandle "main program:\n" if $do_main;
31b49ad4 351 concise_main($order);
c99ca59a 352 }
cc02ea56 353 return @args; # something
c99ca59a
SM
354 }
355}
356
357my %labels;
724aa791 358my $lastnext; # remembers op-chain, used to insert gotos
c99ca59a
SM
359
360my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|",
361 'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*",
051f02e9 362 'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#");
c99ca59a 363
8ec8fbef 364no warnings 'qw'; # "Possible attempt to put comments..."; use #7
35fc55f1
RH
365my @linenoise =
366 qw'# () sc ( @? 1 $* gv *{ m$ m@ m% m? p/ *$ $ $# & a& pt \\ s\\ rf bl
c99ca59a
SM
367 ` *? <> ?? ?/ r/ c/ // qr s/ /c y/ = @= C sC Cp sp df un BM po +1 +I
368 -1 -I 1+ I+ 1- I- ** * i* / i/ %$ i% x + i+ - i- . " << >> < i<
369 > i> <= i, >= i. == i= != i! <? i? s< s> s, s. s= s! s? b& b^ b| -0 -i
370 ! ~ a2 si cs rd sr e^ lg sq in %x %o ab le ss ve ix ri sf FL od ch cy
371 uf lf uc lc qm @ [f [ @[ eh vl ky dl ex % ${ @{ uk pk st jn ) )[ a@
372 a% sl +] -] [- [+ so rv GS GW MS MW .. f. .f && || ^^ ?: &= |= -> s{ s}
373 v} ca wa di rs ;; ; ;d }{ { } {} f{ it {l l} rt }l }n }r dm }g }e ^o
374 ^c ^| ^# um bm t~ u~ ~d DB db ^s se ^g ^r {w }w pf pr ^O ^K ^R ^W ^d ^v
375 ^e ^t ^k t. fc ic fl .s .p .b .c .l .a .h g1 s1 g2 s2 ?. l? -R -W -X -r
376 -w -x -e -o -O -z -s -M -A -C -S -c -b -f -d -p -l -u -g -k -t -T -B cd
377 co cr u. cm ut r. l@ s@ r@ mD uD oD rD tD sD wD cD f$ w$ p$ sh e$ k$ g3
378 g4 s4 g5 s5 T@ C@ L@ G@ A@ S@ Hg Hc Hr Hw Mg Mc Ms Mr Sg Sc So rq do {e
379 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 380 Pu GP SP EP Gn Gg GG SG EG g0 c$ lk t$ ;s n> // /= CO';
c99ca59a
SM
381
382my $chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
383
19e169bf 384sub op_flags { # common flags (see BASOP.op_flags in op.h)
c99ca59a
SM
385 my($x) = @_;
386 my(@v);
387 push @v, "v" if ($x & 3) == 1;
388 push @v, "s" if ($x & 3) == 2;
389 push @v, "l" if ($x & 3) == 3;
390 push @v, "K" if $x & 4;
391 push @v, "P" if $x & 8;
392 push @v, "R" if $x & 16;
393 push @v, "M" if $x & 32;
394 push @v, "S" if $x & 64;
395 push @v, "*" if $x & 128;
396 return join("", @v);
397}
398
399sub base_n {
400 my $x = shift;
401 return "-" . base_n(-$x) if $x < 0;
402 my $str = "";
403 do { $str .= substr($chars, $x % $base, 1) } while $x = int($x / $base);
404 $str = reverse $str if $big_endian;
405 return $str;
406}
407
c27ea44e
SM
408my %sequence_num;
409my $seq_max = 1;
410
f95e3c3c
JC
411sub reset_sequence {
412 # reset the sequence
413 %sequence_num = ();
414 $seq_max = 1;
cc02ea56 415 $lastnext = 0;
f95e3c3c
JC
416}
417
c27ea44e
SM
418sub seq {
419 my($op) = @_;
420 return "-" if not exists $sequence_num{$$op};
421 return base_n($sequence_num{$$op});
422}
c99ca59a
SM
423
424sub walk_topdown {
425 my($op, $sub, $level) = @_;
426 $sub->($op, $level);
427 if ($op->flags & OPf_KIDS) {
428 for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
429 walk_topdown($kid, $sub, $level + 1);
430 }
431 }
c0939cee 432 elsif (class($op) eq "PMOP") {
c6e79e55
SM
433 my $maybe_root = $op->pmreplroot;
434 if (ref($maybe_root) and $maybe_root->isa("B::OP")) {
435 # It really is the root of the replacement, not something
436 # else stored here for lack of space elsewhere
437 walk_topdown($maybe_root, $sub, $level + 1);
438 }
c99ca59a
SM
439 }
440}
441
442sub walklines {
443 my($ar, $level) = @_;
444 for my $l (@$ar) {
445 if (ref($l) eq "ARRAY") {
446 walklines($l, $level + 1);
447 } else {
448 $l->concise($level);
449 }
450 }
451}
452
453sub walk_exec {
454 my($top, $level) = @_;
455 my %opsseen;
456 my @lines;
457 my @todo = ([$top, \@lines]);
458 while (@todo and my($op, $targ) = @{shift @todo}) {
459 for (; $$op; $op = $op->next) {
460 last if $opsseen{$$op}++;
461 push @$targ, $op;
462 my $name = $op->name;
62e36f8a 463 if (class($op) eq "LOGOP") {
c99ca59a
SM
464 my $ar = [];
465 push @$targ, $ar;
466 push @todo, [$op->other, $ar];
467 } elsif ($name eq "subst" and $ {$op->pmreplstart}) {
468 my $ar = [];
469 push @$targ, $ar;
470 push @todo, [$op->pmreplstart, $ar];
471 } elsif ($name =~ /^enter(loop|iter)$/) {
7252851f
NC
472 if ($] > 5.009) {
473 $labels{${$op->nextop}} = "NEXT";
474 $labels{${$op->lastop}} = "LAST";
475 $labels{${$op->redoop}} = "REDO";
476 } else {
477 $labels{$op->nextop->seq} = "NEXT";
478 $labels{$op->lastop->seq} = "LAST";
479 $labels{$op->redoop->seq} = "REDO";
480 }
c99ca59a
SM
481 }
482 }
483 }
484 walklines(\@lines, 0);
485}
486
c27ea44e
SM
487# The structure of this routine is purposely modeled after op.c's peep()
488sub sequence {
489 my($op) = @_;
490 my $oldop = 0;
491 return if class($op) eq "NULL" or exists $sequence_num{$$op};
492 for (; $$op; $op = $op->next) {
493 last if exists $sequence_num{$$op};
494 my $name = $op->name;
495 if ($name =~ /^(null|scalar|lineseq|scope)$/) {
496 next if $oldop and $ {$op->next};
497 } else {
498 $sequence_num{$$op} = $seq_max++;
499 if (class($op) eq "LOGOP") {
500 my $other = $op->other;
501 $other = $other->next while $other->name eq "null";
502 sequence($other);
503 } elsif (class($op) eq "LOOP") {
504 my $redoop = $op->redoop;
505 $redoop = $redoop->next while $redoop->name eq "null";
506 sequence($redoop);
507 my $nextop = $op->nextop;
508 $nextop = $nextop->next while $nextop->name eq "null";
509 sequence($nextop);
510 my $lastop = $op->lastop;
511 $lastop = $lastop->next while $lastop->name eq "null";
512 sequence($lastop);
513 } elsif ($name eq "subst" and $ {$op->pmreplstart}) {
514 my $replstart = $op->pmreplstart;
515 $replstart = $replstart->next while $replstart->name eq "null";
516 sequence($replstart);
517 }
518 }
519 $oldop = $op;
520 }
521}
522
724aa791 523sub fmt_line { # generate text-line for op.
cc02ea56
JC
524 my($hr, $op, $text, $level) = @_;
525
526 $_->($hr, $op, \$text, \$level, $stylename) for @callbacks;
527
724aa791 528 return '' if $hr->{SKIP}; # suppress line if a callback said so
cc02ea56 529 return '' if $hr->{goto} and $hr->{goto} eq '-'; # no goto nowhere
f95e3c3c 530
cc02ea56 531 # spec: (?(text1#varText2)?)
c99ca59a 532 $text =~ s/\(\?\(([^\#]*?)\#(\w+)([^\#]*?)\)\?\)/
f95e3c3c
JC
533 $hr->{$2} ? $1.$hr->{$2}.$3 : ""/eg;
534
cc02ea56 535 # spec: (x(exec_text;basic_text)x)
c99ca59a 536 $text =~ s/\(x\((.*?);(.*?)\)x\)/$order eq "exec" ? $1 : $2/egs;
cc02ea56
JC
537
538 # spec: (*(text)*)
c99ca59a 539 $text =~ s/\(\*\(([^;]*?)\)\*\)/$1 x $level/egs;
cc02ea56
JC
540
541 # spec: (*(text1;text2)*)
c99ca59a 542 $text =~ s/\(\*\((.*?);(.*?)\)\*\)/$1 x ($level - 1) . $2 x ($level>0)/egs;
cc02ea56
JC
543
544 # convert #Var to tag=>val form: Var\t#var
545 $text =~ s/\#([A-Z][a-z]+)(\d+)?/\t\u$1\t\L#$1$2/gs;
546
547 # spec: #varN
724aa791
JC
548 $text =~ s/\#([a-zA-Z]+)(\d+)/sprintf("%-$2s", $hr->{$1})/eg;
549
cc02ea56
JC
550 $text =~ s/\#([a-zA-Z]+)/$hr->{$1}/eg; # populate #var's
551 $text =~ s/[ \t]*~+[ \t]*/ /g; # squeeze tildes
f95e3c3c
JC
552 chomp $text;
553 return "$text\n" if $text ne "";
554 return $text; # suppress empty lines
c99ca59a
SM
555}
556
19e169bf
JC
557our %priv; # used to display each opcode's BASEOP.op_private values
558
c99ca59a
SM
559$priv{$_}{128} = "LVINTRO"
560 for ("pos", "substr", "vec", "threadsv", "gvsv", "rv2sv", "rv2hv", "rv2gv",
561 "rv2av", "rv2arylen", "aelem", "helem", "aslice", "hslice", "padsv",
241416b8 562 "padav", "padhv", "enteriter");
c99ca59a
SM
563$priv{$_}{64} = "REFC" for ("leave", "leavesub", "leavesublv", "leavewrite");
564$priv{"aassign"}{64} = "COMMON";
4ac6efe6 565$priv{"aassign"}{32} = "PHASH" if $] < 5.009;
952306ac 566$priv{"sassign"}{32} = "STATE";
c99ca59a 567$priv{"sassign"}{64} = "BKWARD";
7abc42fc 568$priv{$_}{64} = "RTIME" for ("match", "subst", "substcont", "qr");
c99ca59a
SM
569@{$priv{"trans"}}{1,2,4,8,16,64} = ("<UTF", ">UTF", "IDENT", "SQUASH", "DEL",
570 "COMPL", "GROWS");
571$priv{"repeat"}{64} = "DOLIST";
572$priv{"leaveloop"}{64} = "CONT";
573@{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV")
314d4778 574 for (qw(rv2gv rv2sv padsv aelem helem));
a5911867 575$priv{$_}{16} = "STATE" for ("padav", "padhv", "padsv");
d4797c1d 576@{$priv{"entersub"}}{16,32,64} = ("DBG","TARG","NOMOD");
c99ca59a
SM
577@{$priv{$_}}{4,8,128} = ("INARGS","AMPER","NO()") for ("entersub", "rv2cv");
578$priv{"gv"}{32} = "EARLYCV";
579$priv{"aelem"}{16} = $priv{"helem"}{16} = "LVDEFER";
241416b8
DM
580$priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv",
581 "enteriter");
c99ca59a
SM
582$priv{$_}{16} = "TARGMY"
583 for (map(($_,"s$_"),"chop", "chomp"),
584 map(($_,"i_$_"), "postinc", "postdec", "multiply", "divide", "modulo",
585 "add", "subtract", "negate"), "pow", "concat", "stringify",
586 "left_shift", "right_shift", "bit_and", "bit_xor", "bit_or",
587 "complement", "atan2", "sin", "cos", "rand", "exp", "log", "sqrt",
588 "int", "hex", "oct", "abs", "length", "index", "rindex", "sprintf",
589 "ord", "chr", "crypt", "quotemeta", "join", "push", "unshift", "flock",
590 "chdir", "chown", "chroot", "unlink", "chmod", "utime", "rename",
591 "link", "symlink", "mkdir", "rmdir", "wait", "waitpid", "system",
592 "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority",
593 "setpriority", "time", "sleep");
ef3e5ea9 594$priv{$_}{4} = "REVERSED" for ("enteriter", "iter");
d4797c1d 595@{$priv{"const"}}{4,8,16,32,64,128} = ("SHORT","STRICT","ENTERED",'$[',"BARE","WARN");
c99ca59a
SM
596$priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM";
597$priv{"list"}{64} = "GUESSED";
598$priv{"delete"}{64} = "SLICE";
599$priv{"exists"}{64} = "SUB";
7b9ef140 600@{$priv{"sort"}}{1,2,4,8,16,32,64} = ("NUM", "INT", "REV", "INPLACE","DESC","QSORT","STABLE");
c99ca59a 601$priv{"threadsv"}{64} = "SVREFd";
c27ea44e
SM
602@{$priv{$_}}{16,32,64,128} = ("INBIN","INCR","OUTBIN","OUTCR")
603 for ("open", "backtick");
c99ca59a 604$priv{"exit"}{128} = "VMS";
feaeca78
JH
605$priv{$_}{2} = "FTACCESS"
606 for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec");
7b9ef140 607$priv{"entereval"}{2} = "HAS_HH";
32454ac8
NC
608if ($] >= 5.009) {
609 # Stacked filetests are post 5.8.x
610 $priv{$_}{4} = "FTSTACKED"
611 for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec",
612 "ftis", "fteowned", "ftrowned", "ftzero", "ftsize", "ftmtime",
613 "ftatime", "ftctime", "ftsock", "ftchr", "ftblk", "ftfile", "ftdir",
614 "ftpipe", "ftlink", "ftsuid", "ftsgid", "ftsvtx", "fttty", "fttext",
615 "ftbinary");
616 # Lexical $_ is post 5.8.x
617 $priv{$_}{2} = "GREPLEX"
618 for ("mapwhile", "mapstart", "grepwhile", "grepstart");
619}
c99ca59a 620
d5ec2987
NC
621our %hints; # used to display each COP's op_hints values
622
623# strict refs, subs, vars
624@hints{2,512,1024} = ('$', '&', '*');
625# integers, locale, bytes, arybase
626@hints{1,4,8,16,32} = ('i', 'l', 'b', '[');
34b5ca21
NC
627# block scope, localise %^H, $^OPEN
628@hints{256,131072,262144} = ('{','%','<');
d5ec2987
NC
629# overload new integer, float, binary, string, re
630@hints{4096,8192,16384,32768,65536} = ('I', 'F', 'B', 'S', 'R');
631# taint and eval
632@hints{1048576,2097152} = ('T', 'E');
633# filetest access, UTF-8, assertions, assertions seen
634@hints{4194304,8388608,16777216,33554432} = ('X', 'U', 'A', 'a');
635
636sub _flags {
637 my($hash, $x) = @_;
c99ca59a 638 my @s;
d5ec2987
NC
639 for my $flag (sort {$b <=> $a} keys %$hash) {
640 if ($hash->{$flag} and $x & $flag and $x >= $flag) {
c99ca59a 641 $x -= $flag;
d5ec2987 642 push @s, $hash->{$flag};
c99ca59a
SM
643 }
644 }
645 push @s, $x if $x;
646 return join(",", @s);
647}
648
d5ec2987
NC
649sub private_flags {
650 my($name, $x) = @_;
651 _flags($priv{$name}, $x);
652}
653
654sub hints_flags {
655 my($x) = @_;
656 _flags(\%hints, $x);
657}
658
c27ea44e 659sub concise_sv {
2db5ca0a 660 my($sv, $hr, $preferpv) = @_;
c27ea44e 661 $hr->{svclass} = class($sv);
31b49ad4
SM
662 $hr->{svclass} = "UV"
663 if $hr->{svclass} eq "IV" and $sv->FLAGS & SVf_IVisUV;
5b493bdf 664 Carp::cluck("bad concise_sv: $sv") unless $sv and $$sv;
c27ea44e
SM
665 $hr->{svaddr} = sprintf("%#x", $$sv);
666 if ($hr->{svclass} eq "GV") {
667 my $gv = $sv;
668 my $stash = $gv->STASH->NAME;
669 if ($stash eq "main") {
670 $stash = "";
671 } else {
672 $stash = $stash . "::";
673 }
674 $hr->{svval} = "*$stash" . $gv->SAFENAME;
675 return "*$stash" . $gv->SAFENAME;
676 } else {
677 while (class($sv) eq "RV") {
678 $hr->{svval} .= "\\";
679 $sv = $sv->RV;
680 }
681 if (class($sv) eq "SPECIAL") {
40b5b14f 682 $hr->{svval} .= ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv];
2db5ca0a
YST
683 } elsif ($preferpv && $sv->FLAGS & SVf_POK) {
684 $hr->{svval} .= cstring($sv->PV);
c27ea44e 685 } elsif ($sv->FLAGS & SVf_NOK) {
40b5b14f 686 $hr->{svval} .= $sv->NV;
c27ea44e 687 } elsif ($sv->FLAGS & SVf_IOK) {
31b49ad4 688 $hr->{svval} .= $sv->int_value;
c27ea44e 689 } elsif ($sv->FLAGS & SVf_POK) {
40b5b14f 690 $hr->{svval} .= cstring($sv->PV);
31b49ad4
SM
691 } elsif (class($sv) eq "HV") {
692 $hr->{svval} .= 'HASH';
c27ea44e 693 }
cc02ea56
JC
694
695 $hr->{svval} = 'undef' unless defined $hr->{svval};
696 my $out = $hr->{svclass};
697 return $out .= " $hr->{svval}" ;
c27ea44e
SM
698 }
699}
700
c99ca59a
SM
701sub concise_op {
702 my ($op, $level, $format) = @_;
703 my %h;
704 $h{exname} = $h{name} = $op->name;
705 $h{NAME} = uc $h{name};
706 $h{class} = class($op);
707 $h{extarg} = $h{targ} = $op->targ;
708 $h{extarg} = "" unless $h{extarg};
709 if ($h{name} eq "null" and $h{targ}) {
8ec8fbef 710 # targ holds the old type
c99ca59a
SM
711 $h{exname} = "ex-" . substr(ppname($h{targ}), 3);
712 $h{extarg} = "";
8ec8fbef
SM
713 } elsif ($op->name =~ /^leave(sub(lv)?|write)?$/) {
714 # targ potentially holds a reference count
715 if ($op->private & 64) {
716 my $refs = "ref" . ($h{targ} != 1 ? "s" : "");
717 $h{targarglife} = $h{targarg} = "$h{targ} $refs";
718 }
c99ca59a
SM
719 } elsif ($h{targ}) {
720 my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}];
721 if (defined $padname and class($padname) ne "SPECIAL") {
0b40bd6d 722 $h{targarg} = $padname->PVX;
127212b2 723 if ($padname->FLAGS & SVf_FAKE) {
4ac6efe6
NC
724 if ($] < 5.009) {
725 $h{targarglife} = "$h{targarg}:FAKE";
726 } else {
727 # These changes relate to the jumbo closure fix.
728 # See changes 19939 and 20005
729 my $fake = '';
730 $fake .= 'a' if $padname->IVX & 1; # PAD_FAKELEX_ANON
731 $fake .= 'm' if $padname->IVX & 2; # PAD_FAKELEX_MULTI
732 $fake .= ':' . $padname->NVX if $curcv->CvFLAGS & CVf_ANON;
733 $h{targarglife} = "$h{targarg}:FAKE:$fake";
734 }
127212b2
DM
735 }
736 else {
737 my $intro = $padname->NVX - $cop_seq_base;
738 my $finish = int($padname->IVX) - $cop_seq_base;
739 $finish = "end" if $finish == 999999999 - $cop_seq_base;
740 $h{targarglife} = "$h{targarg}:$intro,$finish";
741 }
c99ca59a
SM
742 } else {
743 $h{targarglife} = $h{targarg} = "t" . $h{targ};
744 }
745 }
746 $h{arg} = "";
747 $h{svclass} = $h{svaddr} = $h{svval} = "";
748 if ($h{class} eq "PMOP") {
749 my $precomp = $op->precomp;
7a9b44b9 750 if (defined $precomp) {
c27ea44e
SM
751 $precomp = cstring($precomp); # Escape literal control sequences
752 $precomp = "/$precomp/";
753 } else {
754 $precomp = "";
7a9b44b9 755 }
b2a3cfdd 756 my $pmreplroot = $op->pmreplroot;
34a48b4b 757 my $pmreplstart;
c6e79e55 758 if (ref($pmreplroot) eq "B::GV") {
b2a3cfdd 759 # with C<@stash_array = split(/pat/, str);>,
c6e79e55 760 # *stash_array is stored in /pat/'s pmreplroot.
b2a3cfdd 761 $h{arg} = "($precomp => \@" . $pmreplroot->NAME . ")";
c6e79e55
SM
762 } elsif (!ref($pmreplroot) and $pmreplroot) {
763 # same as the last case, except the value is actually a
764 # pad offset for where the GV is kept (this happens under
765 # ithreads)
766 my $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$pmreplroot];
767 $h{arg} = "($precomp => \@" . $gv->NAME . ")";
b2a3cfdd 768 } elsif ($ {$op->pmreplstart}) {
c99ca59a
SM
769 undef $lastnext;
770 $pmreplstart = "replstart->" . seq($op->pmreplstart);
771 $h{arg} = "(" . join(" ", $precomp, $pmreplstart) . ")";
772 } else {
773 $h{arg} = "($precomp)";
774 }
775 } elsif ($h{class} eq "PVOP" and $h{name} ne "trans") {
776 $h{arg} = '("' . $op->pv . '")';
777 $h{svval} = '"' . $op->pv . '"';
778 } elsif ($h{class} eq "COP") {
779 my $label = $op->label;
c3caa09d 780 $h{coplabel} = $label;
c99ca59a
SM
781 $label = $label ? "$label: " : "";
782 my $loc = $op->file;
783 $loc =~ s[.*/][];
784 $loc .= ":" . $op->line;
785 my($stash, $cseq) = ($op->stash->NAME, $op->cop_seq - $cop_seq_base);
786 my $arybase = $op->arybase;
787 $arybase = $arybase ? ' $[=' . $arybase : "";
788 $h{arg} = "($label$stash $cseq $loc$arybase)";
789 } elsif ($h{class} eq "LOOP") {
790 $h{arg} = "(next->" . seq($op->nextop) . " last->" . seq($op->lastop)
791 . " redo->" . seq($op->redoop) . ")";
792 } elsif ($h{class} eq "LOGOP") {
793 undef $lastnext;
794 $h{arg} = "(other->" . seq($op->other) . ")";
5b493bdf
JC
795 }
796 elsif ($h{class} eq "SVOP" or $h{class} eq "PADOP") {
6a077020 797 unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) {
5b493bdf 798 my $idx = ($h{class} eq "SVOP") ? $op->targ : $op->padix;
2db5ca0a 799 my $preferpv = $h{name} eq "method_named";
5b493bdf
JC
800 if ($h{class} eq "PADOP" or !${$op->sv}) {
801 my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$idx];
2db5ca0a 802 $h{arg} = "[" . concise_sv($sv, \%h, $preferpv) . "]";
6a077020
DM
803 $h{targarglife} = $h{targarg} = "";
804 } else {
2db5ca0a 805 $h{arg} = "(" . concise_sv($op->sv, \%h, $preferpv) . ")";
6a077020 806 }
c99ca59a
SM
807 }
808 }
809 $h{seq} = $h{hyphseq} = seq($op);
810 $h{seq} = "" if $h{seq} eq "-";
7252851f
NC
811 if ($] > 5.009) {
812 $h{opt} = $op->opt;
813 $h{static} = $op->static;
814 $h{label} = $labels{$$op};
815 } else {
816 $h{seqnum} = $op->seq;
817 $h{label} = $labels{$op->seq};
818 }
c99ca59a
SM
819 $h{next} = $op->next;
820 $h{next} = (class($h{next}) eq "NULL") ? "(end)" : seq($h{next});
821 $h{nextaddr} = sprintf("%#x", $ {$op->next});
822 $h{sibaddr} = sprintf("%#x", $ {$op->sibling});
823 $h{firstaddr} = sprintf("%#x", $ {$op->first}) if $op->can("first");
824 $h{lastaddr} = sprintf("%#x", $ {$op->last}) if $op->can("last");
825
826 $h{classsym} = $opclass{$h{class}};
827 $h{flagval} = $op->flags;
828 $h{flags} = op_flags($op->flags);
829 $h{privval} = $op->private;
830 $h{private} = private_flags($h{name}, $op->private);
d5ec2987
NC
831 if ($op->can("hints")) {
832 $h{hintsval} = $op->hints;
833 $h{hints} = hints_flags($h{hintsval});
834 } else {
835 $h{hintsval} = $h{hints} = '';
836 }
c99ca59a 837 $h{addr} = sprintf("%#x", $$op);
c99ca59a
SM
838 $h{typenum} = $op->type;
839 $h{noise} = $linenoise[$op->type];
f95e3c3c 840
cc02ea56 841 return fmt_line(\%h, $op, $format, $level);
c99ca59a
SM
842}
843
844sub B::OP::concise {
845 my($op, $level) = @_;
846 if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
724aa791 847 # insert a 'goto' line
cc02ea56
JC
848 my $synth = {"seq" => seq($lastnext), "class" => class($lastnext),
849 "addr" => sprintf("%#x", $$lastnext),
850 "goto" => seq($lastnext), # simplify goto '-' removal
851 };
852 print $walkHandle fmt_line($synth, $op, $gotofmt, $level+1);
c99ca59a
SM
853 }
854 $lastnext = $op->next;
f95e3c3c 855 print $walkHandle concise_op($op, $level, $format);
c99ca59a
SM
856}
857
31b49ad4
SM
858# B::OP::terse (see Terse.pm) now just calls this
859sub b_terse {
860 my($op, $level) = @_;
861
862 # This isn't necessarily right, but there's no easy way to get
863 # from an OP to the right CV. This is a limitation of the
864 # ->terse() interface style, and there isn't much to do about
865 # it. In particular, we can die in concise_op if the main pad
866 # isn't long enough, or has the wrong kind of entries, compared to
867 # the pad a sub was compiled with. The fix for that would be to
868 # make a backwards compatible "terse" format that never even
869 # looked at the pad, just like the old B::Terse. I don't think
870 # that's worth the effort, though.
871 $curcv = main_cv unless $curcv;
872
873 if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
724aa791 874 # insert a 'goto'
31b49ad4
SM
875 my $h = {"seq" => seq($lastnext), "class" => class($lastnext),
876 "addr" => sprintf("%#x", $$lastnext)};
cc02ea56
JC
877 print # $walkHandle
878 fmt_line($h, $op, $style{"terse"}[1], $level+1);
31b49ad4
SM
879 }
880 $lastnext = $op->next;
cc02ea56
JC
881 print # $walkHandle
882 concise_op($op, $level, $style{"terse"}[0]);
31b49ad4
SM
883}
884
c99ca59a
SM
885sub tree {
886 my $op = shift;
887 my $level = shift;
888 my $style = $tree_decorations[$tree_style];
889 my($space, $single, $kids, $kid, $nokid, $last, $lead, $size) = @$style;
890 my $name = concise_op($op, $level, $treefmt);
891 if (not $op->flags & OPf_KIDS) {
892 return $name . "\n";
893 }
894 my @lines;
895 for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
896 push @lines, tree($kid, $level+1);
897 }
898 my $i;
899 for ($i = $#lines; substr($lines[$i], 0, 1) eq " "; $i--) {
900 $lines[$i] = $space . $lines[$i];
901 }
902 if ($i > 0) {
903 $lines[$i] = $last . $lines[$i];
904 while ($i-- > 1) {
905 if (substr($lines[$i], 0, 1) eq " ") {
906 $lines[$i] = $nokid . $lines[$i];
907 } else {
f95e3c3c 908 $lines[$i] = $kid . $lines[$i];
c99ca59a
SM
909 }
910 }
911 $lines[$i] = $kids . $lines[$i];
912 } else {
913 $lines[0] = $single . $lines[0];
914 }
915 return("$name$lead" . shift @lines,
916 map(" " x (length($name)+$size) . $_, @lines));
917}
918
213a1a26
SM
919# *** Warning: fragile kludge ahead ***
920# Because the B::* modules run in the same interpreter as the code
2814eb74
PJ
921# they're compiling, their presence tends to distort the view we have of
922# the code we're looking at. In particular, perl gives sequence numbers
923# to COPs. If the program we're looking at were run on its own, this
924# would start at 1. Because all of B::Concise and all the modules it
925# uses are compiled first, though, by the time we get to the user's
926# program the sequence number is already pretty high, which could be
927# distracting if you're trying to tell OPs apart. Therefore we'd like to
928# subtract an offset from all the sequence numbers we display, to
929# restore the simpler view of the world. The trick is to know what that
930# offset will be, when we're still compiling B::Concise! If we
213a1a26 931# hardcoded a value, it would have to change every time B::Concise or
2814eb74
PJ
932# other modules we use do. To help a little, what we do here is compile
933# a little code at the end of the module, and compute the base sequence
934# number for the user's program as being a small offset later, so all we
935# have to worry about are changes in the offset.
7252851f
NC
936
937# [For 5.8.x and earlier perl is generating sequence numbers for all ops,
938# and using them to reference labels]
939
940
213a1a26
SM
941# When you say "perl -MO=Concise -e '$a'", the output should look like:
942
943# 4 <@> leave[t1] vKP/REFC ->(end)
944# 1 <0> enter ->2
945 #^ smallest OP sequence number should be 1
946# 2 <;> nextstate(main 1 -e:1) v ->3
947 # ^ smallest COP sequence number should be 1
948# - <1> ex-rv2sv vK/1 ->4
949# 3 <$> gvsv(*a) s ->4
950
c27ea44e
SM
951# If the second of the marked numbers there isn't 1, it means you need
952# to update the corresponding magic number in the next line.
953# Remember, this needs to stay the last things in the module.
e69a2255 954
c27ea44e 955# Why is this different for MacOS? Does it matter?
8ec8fbef 956my $cop_seq_mnum = $^O eq 'MacOS' ? 12 : 11;
e69a2255 957$cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum;
c99ca59a
SM
958
9591;
960
961__END__
962
963=head1 NAME
964
965B::Concise - Walk Perl syntax tree, printing concise info about ops
966
967=head1 SYNOPSIS
968
969 perl -MO=Concise[,OPTIONS] foo.pl
970
78ad9108
PJ
971 use B::Concise qw(set_style add_callback);
972
c99ca59a
SM
973=head1 DESCRIPTION
974
975This compiler backend prints the internal OPs of a Perl program's syntax
976tree in one of several space-efficient text formats suitable for debugging
977the inner workings of perl or other compiler backends. It can print OPs in
978the order they appear in the OP tree, in the order they will execute, or
979in a text approximation to their tree structure, and the format of the
3c4b39be 980information displayed is customizable. Its function is similar to that of
c99ca59a
SM
981perl's B<-Dx> debugging flag or the B<B::Terse> module, but it is more
982sophisticated and flexible.
983
f8a679e6
RGS
984=head1 EXAMPLE
985
f9f861ec
JC
986Here's two outputs (or 'renderings'), using the -exec and -basic
987(i.e. default) formatting conventions on the same code snippet.
19e169bf
JC
988
989 % perl -MO=Concise,-exec -e '$a = $b + 42'
990 1 <0> enter
991 2 <;> nextstate(main 1 -e:1) v
992 3 <#> gvsv[*b] s
993 4 <$> const[IV 42] s
994 * 5 <2> add[t3] sK/2
995 6 <#> gvsv[*a] s
996 7 <2> sassign vKS/2
997 8 <@> leave[1 ref] vKP/REFC
998
f9f861ec
JC
999In this -exec rendering, each opcode is executed in the order shown.
1000The add opcode, marked with '*', is discussed in more detail.
19e169bf
JC
1001
1002The 1st column is the op's sequence number, starting at 1, and is
f9f861ec
JC
1003displayed in base 36 by default. Here they're purely linear; the
1004sequences are very helpful when looking at code with loops and
1005branches.
19e169bf
JC
1006
1007The symbol between angle brackets indicates the op's type, for
1008example; <2> is a BINOP, <@> a LISTOP, and <#> is a PADOP, which is
1009used in threaded perls. (see L</"OP class abbreviations">).
1010
f9f861ec 1011The opname, as in B<'add[t1]'>, may be followed by op-specific
19e169bf
JC
1012information in parentheses or brackets (ex B<'[t1]'>).
1013
f9f861ec 1014The op-flags (ex B<'sK/2'>) are described in (L</"OP flags
19e169bf 1015abbreviations">).
f8a679e6
RGS
1016
1017 % perl -MO=Concise -e '$a = $b + 42'
8ec8fbef 1018 8 <@> leave[1 ref] vKP/REFC ->(end)
f8a679e6
RGS
1019 1 <0> enter ->2
1020 2 <;> nextstate(main 1 -e:1) v ->3
1021 7 <2> sassign vKS/2 ->8
19e169bf 1022 * 5 <2> add[t1] sK/2 ->6
f8a679e6
RGS
1023 - <1> ex-rv2sv sK/1 ->4
1024 3 <$> gvsv(*b) s ->4
1025 4 <$> const(IV 42) s ->5
1026 - <1> ex-rv2sv sKRM*/1 ->7
1027 6 <$> gvsv(*a) s ->7
1028
19e169bf
JC
1029The default rendering is top-down, so they're not in execution order.
1030This form reflects the way the stack is used to parse and evaluate
1031expressions; the add operates on the two terms below it in the tree.
f8a679e6 1032
19e169bf
JC
1033Nullops appear as C<ex-opname>, where I<opname> is an op that has been
1034optimized away by perl. They're displayed with a sequence-number of
1035'-', because they are not executed (they don't appear in previous
1036example), they're printed here because they reflect the parse.
f8a679e6 1037
19e169bf
JC
1038The arrow points to the sequence number of the next op; they're not
1039displayed in -exec mode, for obvious reasons.
f8a679e6 1040
19e169bf
JC
1041Note that because this rendering was done on a non-threaded perl, the
1042PADOPs in the previous examples are now SVOPs, and some (but not all)
1043of the square brackets have been replaced by round ones. This is a
1044subtle feature to provide some visual distinction between renderings
1045on threaded and un-threaded perls.
f8a679e6 1046
f8a679e6 1047
c99ca59a
SM
1048=head1 OPTIONS
1049
1050Arguments that don't start with a hyphen are taken to be the names of
8ec8fbef
SM
1051subroutines to print the OPs of; if no such functions are specified,
1052the main body of the program (outside any subroutines, and not
19e169bf 1053including use'd or require'd files) is rendered. Passing C<BEGIN>,
8ec8fbef
SM
1054C<CHECK>, C<INIT>, or C<END> will cause all of the corresponding
1055special blocks to be printed.
c99ca59a 1056
724aa791
JC
1057Options affect how things are rendered (ie printed). They're presented
1058here by their visual effect, 1st being strongest. They're grouped
1059according to how they interrelate; within each group the options are
1060mutually exclusive (unless otherwise stated).
1061
1062=head2 Options for Opcode Ordering
1063
1064These options control the 'vertical display' of opcodes. The display
1065'order' is also called 'mode' elsewhere in this document.
1066
c99ca59a
SM
1067=over 4
1068
1069=item B<-basic>
1070
1071Print OPs in the order they appear in the OP tree (a preorder
1072traversal, starting at the root). The indentation of each OP shows its
19e169bf
JC
1073level in the tree, and the '->' at the end of the line indicates the
1074next opcode in execution order. This mode is the default, so the flag
1075is included simply for completeness.
c99ca59a
SM
1076
1077=item B<-exec>
1078
1079Print OPs in the order they would normally execute (for the majority
1080of constructs this is a postorder traversal of the tree, ending at the
1081root). In most cases the OP that usually follows a given OP will
1082appear directly below it; alternate paths are shown by indentation. In
1083cases like loops when control jumps out of a linear path, a 'goto'
1084line is generated.
1085
1086=item B<-tree>
1087
1088Print OPs in a text approximation of a tree, with the root of the tree
1089at the left and 'left-to-right' order of children transformed into
1090'top-to-bottom'. Because this mode grows both to the right and down,
1091it isn't suitable for large programs (unless you have a very wide
1092terminal).
1093
724aa791
JC
1094=back
1095
1096=head2 Options for Line-Style
1097
1098These options select the line-style (or just style) used to render
1099each opcode, and dictates what info is actually printed into each line.
1100
1101=over 4
1102
1103=item B<-concise>
1104
1105Use the author's favorite set of formatting conventions. This is the
1106default, of course.
1107
1108=item B<-terse>
1109
1110Use formatting conventions that emulate the output of B<B::Terse>. The
1111basic mode is almost indistinguishable from the real B<B::Terse>, and the
1112exec mode looks very similar, but is in a more logical order and lacks
1113curly brackets. B<B::Terse> doesn't have a tree mode, so the tree mode
1114is only vaguely reminiscent of B<B::Terse>.
1115
1116=item B<-linenoise>
1117
1118Use formatting conventions in which the name of each OP, rather than being
1119written out in full, is represented by a one- or two-character abbreviation.
1120This is mainly a joke.
1121
1122=item B<-debug>
1123
1124Use formatting conventions reminiscent of B<B::Debug>; these aren't
1125very concise at all.
1126
1127=item B<-env>
1128
1129Use formatting conventions read from the environment variables
1130C<B_CONCISE_FORMAT>, C<B_CONCISE_GOTO_FORMAT>, and C<B_CONCISE_TREE_FORMAT>.
1131
1132=back
1133
1134=head2 Options for tree-specific formatting
1135
1136=over 4
1137
c99ca59a
SM
1138=item B<-compact>
1139
1140Use a tree format in which the minimum amount of space is used for the
1141lines connecting nodes (one character in most cases). This squeezes out
1142a few precious columns of screen real estate.
1143
1144=item B<-loose>
1145
1146Use a tree format that uses longer edges to separate OP nodes. This format
1147tends to look better than the compact one, especially in ASCII, and is
1148the default.
1149
1150=item B<-vt>
1151
1152Use tree connecting characters drawn from the VT100 line-drawing set.
1153This looks better if your terminal supports it.
1154
1155=item B<-ascii>
1156
1157Draw the tree with standard ASCII characters like C<+> and C<|>. These don't
1158look as clean as the VT100 characters, but they'll work with almost any
1159terminal (or the horizontal scrolling mode of less(1)) and are suitable
1160for text documentation or email. This is the default.
1161
724aa791 1162=back
c99ca59a 1163
724aa791
JC
1164These are pairwise exclusive, i.e. compact or loose, vt or ascii.
1165
1166=head2 Options controlling sequence numbering
1167
1168=over 4
c99ca59a
SM
1169
1170=item B<-base>I<n>
1171
1172Print OP sequence numbers in base I<n>. If I<n> is greater than 10, the
1173digit for 11 will be 'a', and so on. If I<n> is greater than 36, the digit
1174for 37 will be 'A', and so on until 62. Values greater than 62 are not
1175currently supported. The default is 36.
1176
1177=item B<-bigendian>
1178
1179Print sequence numbers with the most significant digit first. This is the
1180usual convention for Arabic numerals, and the default.
1181
1182=item B<-littleendian>
1183
724aa791
JC
1184Print seqence numbers with the least significant digit first. This is
1185obviously mutually exclusive with bigendian.
c99ca59a 1186
724aa791 1187=back
c99ca59a 1188
724aa791 1189=head2 Other options
c99ca59a 1190
cc02ea56
JC
1191These are pairwise exclusive.
1192
724aa791 1193=over 4
c99ca59a 1194
724aa791 1195=item B<-main>
c99ca59a 1196
724aa791 1197Include the main program in the output, even if subroutines were also
cc02ea56
JC
1198specified. This rendering is normally suppressed when a subroutine
1199name or reference is given.
1200
1201=item B<-nomain>
1202
1203This restores the default behavior after you've changed it with '-main'
1204(it's not normally needed). If no subroutine name/ref is given, main is
1205rendered, regardless of this flag.
1206
1207=item B<-nobanner>
1208
1209Renderings usually include a banner line identifying the function name
1210or stringified subref. This suppresses the printing of the banner.
1211
1212TBC: Remove the stringified coderef; while it provides a 'cookie' for
1213each function rendered, the cookies used should be 1,2,3.. not a
1214random hex-address. It also complicates string comparison of two
1215different trees.
c99ca59a 1216
724aa791 1217=item B<-banner>
c99ca59a 1218
cc02ea56
JC
1219restores default banner behavior.
1220
1221=item B<-banneris> => subref
1222
1223TBC: a hookpoint (and an option to set it) for a user-supplied
1224function to produce a banner appropriate for users needs. It's not
1225ideal, because the rendering-state variables, which are a natural
1226candidate for use in concise.t, are unavailable to the user.
c99ca59a 1227
724aa791 1228=back
c99ca59a 1229
724aa791 1230=head2 Option Stickiness
c99ca59a 1231
724aa791
JC
1232If you invoke Concise more than once in a program, you should know that
1233the options are 'sticky'. This means that the options you provide in
1234the first call will be remembered for the 2nd call, unless you
1235re-specify or change them.
c99ca59a 1236
cc02ea56
JC
1237=head1 ABBREVIATIONS
1238
1239The concise style uses symbols to convey maximum info with minimal
1240clutter (like hex addresses). With just a little practice, you can
1241start to see the flowers, not just the branches, in the trees.
1242
1243=head2 OP class abbreviations
1244
1245These symbols appear before the op-name, and indicate the
1246B:: namespace that represents the ops in your Perl code.
1247
1248 0 OP (aka BASEOP) An OP with no children
1249 1 UNOP An OP with one child
1250 2 BINOP An OP with two children
1251 | LOGOP A control branch OP
1252 @ LISTOP An OP that could have lots of children
1253 / PMOP An OP with a regular expression
1254 $ SVOP An OP with an SV
1255 " PVOP An OP with a string
1256 { LOOP An OP that holds pointers for a loop
1257 ; COP An OP that marks the start of a statement
1258 # PADOP An OP with a GV on the pad
1259
1260=head2 OP flags abbreviations
1261
19e169bf
JC
1262OP flags are either public or private. The public flags alter the
1263behavior of each opcode in consistent ways, and are represented by 0
1264or more single characters.
cc02ea56
JC
1265
1266 v OPf_WANT_VOID Want nothing (void context)
1267 s OPf_WANT_SCALAR Want single value (scalar context)
1268 l OPf_WANT_LIST Want list of any length (list context)
19e169bf 1269 Want is unknown
cc02ea56
JC
1270 K OPf_KIDS There is a firstborn child.
1271 P OPf_PARENS This operator was parenthesized.
1272 (Or block needs explicit scope entry.)
1273 R OPf_REF Certified reference.
1274 (Return container, not containee).
1275 M OPf_MOD Will modify (lvalue).
1276 S OPf_STACKED Some arg is arriving on the stack.
1277 * OPf_SPECIAL Do something weird for this op (see op.h)
1278
19e169bf
JC
1279Private flags, if any are set for an opcode, are displayed after a '/'
1280
1281 8 <@> leave[1 ref] vKP/REFC ->(end)
1282 7 <2> sassign vKS/2 ->8
1283
1284They're opcode specific, and occur less often than the public ones, so
1285they're represented by short mnemonics instead of single-chars; see
00baac8f 1286F<op.h> for gory details, or try this quick 2-liner:
19e169bf
JC
1287
1288 $> perl -MB::Concise -de 1
1289 DB<1> |x \%B::Concise::priv
1290
c99ca59a
SM
1291=head1 FORMATTING SPECIFICATIONS
1292
724aa791
JC
1293For each line-style ('concise', 'terse', 'linenoise', etc.) there are
12943 format-specs which control how OPs are rendered.
1295
1296The first is the 'default' format, which is used in both basic and exec
1297modes to print all opcodes. The 2nd, goto-format, is used in exec
1298mode when branches are encountered. They're not real opcodes, and are
1299inserted to look like a closing curly brace. The tree-format is tree
1300specific.
1301
cc02ea56
JC
1302When a line is rendered, the correct format-spec is copied and scanned
1303for the following items; data is substituted in, and other
1304manipulations like basic indenting are done, for each opcode rendered.
1305
1306There are 3 kinds of items that may be populated; special patterns,
1307#vars, and literal text, which is copied verbatim. (Yes, it's a set
1308of s///g steps.)
1309
1310=head2 Special Patterns
1311
1312These items are the primitives used to perform indenting, and to
1313select text from amongst alternatives.
c99ca59a
SM
1314
1315=over 4
1316
1317=item B<(x(>I<exec_text>B<;>I<basic_text>B<)x)>
1318
1319Generates I<exec_text> in exec mode, or I<basic_text> in basic mode.
1320
1321=item B<(*(>I<text>B<)*)>
1322
1323Generates one copy of I<text> for each indentation level.
1324
1325=item B<(*(>I<text1>B<;>I<text2>B<)*)>
1326
1327Generates one fewer copies of I<text1> than the indentation level, followed
1328by one copy of I<text2> if the indentation level is more than 0.
1329
1330=item B<(?(>I<text1>B<#>I<var>I<Text2>B<)?)>
1331
1332If the value of I<var> is true (not empty or zero), generates the
1333value of I<var> surrounded by I<text1> and I<Text2>, otherwise
1334nothing.
1335
cc02ea56
JC
1336=item B<~>
1337
1338Any number of tildes and surrounding whitespace will be collapsed to
1339a single space.
1340
1341=back
1342
1343=head2 # Variables
1344
1345These #vars represent opcode properties that you may want as part of
1346your rendering. The '#' is intended as a private sigil; a #var's
1347value is interpolated into the style-line, much like "read $this".
1348
1349These vars take 3 forms:
1350
1351=over 4
1352
c99ca59a
SM
1353=item B<#>I<var>
1354
cc02ea56
JC
1355A property named 'var' is assumed to exist for the opcodes, and is
1356interpolated into the rendering.
c99ca59a
SM
1357
1358=item B<#>I<var>I<N>
1359
cc02ea56
JC
1360Generates the value of I<var>, left justified to fill I<N> spaces.
1361Note that this means while you can have properties 'foo' and 'foo2',
1362you cannot render 'foo2', but you could with 'foo2a'. You would be
1363wise not to rely on this behavior going forward ;-)
c99ca59a 1364
cc02ea56 1365=item B<#>I<Var>
c99ca59a 1366
cc02ea56
JC
1367This ucfirst form of #var generates a tag-value form of itself for
1368display; it converts '#Var' into a 'Var => #var' style, which is then
1369handled as described above. (Imp-note: #Vars cannot be used for
1370conditional-fills, because the => #var transform is done after the check
1371for #Var's value).
c99ca59a
SM
1372
1373=back
1374
cc02ea56
JC
1375The following variables are 'defined' by B::Concise; when they are
1376used in a style, their respective values are plugged into the
1377rendering of each opcode.
1378
1379Only some of these are used by the standard styles, the others are
1380provided for you to delve into optree mechanics, should you wish to
1381add a new style (see L</add_style> below) that uses them. You can
00baac8f 1382also add new ones using L</add_callback>.
c99ca59a
SM
1383
1384=over 4
1385
1386=item B<#addr>
1387
cc02ea56 1388The address of the OP, in hexadecimal.
c99ca59a
SM
1389
1390=item B<#arg>
1391
1392The OP-specific information of the OP (such as the SV for an SVOP, the
cc02ea56 1393non-local exit pointers for a LOOP, etc.) enclosed in parentheses.
c99ca59a
SM
1394
1395=item B<#class>
1396
1397The B-determined class of the OP, in all caps.
1398
f8a679e6 1399=item B<#classsym>
c99ca59a
SM
1400
1401A single symbol abbreviating the class of the OP.
1402
c3caa09d
SM
1403=item B<#coplabel>
1404
1405The label of the statement or block the OP is the start of, if any.
1406
c99ca59a
SM
1407=item B<#exname>
1408
1409The name of the OP, or 'ex-foo' if the OP is a null that used to be a foo.
1410
1411=item B<#extarg>
1412
1413The target of the OP, or nothing for a nulled OP.
1414
1415=item B<#firstaddr>
1416
19e169bf 1417The address of the OP's first child, in hexadecimal.
c99ca59a
SM
1418
1419=item B<#flags>
1420
1421The OP's flags, abbreviated as a series of symbols.
1422
1423=item B<#flagval>
1424
1425The numeric value of the OP's flags.
1426
d5ec2987
NC
1427=item B<#hints>
1428
1429The COP's hint flags, rendered with abbreviated names if possible. An empty
1430string if this is not a COP.
1431
1432=item B<#hintsval>
1433
1434The numeric value of the COP's hint flags, or an empty string if this is not
1435a COP.
1436
f8a679e6 1437=item B<#hyphseq>
c99ca59a
SM
1438
1439The sequence number of the OP, or a hyphen if it doesn't have one.
1440
1441=item B<#label>
1442
1443'NEXT', 'LAST', or 'REDO' if the OP is a target of one of those in exec
1444mode, or empty otherwise.
1445
1446=item B<#lastaddr>
1447
19e169bf 1448The address of the OP's last child, in hexadecimal.
c99ca59a
SM
1449
1450=item B<#name>
1451
1452The OP's name.
1453
1454=item B<#NAME>
1455
1456The OP's name, in all caps.
1457
1458=item B<#next>
1459
1460The sequence number of the OP's next OP.
1461
1462=item B<#nextaddr>
1463
19e169bf 1464The address of the OP's next OP, in hexadecimal.
c99ca59a
SM
1465
1466=item B<#noise>
1467
c27ea44e 1468A one- or two-character abbreviation for the OP's name.
c99ca59a
SM
1469
1470=item B<#private>
1471
1472The OP's private flags, rendered with abbreviated names if possible.
1473
1474=item B<#privval>
1475
1476The numeric value of the OP's private flags.
1477
1478=item B<#seq>
1479
2814eb74
PJ
1480The sequence number of the OP. Note that this is a sequence number
1481generated by B::Concise.
c99ca59a 1482
7252851f
NC
1483=item B<#seqnum>
1484
14855.8.x and earlier only. 5.9 and later do not provide this.
1486
1487The real sequence number of the OP, as a regular number and not adjusted
1488to be relative to the start of the real program. (This will generally be
1489a fairly large number because all of B<B::Concise> is compiled before
1490your program is).
1491
2814eb74 1492=item B<#opt>
c99ca59a 1493
2814eb74
PJ
1494Whether or not the op has been optimised by the peephole optimiser.
1495
7252851f
NC
1496Only available in 5.9 and later.
1497
2814eb74
PJ
1498=item B<#static>
1499
1500Whether or not the op is statically defined. This flag is used by the
1501B::C compiler backend and indicates that the op should not be freed.
c99ca59a 1502
7252851f
NC
1503Only available in 5.9 and later.
1504
c99ca59a
SM
1505=item B<#sibaddr>
1506
19e169bf 1507The address of the OP's next youngest sibling, in hexadecimal.
c99ca59a
SM
1508
1509=item B<#svaddr>
1510
19e169bf 1511The address of the OP's SV, if it has an SV, in hexadecimal.
c99ca59a
SM
1512
1513=item B<#svclass>
1514
1515The class of the OP's SV, if it has one, in all caps (e.g., 'IV').
1516
1517=item B<#svval>
1518
1519The value of the OP's SV, if it has one, in a short human-readable format.
1520
1521=item B<#targ>
1522
1523The numeric value of the OP's targ.
1524
1525=item B<#targarg>
1526
1527The name of the variable the OP's targ refers to, if any, otherwise the
1528letter t followed by the OP's targ in decimal.
1529
1530=item B<#targarglife>
1531
1532Same as B<#targarg>, but followed by the COP sequence numbers that delimit
1533the variable's lifetime (or 'end' for a variable in an open scope) for a
1534variable.
1535
1536=item B<#typenum>
1537
1538The numeric value of the OP's type, in decimal.
1539
1540=back
1541
f9f861ec
JC
1542=head1 One-Liner Command tips
1543
1544=over 4
1545
1546=item perl -MO=Concise,bar foo.pl
1547
1548Renders only bar() from foo.pl. To see main, drop the ',bar'. To see
1549both, add ',-main'
1550
1551=item perl -MDigest::MD5=md5 -MO=Concise,md5 -e1
1552
1553Identifies md5 as an XS function. The export is needed so that BC can
1554find it in main.
1555
1556=item perl -MPOSIX -MO=Concise,_POSIX_ARG_MAX -e1
1557
1558Identifies _POSIX_ARG_MAX as a constant sub, optimized to an IV.
1559Although POSIX isn't entirely consistent across platforms, this is
1560likely to be present in virtually all of them.
1561
1562=item perl -MPOSIX -MO=Concise,a -e 'print _POSIX_SAVED_IDS'
1563
1564This renders a print statement, which includes a call to the function.
1565It's identical to rendering a file with a use call and that single
1566statement, except for the filename which appears in the nextstate ops.
1567
1568=item perl -MPOSIX -MO=Concise,a -e 'sub a{_POSIX_SAVED_IDS}'
1569
1570This is B<very> similar to previous, only the first two ops differ. This
1571subroutine rendering is more representative, insofar as a single main
1572program will have many subs.
1573
1574
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