unsupported
  0   ˆl–Ãa¾”êh¥8 ]¸î•1hßÁ„mñ>×_‹uÐb&=LV[(ÁÀ ?÷     package B::Concise;
# Copyright (C) 2000-2003 Stephen McCamant. All rights reserved.
# This program is free software; you can redistribute and/or modify it
# under the same terms as Perl itself.

# Note: we need to keep track of how many use declarations/BEGIN
# blocks this module uses, so we can avoid printing them when user
# asks for the BEGIN blocks in her program. Update the comments and
# the count in concise_specials if you add or delete one. The
# -MO=Concise counts as use #1.

use strict; # use #2
use warnings; # uses #3 and #4, since warnings uses Carp

use Exporter (); # use #5

our $VERSION   = "0.89";
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 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
	 SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL
	 CVf_ANON PAD_FAKELEX_ANON PAD_FAKELEX_MULTI SVf_ROK);

my %style =
  ("terse" =>
   ["(?(#label =>\n)?)(*(    )*)#class (#addr) #name (?([#targ])?) "
    . "#svclass~(?((#svaddr))?)~#svval~(?(label \"#coplabel\")?)\n",
    "(*(    )*)goto #class (#addr)\n",
    "#class pp_#name"],
   "concise" =>
   ["#hyphseq2 (*(   (x( ;)x))*)<#classsym> #exname#arg(?([#targarglife])?)"
    . "~#flags(?(/#private)?)(?(:#hints)?)(x(;~->#next)x)\n"
    , "  (*(    )*)     goto #seq\n",
    "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"],
   "linenoise" =>
   ["(x(;(*( )*))x)#noise#arg(?([#targarg])?)(x( ;\n)x)",
    "gt_#seq ",
    "(?(#seq)?)#noise#arg(?([#targarg])?)"],
   "debug" =>
   ["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t"
    . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n" .
    ($] > 5.009 ? '' : "\top_seq\t\t#seqnum\n")
    . "\top_flags\t#flagval\n\top_private\t#privval\t#hintsval\n"
    . "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)"
    . "(?(\top_sv\t\t#svaddr\n)?)",
    "    GOTO #addr\n",
    "#addr"],
   "env" => [$ENV{B_CONCISE_FORMAT}, $ENV{B_CONCISE_GOTO_FORMAT},
	     $ENV{B_CONCISE_TREE_FORMAT}],
  );

# Renderings, ie how Concise prints, is controlled by these vars
# primary:
our $stylename;		# selects current style from %style
my $order = "basic";	# how optree is walked & printed: basic, exec, tree

# rendering mechanics:
# these 'formats' are the line-rendering templates
# they're updated from %style when $stylename changes
my ($format, $gotofmt, $treefmt);

# lesser players:
my $base = 36;		# how <sequence#> is displayed
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
my $show_src;		# show source code

# another factor: can affect all styles!
our @callbacks;		# allow external management

set_style_standard("concise");

my $curcv;
my $cop_seq_base;

sub set_style {
    ($format, $gotofmt, $treefmt) = @_;
    #warn "set_style: deprecated, use set_style_standard instead\n"; # someday
    die "expecting 3 style-format args\n" unless @_ == 3;
}

sub add_style {
    my ($newstyle,@args) = @_;
    die "style '$newstyle' already exists, choose a new name\n"
	if exists $style{$newstyle};
    die "expecting 3 style-format args\n" unless @args == 3;
    $style{$newstyle} = [@args];
    $stylename = $newstyle; # update rendering state
}

sub set_style_standard {
    ($stylename) = @_; # update rendering state
    die "err: style '$stylename' unknown\n" unless exists $style{$stylename};
    set_style(@{$style{$stylename}});
}

sub add_callback {
    push @callbacks, @_;
}

# output handle, used with all Concise-output printing
our $walkHandle;	# public for your convenience