This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
When you write C<my $_ ; for (...) {...}>, the lexical $_
[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
bf2b43ff 17our $VERSION = "0.58";
78ad9108 18our @ISA = qw(Exporter);
31b49ad4 19our @EXPORT_OK = qw(set_style set_style_standard add_callback
8ec8fbef 20 concise_subref concise_cv concise_main);
78ad9108 21
8ec8fbef 22# use #6
c99ca59a 23use B qw(class ppname main_start main_root main_cv cstring svref_2object
127212b2 24 SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS CVf_ANON);
c99ca59a
SM
25
26my %style =
27 ("terse" =>
c3caa09d
SM
28 ["(?(#label =>\n)?)(*( )*)#class (#addr) #name (?([#targ])?) "
29 . "#svclass~(?((#svaddr))?)~#svval~(?(label \"#coplabel\")?)\n",
c99ca59a
SM
30 "(*( )*)goto #class (#addr)\n",
31 "#class pp_#name"],
32 "concise" =>
33 ["#hyphseq2 (*( (x( ;)x))*)<#classsym> "
34 . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x)\n",
35 " (*( )*) goto #seq\n",
36 "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"],
37 "linenoise" =>
38 ["(x(;(*( )*))x)#noise#arg(?([#targarg])?)(x( ;\n)x)",
39 "gt_#seq ",
40 "(?(#seq)?)#noise#arg(?([#targarg])?)"],
41 "debug" =>
42 ["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t"
43 . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n\top_seq\t\t"
44 . "#seqnum\n\top_flags\t#flagval\n\top_private\t#privval\n"
45 . "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)"
46 . "(?(\top_sv\t\t#svaddr\n)?)",
47 " GOTO #addr\n",
48 "#addr"],
49 "env" => [$ENV{B_CONCISE_FORMAT}, $ENV{B_CONCISE_GOTO_FORMAT},
50 $ENV{B_CONCISE_TREE_FORMAT}],
51 );
52
53my($format, $gotofmt, $treefmt);
54my $curcv;
c27ea44e 55my $cop_seq_base;
78ad9108
PJ
56my @callbacks;
57
58sub set_style {
59 ($format, $gotofmt, $treefmt) = @_;
60}
61
31b49ad4
SM
62sub set_style_standard {
63 my($name) = @_;
64 set_style(@{$style{$name}});
65}
66
78ad9108
PJ
67sub add_callback {
68 push @callbacks, @_;
69}
c99ca59a 70
8ec8fbef
SM
71sub concise_subref {
72 my($order, $subref) = @_;
73 concise_cv_obj($order, svref_2object($subref));
74}
75
76# This should have been called concise_subref, but it was exported
77# under this name in versions before 0.56
78sub concise_cv { concise_subref(@_); }
79
80sub concise_cv_obj {
81 my ($order, $cv) = @_;
c99ca59a 82 $curcv = $cv;
c27ea44e 83 sequence($cv->START);
c99ca59a
SM
84 if ($order eq "exec") {
85 walk_exec($cv->START);
86 } elsif ($order eq "basic") {
87 walk_topdown($cv->ROOT, sub { $_[0]->concise($_[1]) }, 0);
88 } else {
89 print tree($cv->ROOT, 0)
90 }
91}
92
31b49ad4
SM
93sub concise_main {
94 my($order) = @_;
95 sequence(main_start);
96 $curcv = main_cv;
97 if ($order eq "exec") {
98 return if class(main_start) eq "NULL";
99 walk_exec(main_start);
100 } elsif ($order eq "tree") {
101 return if class(main_root) eq "NULL";
102 print tree(main_root, 0);
103 } elsif ($order eq "basic") {
104 return if class(main_root) eq "NULL";
105 walk_topdown(main_root,
106 sub { $_[0]->concise($_[1]) }, 0);
107 }
108}
109
8ec8fbef
SM
110sub concise_specials {
111 my($name, $order, @cv_s) = @_;
112 my $i = 1;
113 if ($name eq "BEGIN") {
114 splice(@cv_s, 0, 7); # skip 7 BEGIN blocks in this file
115 } elsif ($name eq "CHECK") {
116 pop @cv_s; # skip the CHECK block that calls us
117 }
118 for my $cv (@cv_s) {
119 print "$name $i:\n";
120 $i++;
121 concise_cv_obj($order, $cv);
122 }
123}
124
c99ca59a
SM
125my $start_sym = "\e(0"; # "\cN" sometimes also works
126my $end_sym = "\e(B"; # "\cO" respectively
127
128my @tree_decorations =
129 ([" ", "--", "+-", "|-", "| ", "`-", "-", 1],
130 [" ", "-", "+", "+", "|", "`", "", 0],
131 [" ", map("$start_sym$_$end_sym", "qq", "wq", "tq", "x ", "mq", "q"), 1],
132 [" ", map("$start_sym$_$end_sym", "q", "w", "t", "x", "m"), "", 0],
133 );
134my $tree_style = 0;
135
136my $base = 36;
137my $big_endian = 1;
138
139my $order = "basic";
140
31b49ad4 141set_style_standard("concise");
78ad9108 142
c99ca59a
SM
143sub compile {
144 my @options = grep(/^-/, @_);
145 my @args = grep(!/^-/, @_);
146 my $do_main = 0;
c99ca59a
SM
147 for my $o (@options) {
148 if ($o eq "-basic") {
149 $order = "basic";
150 } elsif ($o eq "-exec") {
151 $order = "exec";
152 } elsif ($o eq "-tree") {
153 $order = "tree";
154 } elsif ($o eq "-compact") {
155 $tree_style |= 1;
156 } elsif ($o eq "-loose") {
157 $tree_style &= ~1;
158 } elsif ($o eq "-vt") {
159 $tree_style |= 2;
160 } elsif ($o eq "-ascii") {
161 $tree_style &= ~2;
162 } elsif ($o eq "-main") {
163 $do_main = 1;
164 } elsif ($o =~ /^-base(\d+)$/) {
165 $base = $1;
166 } elsif ($o eq "-bigendian") {
167 $big_endian = 1;
168 } elsif ($o eq "-littleendian") {
169 $big_endian = 0;
170 } elsif (exists $style{substr($o, 1)}) {
78ad9108 171 set_style(@{$style{substr($o, 1)}});
c99ca59a
SM
172 } else {
173 warn "Option $o unrecognized";
174 }
175 }
c27ea44e
SM
176 return sub {
177 if (@args) {
c99ca59a 178 for my $objname (@args) {
8ec8fbef
SM
179 if ($objname eq "BEGIN") {
180 concise_specials("BEGIN", $order,
181 B::begin_av->isa("B::AV") ?
182 B::begin_av->ARRAY : ());
183 } elsif ($objname eq "INIT") {
184 concise_specials("INIT", $order,
185 B::init_av->isa("B::AV") ?
186 B::init_av->ARRAY : ());
187 } elsif ($objname eq "CHECK") {
188 concise_specials("CHECK", $order,
189 B::check_av->isa("B::AV") ?
190 B::check_av->ARRAY : ());
191 } elsif ($objname eq "END") {
192 concise_specials("END", $order,
193 B::end_av->isa("B::AV") ?
194 B::end_av->ARRAY : ());
195 } else {
196 $objname = "main::" . $objname unless $objname =~ /::/;
197 print "$objname:\n";
198 eval "concise_subref(\$order, \\&$objname)";
199 die "concise_subref($order, \\&$objname) failed: $@" if $@;
200 }
c99ca59a
SM
201 }
202 }
c27ea44e
SM
203 if (!@args or $do_main) {
204 print "main program:\n" if $do_main;
31b49ad4 205 concise_main($order);
c99ca59a
SM
206 }
207 }
208}
209
210my %labels;
211my $lastnext;
212
213my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|",
214 'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*",
051f02e9 215 'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#");
c99ca59a 216
8ec8fbef 217no warnings 'qw'; # "Possible attempt to put comments..."; use #7
35fc55f1
RH
218my @linenoise =
219 qw'# () sc ( @? 1 $* gv *{ m$ m@ m% m? p/ *$ $ $# & a& pt \\ s\\ rf bl
c99ca59a
SM
220 ` *? <> ?? ?/ r/ c/ // qr s/ /c y/ = @= C sC Cp sp df un BM po +1 +I
221 -1 -I 1+ I+ 1- I- ** * i* / i/ %$ i% x + i+ - i- . " << >> < i<
222 > i> <= i, >= i. == i= != i! <? i? s< s> s, s. s= s! s? b& b^ b| -0 -i
223 ! ~ a2 si cs rd sr e^ lg sq in %x %o ab le ss ve ix ri sf FL od ch cy
224 uf lf uc lc qm @ [f [ @[ eh vl ky dl ex % ${ @{ uk pk st jn ) )[ a@
225 a% sl +] -] [- [+ so rv GS GW MS MW .. f. .f && || ^^ ?: &= |= -> s{ s}
226 v} ca wa di rs ;; ; ;d }{ { } {} f{ it {l l} rt }l }n }r dm }g }e ^o
227 ^c ^| ^# um bm t~ u~ ~d DB db ^s se ^g ^r {w }w pf pr ^O ^K ^R ^W ^d ^v
228 ^e ^t ^k t. fc ic fl .s .p .b .c .l .a .h g1 s1 g2 s2 ?. l? -R -W -X -r
229 -w -x -e -o -O -z -s -M -A -C -S -c -b -f -d -p -l -u -g -k -t -T -B cd
230 co cr u. cm ut r. l@ s@ r@ mD uD oD rD tD sD wD cD f$ w$ p$ sh e$ k$ g3
231 g4 s4 g5 s5 T@ C@ L@ G@ A@ S@ Hg Hc Hr Hw Mg Mc Ms Mr Sg Sc So rq do {e
232 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 233 Pu GP SP EP Gn Gg GG SG EG g0 c$ lk t$ ;s n> // /= CO';
c99ca59a
SM
234
235my $chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
236
237sub op_flags {
238 my($x) = @_;
239 my(@v);
240 push @v, "v" if ($x & 3) == 1;
241 push @v, "s" if ($x & 3) == 2;
242 push @v, "l" if ($x & 3) == 3;
243 push @v, "K" if $x & 4;
244 push @v, "P" if $x & 8;
245 push @v, "R" if $x & 16;
246 push @v, "M" if $x & 32;
247 push @v, "S" if $x & 64;
248 push @v, "*" if $x & 128;
249 return join("", @v);
250}
251
252sub base_n {
253 my $x = shift;
254 return "-" . base_n(-$x) if $x < 0;
255 my $str = "";
256 do { $str .= substr($chars, $x % $base, 1) } while $x = int($x / $base);
257 $str = reverse $str if $big_endian;
258 return $str;
259}
260
c27ea44e
SM
261my %sequence_num;
262my $seq_max = 1;
263
264sub seq {
265 my($op) = @_;
266 return "-" if not exists $sequence_num{$$op};
267 return base_n($sequence_num{$$op});
268}
c99ca59a
SM
269
270sub walk_topdown {
271 my($op, $sub, $level) = @_;
272 $sub->($op, $level);
273 if ($op->flags & OPf_KIDS) {
274 for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
275 walk_topdown($kid, $sub, $level + 1);
276 }
277 }
c6e79e55
SM
278 if (class($op) eq "PMOP") {
279 my $maybe_root = $op->pmreplroot;
280 if (ref($maybe_root) and $maybe_root->isa("B::OP")) {
281 # It really is the root of the replacement, not something
282 # else stored here for lack of space elsewhere
283 walk_topdown($maybe_root, $sub, $level + 1);
284 }
c99ca59a
SM
285 }
286}
287
288sub walklines {
289 my($ar, $level) = @_;
290 for my $l (@$ar) {
291 if (ref($l) eq "ARRAY") {
292 walklines($l, $level + 1);
293 } else {
294 $l->concise($level);
295 }
296 }
297}
298
299sub walk_exec {
300 my($top, $level) = @_;
301 my %opsseen;
302 my @lines;
303 my @todo = ([$top, \@lines]);
304 while (@todo and my($op, $targ) = @{shift @todo}) {
305 for (; $$op; $op = $op->next) {
306 last if $opsseen{$$op}++;
307 push @$targ, $op;
308 my $name = $op->name;
62e36f8a 309 if (class($op) eq "LOGOP") {
c99ca59a
SM
310 my $ar = [];
311 push @$targ, $ar;
312 push @todo, [$op->other, $ar];
313 } elsif ($name eq "subst" and $ {$op->pmreplstart}) {
314 my $ar = [];
315 push @$targ, $ar;
316 push @todo, [$op->pmreplstart, $ar];
317 } elsif ($name =~ /^enter(loop|iter)$/) {
318 $labels{$op->nextop->seq} = "NEXT";
319 $labels{$op->lastop->seq} = "LAST";
320 $labels{$op->redoop->seq} = "REDO";
321 }
322 }
323 }
324 walklines(\@lines, 0);
325}
326
c27ea44e
SM
327# The structure of this routine is purposely modeled after op.c's peep()
328sub sequence {
329 my($op) = @_;
330 my $oldop = 0;
331 return if class($op) eq "NULL" or exists $sequence_num{$$op};
332 for (; $$op; $op = $op->next) {
333 last if exists $sequence_num{$$op};
334 my $name = $op->name;
335 if ($name =~ /^(null|scalar|lineseq|scope)$/) {
336 next if $oldop and $ {$op->next};
337 } else {
338 $sequence_num{$$op} = $seq_max++;
339 if (class($op) eq "LOGOP") {
340 my $other = $op->other;
341 $other = $other->next while $other->name eq "null";
342 sequence($other);
343 } elsif (class($op) eq "LOOP") {
344 my $redoop = $op->redoop;
345 $redoop = $redoop->next while $redoop->name eq "null";
346 sequence($redoop);
347 my $nextop = $op->nextop;
348 $nextop = $nextop->next while $nextop->name eq "null";
349 sequence($nextop);
350 my $lastop = $op->lastop;
351 $lastop = $lastop->next while $lastop->name eq "null";
352 sequence($lastop);
353 } elsif ($name eq "subst" and $ {$op->pmreplstart}) {
354 my $replstart = $op->pmreplstart;
355 $replstart = $replstart->next while $replstart->name eq "null";
356 sequence($replstart);
357 }
358 }
359 $oldop = $op;
360 }
361}
362
c99ca59a
SM
363sub fmt_line {
364 my($hr, $fmt, $level) = @_;
365 my $text = $fmt;
366 $text =~ s/\(\?\(([^\#]*?)\#(\w+)([^\#]*?)\)\?\)/
367 $hr->{$2} ? $1.$hr->{$2}.$3 : ""/eg;
368 $text =~ s/\(x\((.*?);(.*?)\)x\)/$order eq "exec" ? $1 : $2/egs;
369 $text =~ s/\(\*\(([^;]*?)\)\*\)/$1 x $level/egs;
370 $text =~ s/\(\*\((.*?);(.*?)\)\*\)/$1 x ($level - 1) . $2 x ($level>0)/egs;
371 $text =~ s/#([a-zA-Z]+)(\d+)/sprintf("%-$2s", $hr->{$1})/eg;
372 $text =~ s/#([a-zA-Z]+)/$hr->{$1}/eg;
373 $text =~ s/[ \t]*~+[ \t]*/ /g;
374 return $text;
375}
376
377my %priv;
378$priv{$_}{128} = "LVINTRO"
379 for ("pos", "substr", "vec", "threadsv", "gvsv", "rv2sv", "rv2hv", "rv2gv",
380 "rv2av", "rv2arylen", "aelem", "helem", "aslice", "hslice", "padsv",
241416b8 381 "padav", "padhv", "enteriter");
c99ca59a
SM
382$priv{$_}{64} = "REFC" for ("leave", "leavesub", "leavesublv", "leavewrite");
383$priv{"aassign"}{64} = "COMMON";
c99ca59a
SM
384$priv{"sassign"}{64} = "BKWARD";
385$priv{$_}{64} = "RTIME" for ("match", "subst", "substcont");
386@{$priv{"trans"}}{1,2,4,8,16,64} = ("<UTF", ">UTF", "IDENT", "SQUASH", "DEL",
387 "COMPL", "GROWS");
388$priv{"repeat"}{64} = "DOLIST";
389$priv{"leaveloop"}{64} = "CONT";
390@{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV")
391 for ("entersub", map("rv2${_}v", "a", "s", "h", "g"), "aelem", "helem");
392$priv{"entersub"}{16} = "DBG";
393$priv{"entersub"}{32} = "TARG";
394@{$priv{$_}}{4,8,128} = ("INARGS","AMPER","NO()") for ("entersub", "rv2cv");
395$priv{"gv"}{32} = "EARLYCV";
396$priv{"aelem"}{16} = $priv{"helem"}{16} = "LVDEFER";
241416b8
DM
397$priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv",
398 "enteriter");
c99ca59a
SM
399$priv{$_}{16} = "TARGMY"
400 for (map(($_,"s$_"),"chop", "chomp"),
401 map(($_,"i_$_"), "postinc", "postdec", "multiply", "divide", "modulo",
402 "add", "subtract", "negate"), "pow", "concat", "stringify",
403 "left_shift", "right_shift", "bit_and", "bit_xor", "bit_or",
404 "complement", "atan2", "sin", "cos", "rand", "exp", "log", "sqrt",
405 "int", "hex", "oct", "abs", "length", "index", "rindex", "sprintf",
406 "ord", "chr", "crypt", "quotemeta", "join", "push", "unshift", "flock",
407 "chdir", "chown", "chroot", "unlink", "chmod", "utime", "rename",
408 "link", "symlink", "mkdir", "rmdir", "wait", "waitpid", "system",
409 "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority",
410 "setpriority", "time", "sleep");
7a9b44b9 411@{$priv{"const"}}{8,16,32,64,128} = ("STRICT","ENTERED", '$[', "BARE", "WARN");
c99ca59a
SM
412$priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM";
413$priv{"list"}{64} = "GUESSED";
414$priv{"delete"}{64} = "SLICE";
415$priv{"exists"}{64} = "SUB";
416$priv{$_}{64} = "LOCALE"
417 for ("sort", "prtf", "sprintf", "slt", "sle", "seq", "sne", "sgt", "sge",
418 "scmp", "lc", "uc", "lcfirst", "ucfirst");
2b6e98cb 419@{$priv{"sort"}}{1,2,4,8} = ("NUM", "INT", "REV", "INPLACE");
c99ca59a 420$priv{"threadsv"}{64} = "SVREFd";
c27ea44e
SM
421@{$priv{$_}}{16,32,64,128} = ("INBIN","INCR","OUTBIN","OUTCR")
422 for ("open", "backtick");
c99ca59a 423$priv{"exit"}{128} = "VMS";
feaeca78
JH
424$priv{$_}{2} = "FTACCESS"
425 for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec");
fbb0b3b3
RGS
426$priv{$_}{4} = "FTSTACKED"
427 for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec",
428 "ftis", "fteowned", "ftrowned", "ftzero", "ftsize", "ftmtime",
429 "ftatime", "ftctime", "ftsock", "ftchr", "ftblk", "ftfile", "ftdir",
430 "ftpipe", "ftlink", "ftsuid", "ftsgid", "ftsvtx", "fttty", "fttext",
431 "ftbinary");
bf2b43ff
RGS
432$priv{$_}{2} = "GREPLEX"
433 for ("mapwhile", "mapstart", "grepwhile", "grepstart");
c99ca59a
SM
434
435sub private_flags {
436 my($name, $x) = @_;
437 my @s;
438 for my $flag (128, 96, 64, 32, 16, 8, 4, 2, 1) {
439 if ($priv{$name}{$flag} and $x & $flag and $x >= $flag) {
440 $x -= $flag;
441 push @s, $priv{$name}{$flag};
442 }
443 }
444 push @s, $x if $x;
445 return join(",", @s);
446}
447
c27ea44e
SM
448sub concise_sv {
449 my($sv, $hr) = @_;
450 $hr->{svclass} = class($sv);
31b49ad4
SM
451 $hr->{svclass} = "UV"
452 if $hr->{svclass} eq "IV" and $sv->FLAGS & SVf_IVisUV;
c27ea44e
SM
453 $hr->{svaddr} = sprintf("%#x", $$sv);
454 if ($hr->{svclass} eq "GV") {
455 my $gv = $sv;
456 my $stash = $gv->STASH->NAME;
457 if ($stash eq "main") {
458 $stash = "";
459 } else {
460 $stash = $stash . "::";
461 }
462 $hr->{svval} = "*$stash" . $gv->SAFENAME;
463 return "*$stash" . $gv->SAFENAME;
464 } else {
465 while (class($sv) eq "RV") {
466 $hr->{svval} .= "\\";
467 $sv = $sv->RV;
468 }
469 if (class($sv) eq "SPECIAL") {
40b5b14f 470 $hr->{svval} .= ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv];
c27ea44e 471 } elsif ($sv->FLAGS & SVf_NOK) {
40b5b14f 472 $hr->{svval} .= $sv->NV;
c27ea44e 473 } elsif ($sv->FLAGS & SVf_IOK) {
31b49ad4 474 $hr->{svval} .= $sv->int_value;
c27ea44e 475 } elsif ($sv->FLAGS & SVf_POK) {
40b5b14f 476 $hr->{svval} .= cstring($sv->PV);
31b49ad4
SM
477 } elsif (class($sv) eq "HV") {
478 $hr->{svval} .= 'HASH';
c27ea44e
SM
479 }
480 return $hr->{svclass} . " " . $hr->{svval};
481 }
482}
483
c99ca59a
SM
484sub concise_op {
485 my ($op, $level, $format) = @_;
486 my %h;
487 $h{exname} = $h{name} = $op->name;
488 $h{NAME} = uc $h{name};
489 $h{class} = class($op);
490 $h{extarg} = $h{targ} = $op->targ;
491 $h{extarg} = "" unless $h{extarg};
492 if ($h{name} eq "null" and $h{targ}) {
8ec8fbef 493 # targ holds the old type
c99ca59a
SM
494 $h{exname} = "ex-" . substr(ppname($h{targ}), 3);
495 $h{extarg} = "";
8ec8fbef
SM
496 } elsif ($op->name =~ /^leave(sub(lv)?|write)?$/) {
497 # targ potentially holds a reference count
498 if ($op->private & 64) {
499 my $refs = "ref" . ($h{targ} != 1 ? "s" : "");
500 $h{targarglife} = $h{targarg} = "$h{targ} $refs";
501 }
c99ca59a
SM
502 } elsif ($h{targ}) {
503 my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}];
504 if (defined $padname and class($padname) ne "SPECIAL") {
0b40bd6d 505 $h{targarg} = $padname->PVX;
127212b2
DM
506 if ($padname->FLAGS & SVf_FAKE) {
507 my $fake = '';
508 $fake .= 'a' if $padname->IVX & 1; # PAD_FAKELEX_ANON
509 $fake .= 'm' if $padname->IVX & 2; # PAD_FAKELEX_MULTI
510 $fake .= ':' . $padname->NVX if $curcv->CvFLAGS & CVf_ANON;
511 $h{targarglife} = "$h{targarg}:FAKE:$fake";
512 }
513 else {
514 my $intro = $padname->NVX - $cop_seq_base;
515 my $finish = int($padname->IVX) - $cop_seq_base;
516 $finish = "end" if $finish == 999999999 - $cop_seq_base;
517 $h{targarglife} = "$h{targarg}:$intro,$finish";
518 }
c99ca59a
SM
519 } else {
520 $h{targarglife} = $h{targarg} = "t" . $h{targ};
521 }
522 }
523 $h{arg} = "";
524 $h{svclass} = $h{svaddr} = $h{svval} = "";
525 if ($h{class} eq "PMOP") {
526 my $precomp = $op->precomp;
7a9b44b9 527 if (defined $precomp) {
c27ea44e
SM
528 $precomp = cstring($precomp); # Escape literal control sequences
529 $precomp = "/$precomp/";
530 } else {
531 $precomp = "";
7a9b44b9 532 }
b2a3cfdd 533 my $pmreplroot = $op->pmreplroot;
34a48b4b 534 my $pmreplstart;
c6e79e55 535 if (ref($pmreplroot) eq "B::GV") {
b2a3cfdd 536 # with C<@stash_array = split(/pat/, str);>,
c6e79e55 537 # *stash_array is stored in /pat/'s pmreplroot.
b2a3cfdd 538 $h{arg} = "($precomp => \@" . $pmreplroot->NAME . ")";
c6e79e55
SM
539 } elsif (!ref($pmreplroot) and $pmreplroot) {
540 # same as the last case, except the value is actually a
541 # pad offset for where the GV is kept (this happens under
542 # ithreads)
543 my $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$pmreplroot];
544 $h{arg} = "($precomp => \@" . $gv->NAME . ")";
b2a3cfdd 545 } elsif ($ {$op->pmreplstart}) {
c99ca59a
SM
546 undef $lastnext;
547 $pmreplstart = "replstart->" . seq($op->pmreplstart);
548 $h{arg} = "(" . join(" ", $precomp, $pmreplstart) . ")";
549 } else {
550 $h{arg} = "($precomp)";
551 }
552 } elsif ($h{class} eq "PVOP" and $h{name} ne "trans") {
553 $h{arg} = '("' . $op->pv . '")';
554 $h{svval} = '"' . $op->pv . '"';
555 } elsif ($h{class} eq "COP") {
556 my $label = $op->label;
c3caa09d 557 $h{coplabel} = $label;
c99ca59a
SM
558 $label = $label ? "$label: " : "";
559 my $loc = $op->file;
560 $loc =~ s[.*/][];
561 $loc .= ":" . $op->line;
562 my($stash, $cseq) = ($op->stash->NAME, $op->cop_seq - $cop_seq_base);
563 my $arybase = $op->arybase;
564 $arybase = $arybase ? ' $[=' . $arybase : "";
565 $h{arg} = "($label$stash $cseq $loc$arybase)";
566 } elsif ($h{class} eq "LOOP") {
567 $h{arg} = "(next->" . seq($op->nextop) . " last->" . seq($op->lastop)
568 . " redo->" . seq($op->redoop) . ")";
569 } elsif ($h{class} eq "LOGOP") {
570 undef $lastnext;
571 $h{arg} = "(other->" . seq($op->other) . ")";
572 } elsif ($h{class} eq "SVOP") {
c27ea44e
SM
573 if (! ${$op->sv}) {
574 my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$op->targ];
575 $h{arg} = "[" . concise_sv($sv, \%h) . "]";
576 $h{targarglife} = $h{targarg} = "";
c99ca59a 577 } else {
c27ea44e 578 $h{arg} = "(" . concise_sv($op->sv, \%h) . ")";
c99ca59a 579 }
31b49ad4
SM
580 } elsif ($h{class} eq "PADOP") {
581 my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$op->padix];
582 $h{arg} = "[" . concise_sv($sv, \%h) . "]";
c99ca59a
SM
583 }
584 $h{seq} = $h{hyphseq} = seq($op);
585 $h{seq} = "" if $h{seq} eq "-";
586 $h{seqnum} = $op->seq;
587 $h{next} = $op->next;
588 $h{next} = (class($h{next}) eq "NULL") ? "(end)" : seq($h{next});
589 $h{nextaddr} = sprintf("%#x", $ {$op->next});
590 $h{sibaddr} = sprintf("%#x", $ {$op->sibling});
591 $h{firstaddr} = sprintf("%#x", $ {$op->first}) if $op->can("first");
592 $h{lastaddr} = sprintf("%#x", $ {$op->last}) if $op->can("last");
593
594 $h{classsym} = $opclass{$h{class}};
595 $h{flagval} = $op->flags;
596 $h{flags} = op_flags($op->flags);
597 $h{privval} = $op->private;
598 $h{private} = private_flags($h{name}, $op->private);
599 $h{addr} = sprintf("%#x", $$op);
600 $h{label} = $labels{$op->seq};
601 $h{typenum} = $op->type;
602 $h{noise} = $linenoise[$op->type];
78ad9108 603 $_->(\%h, $op, \$format, \$level) for @callbacks;
c99ca59a
SM
604 return fmt_line(\%h, $format, $level);
605}
606
607sub B::OP::concise {
608 my($op, $level) = @_;
609 if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
610 my $h = {"seq" => seq($lastnext), "class" => class($lastnext),
611 "addr" => sprintf("%#x", $$lastnext)};
612 print fmt_line($h, $gotofmt, $level+1);
613 }
614 $lastnext = $op->next;
615 print concise_op($op, $level, $format);
616}
617
31b49ad4
SM
618# B::OP::terse (see Terse.pm) now just calls this
619sub b_terse {
620 my($op, $level) = @_;
621
622 # This isn't necessarily right, but there's no easy way to get
623 # from an OP to the right CV. This is a limitation of the
624 # ->terse() interface style, and there isn't much to do about
625 # it. In particular, we can die in concise_op if the main pad
626 # isn't long enough, or has the wrong kind of entries, compared to
627 # the pad a sub was compiled with. The fix for that would be to
628 # make a backwards compatible "terse" format that never even
629 # looked at the pad, just like the old B::Terse. I don't think
630 # that's worth the effort, though.
631 $curcv = main_cv unless $curcv;
632
633 if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
634 my $h = {"seq" => seq($lastnext), "class" => class($lastnext),
635 "addr" => sprintf("%#x", $$lastnext)};
636 print fmt_line($h, $style{"terse"}[1], $level+1);
637 }
638 $lastnext = $op->next;
639 print concise_op($op, $level, $style{"terse"}[0]);
640}
641
c99ca59a
SM
642sub tree {
643 my $op = shift;
644 my $level = shift;
645 my $style = $tree_decorations[$tree_style];
646 my($space, $single, $kids, $kid, $nokid, $last, $lead, $size) = @$style;
647 my $name = concise_op($op, $level, $treefmt);
648 if (not $op->flags & OPf_KIDS) {
649 return $name . "\n";
650 }
651 my @lines;
652 for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
653 push @lines, tree($kid, $level+1);
654 }
655 my $i;
656 for ($i = $#lines; substr($lines[$i], 0, 1) eq " "; $i--) {
657 $lines[$i] = $space . $lines[$i];
658 }
659 if ($i > 0) {
660 $lines[$i] = $last . $lines[$i];
661 while ($i-- > 1) {
662 if (substr($lines[$i], 0, 1) eq " ") {
663 $lines[$i] = $nokid . $lines[$i];
664 } else {
665 $lines[$i] = $kid . $lines[$i];
666 }
667 }
668 $lines[$i] = $kids . $lines[$i];
669 } else {
670 $lines[0] = $single . $lines[0];
671 }
672 return("$name$lead" . shift @lines,
673 map(" " x (length($name)+$size) . $_, @lines));
674}
675
213a1a26
SM
676# *** Warning: fragile kludge ahead ***
677# Because the B::* modules run in the same interpreter as the code
678# they're compiling, their presence tends to distort the view we have
679# of the code we're looking at. In particular, perl gives sequence
680# numbers to both OPs in general and COPs in particular. If the
681# program we're looking at were run on its own, these numbers would
682# start at 1. Because all of B::Concise and all the modules it uses
683# are compiled first, though, by the time we get to the user's program
684# the sequence numbers are alreay at pretty high numbers, which would
685# be distracting if you're trying to tell OPs apart. Therefore we'd
686# like to subtract an offset from all the sequence numbers we display,
687# to restore the simpler view of the world. The trick is to know what
688# that offset will be, when we're still compiling B::Concise! If we
689# hardcoded a value, it would have to change every time B::Concise or
690# other modules we use do. To help a little, what we do here is
691# compile a little code at the end of the module, and compute the base
692# sequence number for the user's program as being a small offset
693# later, so all we have to worry about are changes in the offset.
c27ea44e
SM
694# (Note that we now only play this game with COP sequence numbers. OP
695# sequence numbers aren't used to refer to OPs from a distance, and
696# they don't have much significance, so we just generate our own
697# sequence numbers which are easier to control. This way we also don't
698# stand in the way of a possible future removal of OP sequence
699# numbers).
213a1a26
SM
700
701# When you say "perl -MO=Concise -e '$a'", the output should look like:
702
703# 4 <@> leave[t1] vKP/REFC ->(end)
704# 1 <0> enter ->2
705 #^ smallest OP sequence number should be 1
706# 2 <;> nextstate(main 1 -e:1) v ->3
707 # ^ smallest COP sequence number should be 1
708# - <1> ex-rv2sv vK/1 ->4
709# 3 <$> gvsv(*a) s ->4
710
c27ea44e
SM
711# If the second of the marked numbers there isn't 1, it means you need
712# to update the corresponding magic number in the next line.
713# Remember, this needs to stay the last things in the module.
e69a2255 714
c27ea44e 715# Why is this different for MacOS? Does it matter?
8ec8fbef 716my $cop_seq_mnum = $^O eq 'MacOS' ? 12 : 11;
e69a2255 717$cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum;
c99ca59a
SM
718
7191;
720
721__END__
722
723=head1 NAME
724
725B::Concise - Walk Perl syntax tree, printing concise info about ops
726
727=head1 SYNOPSIS
728
729 perl -MO=Concise[,OPTIONS] foo.pl
730
78ad9108
PJ
731 use B::Concise qw(set_style add_callback);
732
c99ca59a
SM
733=head1 DESCRIPTION
734
735This compiler backend prints the internal OPs of a Perl program's syntax
736tree in one of several space-efficient text formats suitable for debugging
737the inner workings of perl or other compiler backends. It can print OPs in
738the order they appear in the OP tree, in the order they will execute, or
739in a text approximation to their tree structure, and the format of the
740information displyed is customizable. Its function is similar to that of
741perl's B<-Dx> debugging flag or the B<B::Terse> module, but it is more
742sophisticated and flexible.
743
f8a679e6
RGS
744=head1 EXAMPLE
745
746Here's is a short example of output, using the default formatting
747conventions :
748
749 % perl -MO=Concise -e '$a = $b + 42'
8ec8fbef 750 8 <@> leave[1 ref] vKP/REFC ->(end)
f8a679e6
RGS
751 1 <0> enter ->2
752 2 <;> nextstate(main 1 -e:1) v ->3
753 7 <2> sassign vKS/2 ->8
754 5 <2> add[t1] sK/2 ->6
755 - <1> ex-rv2sv sK/1 ->4
756 3 <$> gvsv(*b) s ->4
757 4 <$> const(IV 42) s ->5
758 - <1> ex-rv2sv sKRM*/1 ->7
759 6 <$> gvsv(*a) s ->7
760
761Each line corresponds to an operator. Null ops appear as C<ex-opname>,
762where I<opname> is the op that has been optimized away by perl.
763
764The number on the first row indicates the op's sequence number. It's
765given in base 36 by default.
766
767The symbol between angle brackets indicates the op's type : for example,
768<2> is a BINOP, <@> a LISTOP, etc. (see L</"OP class abbreviations">).
769
770The opname may be followed by op-specific information in parentheses
771(e.g. C<gvsv(*b)>), and by targ information in brackets (e.g.
772C<leave[t1]>).
773
774Next come the op flags. The common flags are listed below
775(L</"OP flags abbreviations">). The private flags follow, separated
776by a slash. For example, C<vKP/REFC> means that the leave op has
777public flags OPf_WANT_VOID, OPf_KIDS, and OPf_PARENS, and the private
778flag OPpREFCOUNTED.
779
780Finally an arrow points to the sequence number of the next op.
781
c99ca59a
SM
782=head1 OPTIONS
783
784Arguments that don't start with a hyphen are taken to be the names of
8ec8fbef
SM
785subroutines to print the OPs of; if no such functions are specified,
786the main body of the program (outside any subroutines, and not
787including use'd or require'd files) is printed. Passing C<BEGIN>,
788C<CHECK>, C<INIT>, or C<END> will cause all of the corresponding
789special blocks to be printed.
c99ca59a
SM
790
791=over 4
792
793=item B<-basic>
794
795Print OPs in the order they appear in the OP tree (a preorder
796traversal, starting at the root). The indentation of each OP shows its
797level in the tree. This mode is the default, so the flag is included
798simply for completeness.
799
800=item B<-exec>
801
802Print OPs in the order they would normally execute (for the majority
803of constructs this is a postorder traversal of the tree, ending at the
804root). In most cases the OP that usually follows a given OP will
805appear directly below it; alternate paths are shown by indentation. In
806cases like loops when control jumps out of a linear path, a 'goto'
807line is generated.
808
809=item B<-tree>
810
811Print OPs in a text approximation of a tree, with the root of the tree
812at the left and 'left-to-right' order of children transformed into
813'top-to-bottom'. Because this mode grows both to the right and down,
814it isn't suitable for large programs (unless you have a very wide
815terminal).
816
817=item B<-compact>
818
819Use a tree format in which the minimum amount of space is used for the
820lines connecting nodes (one character in most cases). This squeezes out
821a few precious columns of screen real estate.
822
823=item B<-loose>
824
825Use a tree format that uses longer edges to separate OP nodes. This format
826tends to look better than the compact one, especially in ASCII, and is
827the default.
828
829=item B<-vt>
830
831Use tree connecting characters drawn from the VT100 line-drawing set.
832This looks better if your terminal supports it.
833
834=item B<-ascii>
835
836Draw the tree with standard ASCII characters like C<+> and C<|>. These don't
837look as clean as the VT100 characters, but they'll work with almost any
838terminal (or the horizontal scrolling mode of less(1)) and are suitable
839for text documentation or email. This is the default.
840
841=item B<-main>
842
843Include the main program in the output, even if subroutines were also
844specified.
845
846=item B<-base>I<n>
847
848Print OP sequence numbers in base I<n>. If I<n> is greater than 10, the
849digit for 11 will be 'a', and so on. If I<n> is greater than 36, the digit
850for 37 will be 'A', and so on until 62. Values greater than 62 are not
851currently supported. The default is 36.
852
853=item B<-bigendian>
854
855Print sequence numbers with the most significant digit first. This is the
856usual convention for Arabic numerals, and the default.
857
858=item B<-littleendian>
859
860Print seqence numbers with the least significant digit first.
861
862=item B<-concise>
863
864Use the author's favorite set of formatting conventions. This is the
865default, of course.
866
867=item B<-terse>
868
a6d05634 869Use formatting conventions that emulate the output of B<B::Terse>. The
c99ca59a
SM
870basic mode is almost indistinguishable from the real B<B::Terse>, and the
871exec mode looks very similar, but is in a more logical order and lacks
872curly brackets. B<B::Terse> doesn't have a tree mode, so the tree mode
873is only vaguely reminiscient of B<B::Terse>.
874
875=item B<-linenoise>
876
877Use formatting conventions in which the name of each OP, rather than being
878written out in full, is represented by a one- or two-character abbreviation.
879This is mainly a joke.
880
881=item B<-debug>
882
883Use formatting conventions reminiscient of B<B::Debug>; these aren't
884very concise at all.
885
886=item B<-env>
887
888Use formatting conventions read from the environment variables
889C<B_CONCISE_FORMAT>, C<B_CONCISE_GOTO_FORMAT>, and C<B_CONCISE_TREE_FORMAT>.
890
891=back
892
893=head1 FORMATTING SPECIFICATIONS
894
895For each general style ('concise', 'terse', 'linenoise', etc.) there are
896three specifications: one of how OPs should appear in the basic or exec
897modes, one of how 'goto' lines should appear (these occur in the exec
898mode only), and one of how nodes should appear in tree mode. Each has the
899same format, described below. Any text that doesn't match a special
900pattern is copied verbatim.
901
902=over 4
903
904=item B<(x(>I<exec_text>B<;>I<basic_text>B<)x)>
905
906Generates I<exec_text> in exec mode, or I<basic_text> in basic mode.
907
908=item B<(*(>I<text>B<)*)>
909
910Generates one copy of I<text> for each indentation level.
911
912=item B<(*(>I<text1>B<;>I<text2>B<)*)>
913
914Generates one fewer copies of I<text1> than the indentation level, followed
915by one copy of I<text2> if the indentation level is more than 0.
916
917=item B<(?(>I<text1>B<#>I<var>I<Text2>B<)?)>
918
919If the value of I<var> is true (not empty or zero), generates the
920value of I<var> surrounded by I<text1> and I<Text2>, otherwise
921nothing.
922
923=item B<#>I<var>
924
925Generates the value of the variable I<var>.
926
927=item B<#>I<var>I<N>
928
929Generates the value of I<var>, left jutified to fill I<N> spaces.
930
931=item B<~>
932
933Any number of tildes and surrounding whitespace will be collapsed to
934a single space.
935
936=back
937
938The following variables are recognized:
939
940=over 4
941
942=item B<#addr>
943
944The address of the OP, in hexidecimal.
945
946=item B<#arg>
947
948The OP-specific information of the OP (such as the SV for an SVOP, the
949non-local exit pointers for a LOOP, etc.) enclosed in paretheses.
950
951=item B<#class>
952
953The B-determined class of the OP, in all caps.
954
f8a679e6 955=item B<#classsym>
c99ca59a
SM
956
957A single symbol abbreviating the class of the OP.
958
c3caa09d
SM
959=item B<#coplabel>
960
961The label of the statement or block the OP is the start of, if any.
962
c99ca59a
SM
963=item B<#exname>
964
965The name of the OP, or 'ex-foo' if the OP is a null that used to be a foo.
966
967=item B<#extarg>
968
969The target of the OP, or nothing for a nulled OP.
970
971=item B<#firstaddr>
972
973The address of the OP's first child, in hexidecimal.
974
975=item B<#flags>
976
977The OP's flags, abbreviated as a series of symbols.
978
979=item B<#flagval>
980
981The numeric value of the OP's flags.
982
f8a679e6 983=item B<#hyphseq>
c99ca59a
SM
984
985The sequence number of the OP, or a hyphen if it doesn't have one.
986
987=item B<#label>
988
989'NEXT', 'LAST', or 'REDO' if the OP is a target of one of those in exec
990mode, or empty otherwise.
991
992=item B<#lastaddr>
993
994The address of the OP's last child, in hexidecimal.
995
996=item B<#name>
997
998The OP's name.
999
1000=item B<#NAME>
1001
1002The OP's name, in all caps.
1003
1004=item B<#next>
1005
1006The sequence number of the OP's next OP.
1007
1008=item B<#nextaddr>
1009
1010The address of the OP's next OP, in hexidecimal.
1011
1012=item B<#noise>
1013
c27ea44e 1014A one- or two-character abbreviation for the OP's name.
c99ca59a
SM
1015
1016=item B<#private>
1017
1018The OP's private flags, rendered with abbreviated names if possible.
1019
1020=item B<#privval>
1021
1022The numeric value of the OP's private flags.
1023
1024=item B<#seq>
1025
c27ea44e
SM
1026The sequence number of the OP. Note that this is now a sequence number
1027generated by B::Concise, rather than the real op_seq value (for which
1028see B<#seqnum>).
c99ca59a
SM
1029
1030=item B<#seqnum>
1031
1032The real sequence number of the OP, as a regular number and not adjusted
1033to be relative to the start of the real program. (This will generally be
1034a fairly large number because all of B<B::Concise> is compiled before
1035your program is).
1036
1037=item B<#sibaddr>
1038
1039The address of the OP's next youngest sibling, in hexidecimal.
1040
1041=item B<#svaddr>
1042
1043The address of the OP's SV, if it has an SV, in hexidecimal.
1044
1045=item B<#svclass>
1046
1047The class of the OP's SV, if it has one, in all caps (e.g., 'IV').
1048
1049=item B<#svval>
1050
1051The value of the OP's SV, if it has one, in a short human-readable format.
1052
1053=item B<#targ>
1054
1055The numeric value of the OP's targ.
1056
1057=item B<#targarg>
1058
1059The name of the variable the OP's targ refers to, if any, otherwise the
1060letter t followed by the OP's targ in decimal.
1061
1062=item B<#targarglife>
1063
1064Same as B<#targarg>, but followed by the COP sequence numbers that delimit
1065the variable's lifetime (or 'end' for a variable in an open scope) for a
1066variable.
1067
1068=item B<#typenum>
1069
1070The numeric value of the OP's type, in decimal.
1071
1072=back
1073
1074=head1 ABBREVIATIONS
1075
1076=head2 OP flags abbreviations
1077
1078 v OPf_WANT_VOID Want nothing (void context)
1079 s OPf_WANT_SCALAR Want single value (scalar context)
1080 l OPf_WANT_LIST Want list of any length (list context)
1081 K OPf_KIDS There is a firstborn child.
1082 P OPf_PARENS This operator was parenthesized.
1083 (Or block needs explicit scope entry.)
1084 R OPf_REF Certified reference.
1085 (Return container, not containee).
1086 M OPf_MOD Will modify (lvalue).
1087 S OPf_STACKED Some arg is arriving on the stack.
1088 * OPf_SPECIAL Do something weird for this op (see op.h)
1089
1090=head2 OP class abbreviations
1091
1092 0 OP (aka BASEOP) An OP with no children
1093 1 UNOP An OP with one child
1094 2 BINOP An OP with two children
1095 | LOGOP A control branch OP
1096 @ LISTOP An OP that could have lots of children
1097 / PMOP An OP with a regular expression
1098 $ SVOP An OP with an SV
1099 " PVOP An OP with a string
1100 { LOOP An OP that holds pointers for a loop
1101 ; COP An OP that marks the start of a statement
051f02e9 1102 # PADOP An OP with a GV on the pad
c99ca59a 1103
78ad9108
PJ
1104=head1 Using B::Concise outside of the O framework
1105
1106It is possible to extend B<B::Concise> by using it outside of the B<O>
1107framework and providing new styles and new variables.
1108
1109 use B::Concise qw(set_style add_callback);
1110 set_style($format, $gotofmt, $treefmt);
1111 add_callback
1112 (
1113 sub
1114 {
1115 my ($h, $op, $level, $format) = @_;
1116 $h->{variable} = some_func($op);
1117 }
1118 );
1119 B::Concise::compile(@options)->();
1120
1121You can specify a style by calling the B<set_style> subroutine. If you
1122have a new variable in your style, or you want to change the value of an
1123existing variable, you will need to add a callback to specify the value
1124for that variable.
1125
1126This is done by calling B<add_callback> passing references to any
1127callback subroutines. The subroutines are called in the same order as
1128they are added. Each subroutine is passed four parameters. These are a
1129reference to a hash, the keys of which are the names of the variables
1130and the values of which are their values, the op, the level and the
1131format.
1132
1133To define your own variables, simply add them to the hash, or change
1134existing values if you need to. The level and format are passed in as
1135references to scalars, but it is unlikely that they will need to be
1136changed or even used.
1137
31b49ad4
SM
1138To switch back to one of the standard styles like C<concise> or
1139C<terse>, use C<set_style_standard>.
1140
78ad9108
PJ
1141To see the output, call the subroutine returned by B<compile> in the
1142same way that B<O> does.
1143
c99ca59a
SM
1144=head1 AUTHOR
1145
31b49ad4 1146Stephen McCamant, E<lt>smcc@CSUA.Berkeley.EDUE<gt>.
c99ca59a
SM
1147
1148=cut