use Exporter (); # use #5
-our $VERSION = "0.61";
+our $VERSION = "0.62";
our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(set_style set_style_standard add_callback
- concise_subref concise_cv concise_main
- add_style walk_output);
+our @EXPORT_OK = qw( set_style set_style_standard add_callback
+ concise_subref concise_cv concise_main
+ add_style walk_output compile reset_sequence );
+our %EXPORT_TAGS =
+ ( io => [qw( walk_output compile reset_sequence )],
+ style => [qw( add_style set_style_standard )],
+ cb => [qw( add_callback )],
+ mech => [qw( concise_subref concise_cv concise_main )], );
# use #6
use B qw(class ppname main_start main_root main_cv cstring svref_2object
"#class pp_#name"],
"concise" =>
["#hyphseq2 (*( (x( ;)x))*)<#classsym> "
- . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x)\n",
- " (*( )*) goto #seq\n",
+ . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x)\n"
+ , " (*( )*) goto #seq\n",
"(?(<#seq>)?)#exname#arg(?([#targarglife])?)"],
"linenoise" =>
["(x(;(*( )*))x)#noise#arg(?([#targarg])?)(x( ;\n)x)",
my $big_endian = 1; # more <sequence#> display
my $tree_style = 0; # tree-order details
my $banner = 1; # print banner before optree is traversed
+my $do_main = 0; # force printing of main routine
-# another factor:
+# another factor: can affect all styles!
our @callbacks; # allow external management
set_style_standard("concise");
}
# output handle, used with all Concise-output printing
-our $walkHandle = \*STDOUT; # public for your convenience
+our $walkHandle; # public for your convenience
+BEGIN { $walkHandle = \*STDOUT }
sub walk_output { # updates $walkHandle
my $handle = shift;
+ return $walkHandle unless $handle; # allow use as accessor
+
if (ref $handle eq 'SCALAR') {
require Config;
die "no perlio in this build, can't call walk_output (\\\$scalar)\n"
# in 5.8+, open(FILEHANDLE,MODE,REFERENCE) writes to string
open my $tmp, '>', $handle; # but cant re-set existing STDOUT
$walkHandle = $tmp; # so use my $tmp as intermediate var
- return;
+ return $walkHandle;
}
- $walkHandle = $handle;
- my $iotype = ref $walkHandle;
+ my $iotype = ref $handle;
die "expecting argument/object that can print\n"
- unless $iotype eq 'GLOB' or $iotype and $walkHandle->can('print');
+ unless $iotype eq 'GLOB' or $iotype and $handle->can('print');
+ $walkHandle = $handle;
}
sub concise_subref {
my($order, $coderef) = @_;
my $codeobj = svref_2object($coderef);
- die "err: not a coderef: $coderef\n" unless ref $codeobj eq 'B::CV';#CODE';
+
+ return concise_stashref(@_)
+ unless ref $codeobj eq 'B::CV';
concise_cv_obj($order, $codeobj);
}
+sub concise_stashref {
+ my($order, $h) = @_;
+ foreach my $k (sort keys %$h) {
+ local *s = $h->{$k};
+ my $coderef = *s{CODE} or next;
+ reset_sequence();
+ print "FUNC: ", *s, "\n";
+ my $codeobj = svref_2object($coderef);
+ next unless ref $codeobj eq 'B::CV';
+ eval { concise_cv_obj($order, $codeobj) }
+ or warn "err $@ on $codeobj";
+ }
+}
+
# This should have been called concise_subref, but it was exported
# under this name in versions before 0.56
sub concise_cv { concise_subref(@_); }
[" ", map("$start_sym$_$end_sym", "q", "w", "t", "x", "m"), "", 0],
);
-sub compile {
+
+sub compileOpts {
+ # set rendering state from options and args
my @options = grep(/^-/, @_);
my @args = grep(!/^-/, @_);
- my $do_main = 0;
for my $o (@options) {
+ # mode/order
if ($o eq "-basic") {
$order = "basic";
} elsif ($o eq "-exec") {
$order = "exec";
} elsif ($o eq "-tree") {
$order = "tree";
- } elsif ($o eq "-compact") {
+ }
+ # tree-specific
+ elsif ($o eq "-compact") {
$tree_style |= 1;
} elsif ($o eq "-loose") {
$tree_style &= ~1;
$tree_style |= 2;
} elsif ($o eq "-ascii") {
$tree_style &= ~2;
- } elsif ($o eq "-main") {
- $do_main = 1;
- } elsif ($o =~ /^-base(\d+)$/) {
+ }
+ # sequence numbering
+ elsif ($o =~ /^-base(\d+)$/) {
$base = $1;
} elsif ($o eq "-bigendian") {
$big_endian = 1;
} elsif ($o eq "-littleendian") {
$big_endian = 0;
- } elsif ($o eq "-banner") {
+ }
+ elsif ($o eq "-nobanner") {
$banner = 0;
+ } elsif ($o eq "-banner") {
+ $banner = 1;
+ }
+ elsif ($o eq "-main") {
+ $do_main = 1;
+ } elsif ($o eq "-nomain") {
+ $do_main = 0;
}
+ # line-style options
elsif (exists $style{substr($o, 1)}) {
$stylename = substr($o, 1);
set_style_standard($stylename);
warn "Option $o unrecognized";
}
}
+ return (@args);
+}
+
+sub compile {
+ my (@args) = compileOpts(@_);
return sub {
- if (@args) {
- for my $objname (@args) {
- if ($objname eq "BEGIN") {
- concise_specials("BEGIN", $order,
- B::begin_av->isa("B::AV") ?
- B::begin_av->ARRAY : ());
- } elsif ($objname eq "INIT") {
- concise_specials("INIT", $order,
- B::init_av->isa("B::AV") ?
- B::init_av->ARRAY : ());
- } elsif ($objname eq "CHECK") {
- concise_specials("CHECK", $order,
- B::check_av->isa("B::AV") ?
- B::check_av->ARRAY : ());
- } elsif ($objname eq "END") {
- concise_specials("END", $order,
- B::end_av->isa("B::AV") ?
- B::end_av->ARRAY : ());
+ my @newargs = compileOpts(@_); # accept new rendering options
+ warn "disregarding non-options: @newargs\n" if @newargs;
+
+ for my $objname (@args) {
+
+ if ($objname eq "BEGIN") {
+ concise_specials("BEGIN", $order,
+ B::begin_av->isa("B::AV") ?
+ B::begin_av->ARRAY : ());
+ } elsif ($objname eq "INIT") {
+ concise_specials("INIT", $order,
+ B::init_av->isa("B::AV") ?
+ B::init_av->ARRAY : ());
+ } elsif ($objname eq "CHECK") {
+ concise_specials("CHECK", $order,
+ B::check_av->isa("B::AV") ?
+ B::check_av->ARRAY : ());
+ } elsif ($objname eq "END") {
+ concise_specials("END", $order,
+ B::end_av->isa("B::AV") ?
+ B::end_av->ARRAY : ());
+ }
+ else {
+ # convert function names to subrefs
+ my $objref;
+ if (ref $objname) {
+ print $walkHandle "B::Concise::compile($objname)\n"
+ if $banner;
+ $objref = $objname;
} else {
- # convert function names to subrefs
- my $objref;
- if (ref $objname) {
- print $walkHandle "B::Concise::compile($objname)\n"
- if $banner;
- $objref = $objname;
- } else {
- $objname = "main::" . $objname unless $objname =~ /::/;
- print $walkHandle "$objname:\n";
- no strict 'refs';
- die "err: unknown function ($objname)\n"
- unless *{$objname}{CODE};
- $objref = \&$objname;
- }
- concise_subref($order, $objref);
+ $objname = "main::" . $objname unless $objname =~ /::/;
+ print $walkHandle "$objname:\n";
+ no strict 'refs';
+ die "err: unknown function ($objname)\n"
+ unless *{$objname}{CODE};
+ $objref = \&$objname;
}
+ concise_subref($order, $objref);
}
}
if (!@args or $do_main) {
print $walkHandle "main program:\n" if $do_main;
concise_main($order);
}
+ return @args; # something
}
}
# reset the sequence
%sequence_num = ();
$seq_max = 1;
+ $lastnext = 0;
}
sub seq {
}
sub fmt_line { # generate text-line for op.
- my($hr, $text, $level) = @_;
+ my($hr, $op, $text, $level) = @_;
+
+ $_->($hr, $op, \$text, \$level, $stylename) for @callbacks;
+
return '' if $hr->{SKIP}; # suppress line if a callback said so
+ return '' if $hr->{goto} and $hr->{goto} eq '-'; # no goto nowhere
+ # spec: (?(text1#varText2)?)
$text =~ s/\(\?\(([^\#]*?)\#(\w+)([^\#]*?)\)\?\)/
$hr->{$2} ? $1.$hr->{$2}.$3 : ""/eg;
+ # spec: (x(exec_text;basic_text)x)
$text =~ s/\(x\((.*?);(.*?)\)x\)/$order eq "exec" ? $1 : $2/egs;
+
+ # spec: (*(text)*)
$text =~ s/\(\*\(([^;]*?)\)\*\)/$1 x $level/egs;
+
+ # spec: (*(text1;text2)*)
$text =~ s/\(\*\((.*?);(.*?)\)\*\)/$1 x ($level - 1) . $2 x ($level>0)/egs;
+
+ # convert #Var to tag=>val form: Var\t#var
+ $text =~ s/\#([A-Z][a-z]+)(\d+)?/\t\u$1\t\L#$1$2/gs;
+
+ # spec: #varN
$text =~ s/\#([a-zA-Z]+)(\d+)/sprintf("%-$2s", $hr->{$1})/eg;
- $text =~ s/\#([a-zA-Z]+)/$hr->{$1}/eg; # populate data into template
- $text =~ s/[ \t]*~+[ \t]*/ /g;
+ $text =~ s/\#([a-zA-Z]+)/$hr->{$1}/eg; # populate #var's
+ $text =~ s/[ \t]*~+[ \t]*/ /g; # squeeze tildes
chomp $text;
return "$text\n" if $text ne "";
return $text; # suppress empty lines
} elsif (class($sv) eq "HV") {
$hr->{svval} .= 'HASH';
}
- return $hr->{svclass} . " " . $hr->{svval};
+
+ $hr->{svval} = 'undef' unless defined $hr->{svval};
+ my $out = $hr->{svclass};
+ return $out .= " $hr->{svval}" ;
}
}
$h{typenum} = $op->type;
$h{noise} = $linenoise[$op->type];
- $_->(\%h, $op, \$format, \$level, $stylename) for @callbacks;
- return fmt_line(\%h, $format, $level);
+ return fmt_line(\%h, $op, $format, $level);
}
sub B::OP::concise {
my($op, $level) = @_;
if ($order eq "exec" and $lastnext and $$lastnext != $$op) {
# insert a 'goto' line
- my $h = {"seq" => seq($lastnext), "class" => class($lastnext),
- "addr" => sprintf("%#x", $$lastnext)};
- print $walkHandle fmt_line($h, $gotofmt, $level+1);
+ my $synth = {"seq" => seq($lastnext), "class" => class($lastnext),
+ "addr" => sprintf("%#x", $$lastnext),
+ "goto" => seq($lastnext), # simplify goto '-' removal
+ };
+ print $walkHandle fmt_line($synth, $op, $gotofmt, $level+1);
}
$lastnext = $op->next;
print $walkHandle concise_op($op, $level, $format);
# insert a 'goto'
my $h = {"seq" => seq($lastnext), "class" => class($lastnext),
"addr" => sprintf("%#x", $$lastnext)};
- print fmt_line($h, $style{"terse"}[1], $level+1);
+ print # $walkHandle
+ fmt_line($h, $op, $style{"terse"}[1], $level+1);
}
$lastnext = $op->next;
- print concise_op($op, $level, $style{"terse"}[0]);
+ print # $walkHandle
+ concise_op($op, $level, $style{"terse"}[0]);
}
sub tree {
=head2 Other options
+These are pairwise exclusive.
+
=over 4
=item B<-main>
Include the main program in the output, even if subroutines were also
-specified. This is the only option that is not sticky (see below)
+specified. This rendering is normally suppressed when a subroutine
+name or reference is given.
+
+=item B<-nomain>
+
+This restores the default behavior after you've changed it with '-main'
+(it's not normally needed). If no subroutine name/ref is given, main is
+rendered, regardless of this flag.
+
+=item B<-nobanner>
+
+Renderings usually include a banner line identifying the function name
+or stringified subref. This suppresses the printing of the banner.
+
+TBC: Remove the stringified coderef; while it provides a 'cookie' for
+each function rendered, the cookies used should be 1,2,3.. not a
+random hex-address. It also complicates string comparison of two
+different trees.
=item B<-banner>
-B::Concise::compile normally prints a banner line identifying the
-function name, or in case of a subref, a generic message including
-(unfortunately) the stringified coderef. This option suppresses the
-printing of the banner.
+restores default banner behavior.
+
+=item B<-banneris> => subref
+
+TBC: a hookpoint (and an option to set it) for a user-supplied
+function to produce a banner appropriate for users needs. It's not
+ideal, because the rendering-state variables, which are a natural
+candidate for use in concise.t, are unavailable to the user.
=back
the first call will be remembered for the 2nd call, unless you
re-specify or change them.
+=head1 ABBREVIATIONS
+
+The concise style uses symbols to convey maximum info with minimal
+clutter (like hex addresses). With just a little practice, you can
+start to see the flowers, not just the branches, in the trees.
+
+=head2 OP class abbreviations
+
+These symbols appear before the op-name, and indicate the
+B:: namespace that represents the ops in your Perl code.
+
+ 0 OP (aka BASEOP) An OP with no children
+ 1 UNOP An OP with one child
+ 2 BINOP An OP with two children
+ | LOGOP A control branch OP
+ @ LISTOP An OP that could have lots of children
+ / PMOP An OP with a regular expression
+ $ SVOP An OP with an SV
+ " PVOP An OP with a string
+ { LOOP An OP that holds pointers for a loop
+ ; COP An OP that marks the start of a statement
+ # PADOP An OP with a GV on the pad
+
+=head2 OP flags abbreviations
+
+These symbols represent various flags which alter behavior of the
+opcode, sometimes in opcode-specific ways.
+
+ v OPf_WANT_VOID Want nothing (void context)
+ s OPf_WANT_SCALAR Want single value (scalar context)
+ l OPf_WANT_LIST Want list of any length (list context)
+ K OPf_KIDS There is a firstborn child.
+ P OPf_PARENS This operator was parenthesized.
+ (Or block needs explicit scope entry.)
+ R OPf_REF Certified reference.
+ (Return container, not containee).
+ M OPf_MOD Will modify (lvalue).
+ S OPf_STACKED Some arg is arriving on the stack.
+ * OPf_SPECIAL Do something weird for this op (see op.h)
+
=head1 FORMATTING SPECIFICATIONS
For each line-style ('concise', 'terse', 'linenoise', etc.) there are
inserted to look like a closing curly brace. The tree-format is tree
specific.
-When a line is rendered, the correct format string is scanned for the
-following items, and data is substituted in, or other manipulations,
-like basic indenting. Any text that doesn't match a special pattern
-(the items below) is copied verbatim. (Yes, it's a set of s///g steps.)
+When a line is rendered, the correct format-spec is copied and scanned
+for the following items; data is substituted in, and other
+manipulations like basic indenting are done, for each opcode rendered.
+
+There are 3 kinds of items that may be populated; special patterns,
+#vars, and literal text, which is copied verbatim. (Yes, it's a set
+of s///g steps.)
+
+=head2 Special Patterns
+
+These items are the primitives used to perform indenting, and to
+select text from amongst alternatives.
=over 4
value of I<var> surrounded by I<text1> and I<Text2>, otherwise
nothing.
+=item B<~>
+
+Any number of tildes and surrounding whitespace will be collapsed to
+a single space.
+
+=back
+
+=head2 # Variables
+
+These #vars represent opcode properties that you may want as part of
+your rendering. The '#' is intended as a private sigil; a #var's
+value is interpolated into the style-line, much like "read $this".
+
+These vars take 3 forms:
+
+=over 4
+
=item B<#>I<var>
-Generates the value of the variable I<var>.
+A property named 'var' is assumed to exist for the opcodes, and is
+interpolated into the rendering.
=item B<#>I<var>I<N>
-Generates the value of I<var>, left jutified to fill I<N> spaces.
+Generates the value of I<var>, left justified to fill I<N> spaces.
+Note that this means while you can have properties 'foo' and 'foo2',
+you cannot render 'foo2', but you could with 'foo2a'. You would be
+wise not to rely on this behavior going forward ;-)
-=item B<~>
+=item B<#>I<Var>
-Any number of tildes and surrounding whitespace will be collapsed to
-a single space.
+This ucfirst form of #var generates a tag-value form of itself for
+display; it converts '#Var' into a 'Var => #var' style, which is then
+handled as described above. (Imp-note: #Vars cannot be used for
+conditional-fills, because the => #var transform is done after the check
+for #Var's value).
=back
-The following variables are recognized:
+The following variables are 'defined' by B::Concise; when they are
+used in a style, their respective values are plugged into the
+rendering of each opcode.
+
+Only some of these are used by the standard styles, the others are
+provided for you to delve into optree mechanics, should you wish to
+add a new style (see L</add_style> below) that uses them. You can
+also add new ones using L<add_callback>.
=over 4
=item B<#addr>
-The address of the OP, in hexidecimal.
+The address of the OP, in hexadecimal.
=item B<#arg>
The OP-specific information of the OP (such as the SV for an SVOP, the
-non-local exit pointers for a LOOP, etc.) enclosed in paretheses.
+non-local exit pointers for a LOOP, etc.) enclosed in parentheses.
=item B<#class>
=back
-=head1 ABBREVIATIONS
-
-=head2 OP flags abbreviations
-
- v OPf_WANT_VOID Want nothing (void context)
- s OPf_WANT_SCALAR Want single value (scalar context)
- l OPf_WANT_LIST Want list of any length (list context)
- K OPf_KIDS There is a firstborn child.
- P OPf_PARENS This operator was parenthesized.
- (Or block needs explicit scope entry.)
- R OPf_REF Certified reference.
- (Return container, not containee).
- M OPf_MOD Will modify (lvalue).
- S OPf_STACKED Some arg is arriving on the stack.
- * OPf_SPECIAL Do something weird for this op (see op.h)
-
-=head2 OP class abbreviations
-
- 0 OP (aka BASEOP) An OP with no children
- 1 UNOP An OP with one child
- 2 BINOP An OP with two children
- | LOGOP A control branch OP
- @ LISTOP An OP that could have lots of children
- / PMOP An OP with a regular expression
- $ SVOP An OP with an SV
- " PVOP An OP with a string
- { LOOP An OP that holds pointers for a loop
- ; COP An OP that marks the start of a statement
- # PADOP An OP with a GV on the pad
-
=head1 Using B::Concise outside of the O framework
-You can use B<B::Concise>, and call compile() directly, and
+The common (and original) usage of B::Concise was for command-line
+renderings of simple code, as given in EXAMPLE. But you can also use
+B<B::Concise> from your code, and call compile() directly, and
repeatedly. By doing so, you can avoid the compile-time only
-operation of 'perl -MO=Concise ..'. For example, you can use the
-debugger to step through B::Concise::compile() itself.
+operation of O.pm, and even use the debugger to step through
+B::Concise::compile() itself.
-When doing so, you can alter Concise output by providing new output
-styles, and optionally by adding callback routines which populate new
-variables that may be rendered as part of those styles. For all
-following sections, please review L</FORMATTING SPECIFICATIONS>.
+Once you're doing this, you may alter Concise output by adding new
+rendering styles, and by optionally adding callback routines which
+populate new variables, if such were referenced from those (just
+added) styles.
=head2 Example: Altering Concise Renderings
use B::Concise qw(set_style add_callback);
- set_style($your_format, $your_gotofmt, $your_treefmt);
+ add_style($yourStyleName => $defaultfmt, $gotofmt, $treefmt);
add_callback
( sub {
my ($h, $op, $format, $level, $stylename) = @_;
$h->{variable} = some_func($op);
- }
- );
- B::Concise::compile(@options)->();
+ });
+ $walker = B::Concise::compile(@options,@subnames,@subrefs);
+ $walker->();
=head2 set_style()
B<compile> accepts options as described above in L</OPTIONS>, and
arguments, which are either coderefs, or subroutine names.
-compile() constructs and returns a coderef, which when invoked, scans
-the optree, and prints the results to STDOUT. Once you have the
-coderef, you may change the output style; thereafter the coderef renders
-in the new style.
+It constructs and returns a $treewalker coderef, which when invoked,
+traverses, or walks, and renders the optrees of the given arguments to
+STDOUT. You can reuse this, and can change the rendering style used
+each time; thereafter the coderef renders in the new style.
B<walk_output> lets you change the print destination from STDOUT to
another open filehandle, or (unless you've built with -Uuseperlio)
into a string passed as a ref.
+ my $walker = B::Concise::compile('-terse','aFuncName', \&aSubRef); # 1
walk_output(\my $buf);
- my $walker = B::Concise::compile('-concise','funcName', \&aSubRef);
- print "Concise Banner for Functions: $buf\n";
- $walker->();
- print "Concise Rendering(s)?: $buf\n";
-
-For each subroutine visited by Concise, the $buf will contain a
-banner naming the function or coderef about to be traversed.
-Once $walker is invoked, it prints the actual renderings for each.
-
-To switch back to one of the standard styles like C<concise> or
-C<terse>, call C<set_style_standard>, or pass the style name into
-B::Concise::compile() (as done above).
+ $walker->(); # 1 renders -terse
+ set_style_standard('concise'); # 2
+ $walker->(); # 2 renders -concise
+ $walker->(@new); # 3 renders whatever
+ print "3 different renderings: terse, concise, and @new: $buf\n";
+
+When $walker is called, it traverses the subroutines supplied when it
+was created, and renders them using the current style. You can change
+the style afterwards in several different ways:
+
+ 1. call C<compile>, altering style or mode/order
+ 2. call C<set_style_standard>
+ 3. call $walker, passing @new options
+
+Passing new options to the $walker is the easiest way to change
+amongst any pre-defined styles (the ones you add are automatically
+recognized as options), and is the only way to alter rendering order
+without calling compile again. Note however that rendering state is
+still shared amongst multiple $walker objects, so they must still be
+used in a coordinated manner.
=head2 B::Concise::reset_sequence()
projects / p5sagit/p5-mst-13.2.git / blobdiff