#!/usr/local/bin/perl

# The start of a gimme5 replacement based on STD parsing.
#
use strict;
use 5.010;
use warnings;

use STD;
use utf8;
use YAML::XS; # An attempt to replace this with YAML::Syck passed the
              # tests but produced a different output format that
              # confused some calling programs.  For example, anchors
              # are usually numbers ascending from 1, and they became
              # disjoint sets of descending numbers.  Also, empty
              # sequences shown as [] became followed by an empty line.
              # See also: YAML::Syck in package VAST::package_def below.
use Encode;

my $OPT_match = 0;
my $OPT_log = 0;
my $OPT_stab = 0;
my $PROG = '';
my @did_ws;

my @context;

sub USAGE {
    print <<'END';
viv [switches] filename
    where switches can be:
    	-e	use following argument as program
    	--ast	spit out an abstract syntax tree (default)
    	--p5	spit out a Perl 5 representation (partially impl)
    	--p6	spit out a Perl 6 representation
    	--stab	include the symbol table
    	--pos	include position info in AST
    	--match	include match tree info in AST
    	--log	emit debugging info to standard error
END
    exit;
}

use Actions;

sub MAIN {
    my $output = 'ast';

    USAGE() unless @_;
    while (@_) {
	last unless $_[0] =~ /^-/;
	my $switch = shift @_;
	if ($switch eq '--eval' or $switch eq '-e') {
	    $PROG .= Encode::decode_utf8(shift(@_)) . "\n";
	}
	elsif ($switch eq '--ast' or $switch eq '-a') {
	    $output = 'ast';
	}
	elsif ($switch eq '--p5' or $switch eq '-5') {
	    $output = 'p5';
	}
	elsif ($switch eq '--p6' or $switch eq '-6') {
	    $output = 'p6';
	}
	elsif ($switch eq '--stab' or $switch eq '-s') {
	    $OPT_stab = 1;
	}
	elsif ($switch eq '--log' or $switch eq '-l') {
	    $OPT_log = 1;
	}
	elsif ($switch eq '--pos' or $switch eq '-p') {
	    # obsolete, ignored
	}
	elsif ($switch eq '--match' or $switch eq '-m') {
	    $OPT_match = 1;	# attach match object
	}
	elsif ($switch eq '--help') {
	    USAGE();
	}
    }
#    USAGE() unless -r $_[0];
    my $r;
    if (@_ and -f $_[0]) {
	$r = STD->parsefile($_[0], actions => 'Actions')->{'_ast'};
    }
    else {
	if (not $PROG) {
	    local $/;
	    @ARGV = @_;
	    $PROG = <>;
	}
	$r = STD->parse($PROG, actions => 'Actions')->{'_ast'};
    }
    $::ORIG =~ s/\n;\z//;
    if ($OPT_stab) {
        no warnings;
        $r->{stabs} = $STD::ALL;
    }
    if ($output eq 'ast') {
	my $x = Dump($r);
#	$x =~ s/\n.*: \[\]$//mg;
	print $x;
    }
    elsif ($output eq 'p6') {
	say $r->ret(0,$r->emit_p6(0));
    }
    elsif ($output eq 'p5') {
	print fixpod($r->ret(0,$r->emit_p5(0)));
    }
    else {
	die "Unknown output mode";
    }
}

 
# viv should likely be abstracted into a module instead of doing this hack... - pmurias
sub VIV::SET_OPT {
    my %opt = @_;
    $OPT_match = $opt{match};
    $OPT_log = $opt{log};
}

sub fixpod {
    my $text = shift;
    return $text unless $text =~ /\n/;
    my @text = split(/^/, $text);
    my $in_begin = 0;
    my $in_for = 0;
    for (@text) {
	$in_begin = $1 if /^=begin\s+(\w+)/;
	$in_for = 1 if /^=for/;
	$in_for = 0 if /^\s*$/;
	my $docomment = $in_begin || $in_for;
	$in_begin = 0 if /^=end\s+(\w+)/ and $1 eq $in_begin;
	s/^/# / if $docomment;
    }
    join('', @text);
}

sub indent {
    my $x = shift || '';
    my $i = shift || 1;
    my $s = '    ' x $i;
    $x =~ s/^/$s/mg;
    $x;
}

###################################################################

{ package VAST::Base;

    sub ret { my $self = shift;
	my $lvl = shift;
	my $val = join '', @_;
	my @c = map { ref $_ } @context;
	my $c = "@c " . ref($self);
	$c =~ s/VAST:://g;
	print STDERR ' ' x ($lvl-1), "$c returns $val\n" if $OPT_log;
	wantarray ? @_ : $val;
    }

    sub Str { my $self = shift;
	my $b = $self->{BEG};
	my $e = $self->{END};
	return '' if $b > length($::ORIG);
	substr($::ORIG, $b, $e - $b);
    }

    sub emit_p6 { my $self = shift;
	my $lvl = shift;
	my $text = '';
	say ' ' x $lvl, ref $self, " in Base from ",$self->{BEG}," to ",$self->{END} if $OPT_log;
	if (exists $self->{'.'}) {
	    my $last = $self->{BEG};
	    my $all = $self->{'.'};
	    my @kids;
	    for my $kid (ref($all) eq 'ARRAY' ? @$all : $all) {
		next unless $kid;
		if (not defined $kid->{BEG}) {
		    $kid->{BEG} = $kid->{_from} // next;
		    $kid->{END} = $kid->{_pos};
		}
		push @kids, $kid;
	    }
	    for my $kid (sort { $a->{BEG} <=> $b->{BEG} } @kids) {
		my $kb = $kid->{BEG};
		if ($kb > $last) {
		    $text .= substr($::ORIG, $last, $kb - $last);
		}
		if (ref($kid) =~ /STD/) {
		    print STDERR ::Dump($self);
		}
		my $new = $kid->emit_p6($lvl+1);
		substr($new,0,$last-$kb,'') if $kb < $last;
		$text .= $new;
		$last = $kid->{END};

	    }
	    my $se = $self->{END};
	    if ($se > $last) {
		    $text .= substr($::ORIG, $last, $se - $last);
	    }
	    return $self->ret($lvl,$text);
	}
	else {
	    my $text = $self->{TEXT};
	    return $self->ret($lvl,$text);
	}
    }

    sub emit_p5 { my $self = shift; my $lvl = shift;
	my @text;
	say ' ' x $lvl, ref $self, " in Base from ",$self->{BEG}," to ",$self->{END} if $OPT_log;
	$context[$lvl] = $self;
	# print STDERR "HERE " . ref($self) . "\n";
	if (exists $self->{'.'}) {
	    my $last = $self->{BEG};
	    my $all = $self->{'.'};
	    my @kids;
	    for my $kid (ref($all) eq 'ARRAY' ? @$all : $all) {
		next unless $kid;
		if (not defined $kid->{BEG}) {
		    $kid->{BEG} = $kid->{_from} // next;
		    $kid->{END} = $kid->{_pos};
		}
		push @kids, $kid;
	    }
	    for my $kid (sort { $a->{BEG} <=> $b->{BEG} } @kids) {
		my $kb = $kid->{BEG};
		if ($kb > $last) {
		    push @text, substr($::ORIG, $last, $kb - $last);
		}
		if (ref($kid) eq 'HASH') {
		    print STDERR ::Dump($self);
		}
		push @text, scalar $kid->emit_p5($lvl+1);
		$last = $kid->{END};

	    }
	    my $se = $self->{END};
	    if ($se > $last) {
		    push @text, substr($::ORIG, $last, $se - $last);
	    }
	}
	else {
	    # print STDERR "OOPS " . ref($self) . " $$self{TEXT}\n";
	    push @text, $self->{TEXT};
	}
	splice(@context,$lvl);
	$self->ret($lvl,@text);
    }

    sub gap { my $self = shift;
	my $after = shift;
	my $beg = $self->{END};
	my $end = $after->{BEG};
	return '' unless $beg && $end;
	return substr($::ORIG, $beg, $end - $beg);
    }

}

{ package VAST::Str; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	return $self->{TEXT};
    }
    sub emit_p6 {  my $self = shift; my $lvl = shift;
	return $self->{TEXT};
    }

}

{ package VAST::Additive; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	my @t = $self->SUPER::emit_p5($lvl+1);
	if ($t[0] eq '*') {	# *-1
	    $t[0] = '';
	}
	$self->ret($lvl,@t);
    }
}

{ package VAST::Adverb; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	my @t = $self->SUPER::emit_p5($lvl+1);
	my $adv = pop @t;
	if ($adv eq ':delete' or $adv eq ':exists') {
	    $adv =~ s/^://;
	    unshift(@t, $adv . ' ');
	    $t[-1] =~ s/\s+$//;
	}
	$self->ret($lvl,@t);
    }
}

{ package VAST::apostrophe; our @ISA = 'VAST::Base';
}


{ package VAST::arglist; our @ISA = 'VAST::Base';
}


{ package VAST::args; our @ISA = 'VAST::Base';
}


{ package VAST::assertion; our @ISA = 'VAST::Base';
}


{ package VAST::assertion__S_Bang; our @ISA = 'VAST::Base';
}


{ package VAST::assertion__S_Bra; our @ISA = 'VAST::Base';
}


{ package VAST::assertion__S_Cur_Ly; our @ISA = 'VAST::Base';
}


{ package VAST::assertion__S_DotDotDot; our @ISA = 'VAST::Base';
}


{ package VAST::assertion__S_method; our @ISA = 'VAST::Base';
}


{ package VAST::assertion__S_name; our @ISA = 'VAST::Base';
}


{ package VAST::assertion__S_Question; our @ISA = 'VAST::Base';
}


{ package VAST::atom; our @ISA = 'VAST::Base';
}


{ package VAST::Autoincrement; our @ISA = 'VAST::Base';
}


{ package VAST::babble; our @ISA = 'VAST::Base';
}


{ package VAST::backslash; our @ISA = 'VAST::Base';
}


{ package VAST::backslash__S_Back; our @ISA = 'VAST::Base';
}


{ package VAST::backslash__S_d; our @ISA = 'VAST::Base';
}


{ package VAST::backslash__S_h; our @ISA = 'VAST::Base';
}


{ package VAST::backslash__S_misc; our @ISA = 'VAST::Base';
}


{ package VAST::backslash__S_n; our @ISA = 'VAST::Base';
}


{ package VAST::backslash__S_s; our @ISA = 'VAST::Base';
}


{ package VAST::backslash__S_stopper; our @ISA = 'VAST::Base';
}


{ package VAST::backslash__S_t; our @ISA = 'VAST::Base';
}


{ package VAST::backslash__S_v; our @ISA = 'VAST::Base';
}


{ package VAST::backslash__S_w; our @ISA = 'VAST::Base';
}


{ package VAST::backslash__S_x; our @ISA = 'VAST::Base';
}


{ package VAST::before; our @ISA = 'VAST::Base';
}


{ package VAST::block; our @ISA = 'VAST::Base';
}


{ package VAST::blockoid; our @ISA = 'VAST::Base';
}


{ package VAST::capterm; our @ISA = 'VAST::Base';
}


{ package VAST::cclass_elem; our @ISA = 'VAST::Base';
}


{ package VAST::Chaining; our @ISA = 'VAST::Base';
}


{ package VAST::circumfix; our @ISA = 'VAST::Base';
}


{ package VAST::circumfix__S_Bra_Ket; our @ISA = 'VAST::Base';
}


{ package VAST::circumfix__S_Cur_Ly; our @ISA = 'VAST::Base';
}


{ package VAST::circumfix__S_Paren_Thesis; our @ISA = 'VAST::Base';
}


{ package VAST::circumfix__S_sigil; our @ISA = 'VAST::Base';
}


{ package VAST::codeblock; our @ISA = 'VAST::Base';
}


{ package VAST::colonpair; our @ISA = 'VAST::Base';
}


{ package VAST::Comma; our @ISA = 'VAST::Base';
}



{ package VAST::comp_unit; our @ISA = 'VAST::Base';
    sub emit_p5 { my $self = shift; my $lvl = shift;
	$context[$lvl] = $self;
	my $r = $self->ret($lvl,$self->{statementlist}->emit_p5($lvl+1));
	splice(@context,$lvl);
	$r .= "\n";
    }
    sub emit_p6 { my $self = shift;
	my $lvl = shift;
	$self->ret($lvl,substr($::ORIG, 0, $self->{statementlist}{BEG}) . $self->{statementlist}->emit_p6($lvl+1));
    }

}

{ package VAST::Concatenation; our @ISA = 'VAST::Base';
}


{ package VAST::Conditional; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	for (@t) {
	    s/\?\?/?/;
	    s/!!/:/;
        }
        $self->ret($lvl,@t);
    }
}


{ package VAST::CORE; our @ISA = 'VAST::Base';
}


{ package VAST::declarator; our @ISA = 'VAST::Base';
}


{ package VAST::default_value; our @ISA = 'VAST::Base';
}


{ package VAST::deflongname; our @ISA = 'VAST::Base';
}


{ package VAST::def_module_name; our @ISA = 'VAST::Base';
}


{ package VAST::desigilname; our @ISA = 'VAST::Base';
}


{ package VAST::dotty; our @ISA = 'VAST::Base';
}


{ package VAST::dotty__S_Dot; our @ISA = 'VAST::Methodcall';
}


{ package VAST::SYM_dotty__S_Dot; our @ISA = 'VAST::Base';
}


{ package VAST::dottyop; our @ISA = 'VAST::Base';
}


{ package VAST::eat_terminator; our @ISA = 'VAST::Base';
}


{ package VAST::escape; our @ISA = 'VAST::Base';
}


{ package VAST::escape__S_At; our @ISA = 'VAST::Base';
}


{ package VAST::escape__S_Back; our @ISA = 'VAST::Base';
}


{ package VAST::escape__S_Dollar; our @ISA = 'VAST::Base';
}


{ package VAST::EXPR; our @ISA = 'VAST::Base';
}


{ package VAST::fatarrow; our @ISA = 'VAST::Base';
}


{ package VAST::fulltypename; our @ISA = 'VAST::Base';
}


{ package VAST::hexint; our @ISA = 'VAST::Base';
}


{ package VAST::ident; our @ISA = 'VAST::Base';
}


{ package VAST::identifier; our @ISA = 'VAST::Base';
}


{ package VAST::index; our @ISA = 'VAST::Base';
}



{ package VAST::infix; our @ISA = 'VAST::Base';
}

{ package VAST::SYM_infix__S_ColonEqual; our @ISA = 'VAST::Item_assignment';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = '=';	# XXX oversimplified
        $self->ret($lvl,@t);
    }
}

{ package VAST::SYM_infix__S_ColonColonEqual; our @ISA = 'VAST::Item_assignment';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = '=';	# XXX oversimplified
        $self->ret($lvl,@t);
    }
}


{ package VAST::infixish; our @ISA = 'VAST::Base';
}


{ package VAST::SYM_infix__S_PlusAmp; our @ISA = 'VAST::Multiplicative';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = '&';
        $self->ret($lvl,@t);
    }
}

{ package VAST::SYM_infix__S_PlusVert; our @ISA = 'VAST::Additive';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = '|';
        $self->ret($lvl,@t);
    }
}


{ package VAST::SYM_infix__S_Tilde; our @ISA = 'VAST::Concatenation';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = '.';
        $self->ret($lvl,@t);
    }
}


{ package VAST::SYM_infix__S_TildeTilde; our @ISA = 'VAST::Chaining';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = '=~';
        $self->ret($lvl,@t);
    }
}

{ package VAST::SYM_infix__S_TildeVert; our @ISA = 'VAST::Additive';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = '|';
        $self->ret($lvl,@t);
    }
}


{ package VAST::integer; our @ISA = 'VAST::Base';
}


{ package VAST::Item_assignment; our @ISA = 'VAST::Base';
}


{ package VAST::Junctive_or; our @ISA = 'VAST::Base';
}


{ package VAST::label; our @ISA = 'VAST::Base';
}


{ package VAST::lambda; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = 'sub';
        $self->ret($lvl,@t);
    }
}


{ package VAST::left; our @ISA = 'VAST::Base';
}


{ package VAST::List_assignment; our @ISA = 'VAST::Base';
}


{ package VAST::litchar; our @ISA = 'VAST::Base';
}


{ package VAST::longname; our @ISA = 'VAST::Base';
}


{ package VAST::Loose_and; our @ISA = 'VAST::Base';
}


{ package VAST::Loose_or; our @ISA = 'VAST::Base';
}


{ package VAST::Loose_unary; our @ISA = 'VAST::Base';
}


{ package VAST::metachar; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_Back; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_Bra_Ket; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_Caret; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_CaretCaret; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_ColonColon; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_ColonColonColon; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_Cur_Ly; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_Dollar; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_DollarDollar; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_Dot; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_Double_Double; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_Lt_Gt; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_mod; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_Nch; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_Paren_Thesis; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_qw; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_sigwhite; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_Single_Single; our @ISA = 'VAST::Base';
}


{ package VAST::metachar__S_var; our @ISA = 'VAST::Base';
}


{ package VAST::Methodcall; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	my @t = $self->SUPER::emit_p5($lvl+1);
	if (@t > 2) {
	    my $first = shift @t;
	    my $second = join '', @t;
	    @t = ($first,$second);
	}
	if ($t[1] eq '.pos') { $t[1] = '.<_pos>'; }
	$t[1] =~ s/^(\.?)<(.*)>$/$1\{'$2'\}/;
	if ($t[0] =~ /^[@%]/) {
	    if ($t[1] =~ s/^\.?([[{])/$1/) {
		if ($t[1] =~ /,/) {
		    substr($t[0],0,1) = '@';
		}
		else {
		    substr($t[0],0,1) = '$';
		}

	    }
	}
	elsif ($t[0] =~ /^\$\w+$/) {
	    $t[1] =~ s/^([[{])/.$1/;
	}
	elsif ($t[0] =~ s/^&(\w+)/\$$1/) {
	    $t[1] =~ s/^\(/->(/;
	}
	$t[1] =~ s/^\./->/;
	my $t = join('', @t);
	$t =~ s/^(.*\S)\s*:(delete|exists)/$2 $1/;
#	print STDERR ::Dump(\@t);
	$self->ret($lvl,$t);
    }
}


{ package VAST::method_def; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @b = $self->SUPER::emit_p5($lvl+1);
	my @e = '';
	while (@b) {
	    my $t = pop(@b);
	    if ($t =~ s/^\{//) {
		$t = " {\n    my \$self = shift;\n" . pop(@b) . $t;
		unshift(@e,$t);
		last;
	    }
	    unshift(@e,$t);
	}
        $self->ret($lvl,@b,@e);
    }
}


{ package VAST::methodop; our @ISA = 'VAST::Base';
}


{ package VAST::modifier_expr; our @ISA = 'VAST::Base';
}


{ package VAST::mod_internal; our @ISA = 'VAST::Base';
}


{ package VAST::mod_internal__S_adv; our @ISA = 'VAST::Base';
}


{ package VAST::mod_internal__S_ColonBangs; our @ISA = 'VAST::Base';
}


{ package VAST::mod_internal__S_Coloni; our @ISA = 'VAST::Base';
}


{ package VAST::mod_internal__S_Colonmy; our @ISA = 'VAST::Base';
}


{ package VAST::mod_internal__S_Colons; our @ISA = 'VAST::Base';
}


{ package VAST::module_name; our @ISA = 'VAST::Base';
}


{ package VAST::module_name__S_normal; our @ISA = 'VAST::Base';
}


{ package VAST::morename; our @ISA = 'VAST::Base';
}


{ package VAST::multi_declarator; our @ISA = 'VAST::Base';
}


{ package VAST::multi_declarator__S_multi; our @ISA = 'VAST::Base';
}


{ package VAST::multi_declarator__S_null; our @ISA = 'VAST::Base';
}


{ package VAST::multi_declarator__S_proto; our @ISA = 'VAST::Base';
}


{ package VAST::Multiplicative; our @ISA = 'VAST::Base';
}


{ package VAST::multisig; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	pop(@t);shift(@t);
        $self->ret($lvl,@t);
    }
}


{ package VAST::name; our @ISA = 'VAST::Base';
}


{ package VAST::named_param; our @ISA = 'VAST::Base';
}


{ package VAST::Named_unary; our @ISA = 'VAST::Base';
}


{ package VAST::nibbler; our @ISA = 'VAST::Base';
}


{ package VAST::nofun; our @ISA = 'VAST::Base';
}


{ package VAST::normspace; our @ISA = 'VAST::Base';
}



{ package VAST::nulltermish; our @ISA = 'VAST::Base';
}


{ package VAST::number; our @ISA = 'VAST::Base';
}


{ package VAST::number__S_numish; our @ISA = 'VAST::Base';
}


{ package VAST::numish; our @ISA = 'VAST::Base';
}


{ package VAST::opener; our @ISA = 'VAST::Base';
}


{ package VAST::package_declarator; our @ISA = 'VAST::Base';
}


{ package VAST::package_declarator__S_class; our @ISA = 'VAST::package_declarator';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] =~ s/\S.*//s;
        $self->ret($lvl,@t);
    }
}


{ package VAST::package_declarator__S_grammar; our @ISA = 'VAST::package_declarator';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] =~ s/\S.*//s;
        $self->ret($lvl,@t);
    }
}


{ package VAST::package_declarator__S_role; our @ISA = 'VAST::package_declarator';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] =~ s/\S.*//s;
        $self->ret($lvl,@t);
    }
}

{ package VAST::package_declarator__S_knowhow; our @ISA = 'VAST::package_declarator';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] =~ s/\S.*//s;
        $self->ret($lvl,@t);
    }
}


{ package VAST::package_def; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	my $def_module_name = $self->{def_module_name}[0]->Str;
	my @extends;
	for (@{$self->{trait}}) {
	    my $t = $_->Str;
	    push(@extends, $t =~ /^is\s+(\S+)/);
	}
	@extends = 'Cursor' unless @extends;
	my $block = $self->{block};
	my $out;
	if ($block) {
	    $out = "{ package $def_module_name;\n";
	}
	else {
	    $::PKG = $def_module_name;
	    $out = "package $def_module_name;\n";
	}

	my $moose;
	$moose .= <<"END";
use Moose ':all' => { -prefix => "moose_" };
END

	$moose .= <<"END" for @extends;
use $_; # for base class as well as DEBUG constants
moose_extends('$_');
END

	$moose .= <<"END";

no warnings 'qw', 'recursion';
END

	if ($block) {
	    my $b = $block->emit_p5($lvl+1);
	    $b =~ s/{//;
	    $out .= ::indent($moose);
	    $out .= $b;
	    my $comment = $self->{comment};
	    if ($comment) {
		$out .= $block->gap($comment);
		$out .= $comment->emit_p5($lvl+1);
	    }
	    else {
		$out .= "\n";
	    }
	}
	else {
	    $out .= $moose;
	    $out .= <<"END";

my \$retree;

\$DB::deep = \$DB::deep = 1000; # suppress used-once warning

sub BUILD {
    my \$self = shift;
END

	$out .= <<'END' if $::PKG eq 'STD';
    $self->_AUTOLEXpeek('termish',$retree);
END

	$out .= <<'END';
}

use YAML::XS;

$SIG{__WARN__} = sub { die @_,"   statement started at line ", 'STD'->lineof($::LASTSTATE), "\n" } if $::DEBUG;

END
	    $out .= $self->{statementlist}->emit_p5($lvl+1);
	}
	$out;
    }
}


{ package VAST::parameter; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	my $t = '    my ' . join('',@t) . " = shift;\n";
        $self->ret($lvl,$t);
    }
}


{ package VAST::param_sep; our @ISA = 'VAST::Base';
}


{ package VAST::param_var; our @ISA = 'VAST::Base';
}


{ package VAST::pblock; our @ISA = 'VAST::Base';
}


{ package VAST::pod_comment; our @ISA = 'VAST::Base';
}


{ package VAST::POST; our @ISA = 'VAST::Base';
}


{ package VAST::postcircumfix; our @ISA = 'VAST::Base';
}


{ package VAST::SYM_postcircumfix__S_Lt_Gt; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = "{'";
	$t[-1] = "'}";
        $self->ret($lvl,@t);
    }
}


{ package VAST::postfix; our @ISA = 'VAST::Base';
}


{ package VAST::postop; our @ISA = 'VAST::Base';
}


{ package VAST::PRE; our @ISA = 'VAST::Base';
}


{ package VAST::prefix; our @ISA = 'VAST::Base';
}


{ package VAST::SYM_prefix__S_Plus; our @ISA = 'VAST::Symbolic_unary';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = '0+';
        $self->ret($lvl,@t);
    }
}


{ package VAST::SYM_prefix__S_temp; our @ISA = 'VAST::Named_unary';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = 'local';
        $self->ret($lvl,@t);
    }
}


{ package VAST::quantified_atom; our @ISA = 'VAST::Base';
}


{ package VAST::quantifier; our @ISA = 'VAST::Base';
}


{ package VAST::quantifier__S_Plus; our @ISA = 'VAST::Base';
}


{ package VAST::quantifier__S_Question; our @ISA = 'VAST::Base';
}


{ package VAST::quantifier__S_Star; our @ISA = 'VAST::Base';
}


{ package VAST::quantifier__S_StarStar; our @ISA = 'VAST::Base';
}


{ package VAST::quantmod; our @ISA = 'VAST::Base';
}


{ package VAST::quibble; our @ISA = 'VAST::Base';
}



{ package VAST::quote; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] =~ s/</qw</;
#	print STDERR ::Dump(\@t);
	$self->ret($lvl,@t);
    }
}

{ package VAST::quote__S_Double_Double; our @ISA = 'VAST::Base';
}


{ package VAST::quote__S_Fre_Nch; our @ISA = 'VAST::Base';
}


{ package VAST::quote__S_Lt_Gt; our @ISA = 'VAST::Base';
}


{ package VAST::quotepair; our @ISA = 'VAST::Base';
}


{ package VAST::quote__S_s; our @ISA = 'VAST::Base';
}


{ package VAST::quote__S_Single_Single; our @ISA = 'VAST::Base';
}


{ package VAST::quote__S_Slash_Slash; our @ISA = 'VAST::Base';
}


{ package VAST::regex_block; our @ISA = 'VAST::Base';
}


{ package VAST::regex_declarator; our @ISA = 'VAST::Base';
}


{ package VAST::regex_declarator__S_regex; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	my $comment = substr($::ORIG, $self->{BEG},100);
	$comment =~ s/\s*\{.*//s;
        my $t = join '', $self->SUPER::emit_p5($lvl+1);
	$t =~ s/regex/sub/;
        $self->ret($lvl,"## $comment\n$t");
    }
}


{ package VAST::regex_declarator__S_rule; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	my $comment = substr($::ORIG, $self->{BEG},100);
	$comment =~ s/\s*\{.*//s;
        my $t = join '', $self->SUPER::emit_p5($lvl+1);
	$t =~ s/rule/sub/;
        $self->ret($lvl,"## $comment\n$t");
    }
}


{ package VAST::regex_declarator__S_token; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	my $comment = substr($::ORIG, $self->{BEG},100);
	$comment =~ s/\s*\{.*//s;
        my $t = join '', $self->SUPER::emit_p5($lvl+1);
	$t =~ s/token/sub/;
        $self->ret($lvl,"## $comment\n$t");
    }
}

{ package VAST::regex_def; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @b = $self->SUPER::emit_p5($lvl+1);
	my @e = '';
	while (@b) {
	    my $t = pop(@b);
	    if ($t =~ s/^\{//) {
		$t = " {\n    my \$self = shift;\n" . pop(@b) . $t;
		unshift(@e,$t);
		last;
	    }
	    unshift(@e,$t);
	}
	my $block = join('', @b, @e);
	$block =~ s/(.*[^ ]) +\}\n/$1\n}\n/s;
        $self->ret($lvl,$block);
    }
}


{ package VAST::Replication; our @ISA = 'VAST::Base';
}


{ package VAST::right; our @ISA = 'VAST::Base';
}


{ package VAST::routine_declarator; our @ISA = 'VAST::Base';
}


{ package VAST::routine_declarator__S_method; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	my $comment = substr($::ORIG, $self->{BEG},100);
	$comment =~ s/\s*\{.*//s;
        my $t = join '', $self->SUPER::emit_p5($lvl+1);
	$t =~ s/method/sub/;
        $self->ret($lvl,"## $comment\n$t");
    }
}


{ package VAST::rxinfix; our @ISA = 'VAST::Base';
}


{ package VAST::rxinfix__S_Tilde; our @ISA = 'VAST::Base';
}


{ package VAST::rxinfix__S_Vert; our @ISA = 'VAST::Base';
}


{ package VAST::rxinfix__S_VertVert; our @ISA = 'VAST::Base';
}


{ package VAST::scoped; our @ISA = 'VAST::Base';
}


{ package VAST::scope_declarator; our @ISA = 'VAST::Base';
}


{ package VAST::scope_declarator__S_has; our @ISA = 'VAST::Base';
}


{ package VAST::scope_declarator__S_my; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	my $t = join('', @t);
	$t =~ s/my(\s+)&(\w+)/my$1\$$2/;
	$t =~ s/my(\s+)([\$@%])::(\w+)/local$1${2}::$3/;
        $self->ret($lvl,$t);
    }
}


{ package VAST::scope_declarator__S_our; our @ISA = 'VAST::Base';
}


{ package VAST::semiarglist; our @ISA = 'VAST::Base';
}


{ package VAST::semilist; our @ISA = 'VAST::Base';
}


{ package VAST::sibble; our @ISA = 'VAST::Base';
}


{ package VAST::sigil; our @ISA = 'VAST::Base';
}


{ package VAST::sigil__S_Amp; our @ISA = 'VAST::Base';
}


{ package VAST::sigil__S_At; our @ISA = 'VAST::Base';
}


{ package VAST::sigil__S_Dollar; our @ISA = 'VAST::Base';
}


{ package VAST::sigil__S_Percent; our @ISA = 'VAST::Base';
}


{ package VAST::sign; our @ISA = 'VAST::Base';
}


{ package VAST::signature; our @ISA = 'VAST::Base';
}


{ package VAST::spacey; our @ISA = 'VAST::Base';
}



{ package VAST::special_variable; our @ISA = 'VAST::Base';
}

{ package VAST::special_variable__S_Dollar_a2_; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = '$C';
        $self->ret($lvl,@t);
    }
}


{ package VAST::special_variable__S_DollarSlash; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = '$M';
        $self->ret($lvl,@t);
    }
}


{ package VAST::statement; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
        $self->ret($lvl,@t);
    }
}


{ package VAST::statement_control; our @ISA = 'VAST::Base';
}


{ package VAST::statement_control__S_default; our @ISA = 'VAST::Base';
}


{ package VAST::statement_control__S_for; our @ISA = 'VAST::Base';
}


{ package VAST::statement_control__S_given; our @ISA = 'VAST::Base';
}


{ package VAST::statement_control__S_if; our @ISA = 'VAST::Base';
}


{ package VAST::statement_control__S_loop; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	my $t = join('', @t);
	$t =~ s/^loop(\s+\()/for$1/;
	$t =~ s/^loop/for (;;)/;
        $self->ret($lvl,$t);
    }
}


{ package VAST::statement_control__S_when; our @ISA = 'VAST::Base';
}


{ package VAST::statement_control__S_while; our @ISA = 'VAST::Base';
}


{ package VAST::statementlist; our @ISA = 'VAST::Base';
}


{ package VAST::statement_mod_cond; our @ISA = 'VAST::Base';
}


{ package VAST::statement_mod_cond__S_if; our @ISA = 'VAST::Base';
}


{ package VAST::statement_mod_cond__S_unless; our @ISA = 'VAST::Base';
}


{ package VAST::statement_mod_loop; our @ISA = 'VAST::Base';
}


{ package VAST::statement_mod_loop__S_for; our @ISA = 'VAST::Base';
}


{ package VAST::statement_mod_loop__S_while; our @ISA = 'VAST::Base';
}


{ package VAST::statement_prefix; our @ISA = 'VAST::Base';
}


{ package VAST::statement_prefix__S_do; our @ISA = 'VAST::Base';
}


{ package VAST::statement_prefix__S_try; our @ISA = 'VAST::Base';
}


{ package VAST::stdstopper; our @ISA = 'VAST::Base';
}


{ package VAST::stopper; our @ISA = 'VAST::Base';
}


{ package VAST::Structural_infix; our @ISA = 'VAST::Base';
}


{ package VAST::sublongname; our @ISA = 'VAST::Base';
}


{ package VAST::subshortname; our @ISA = 'VAST::Base';
}


{ package VAST::Symbolic_unary; our @ISA = 'VAST::Base';
}


{ package VAST::term; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	# print STDERR "HERE " . ref($self) . "\n";
	my $t = $self->SUPER::emit_p5($lvl+1);
	# print STDERR "$t in " . ref($context[$lvl-1]);
	$self->ret($lvl,$t);
    }
}

{ package VAST::term__S_capterm; our @ISA = 'VAST::Base';
}


{ package VAST::term__S_circumfix; our @ISA = 'VAST::Base';
}


{ package VAST::term__S_colonpair; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	my $t = $self->SUPER::emit_p5($lvl+1);
	my $val;
	if ($t =~ s/^:!//) {
	    $val = 0
	}
	elsif ($t =~ s/^:(\d+)//) {
	    $val = $1;
	}
	else {
	    $t =~ s/^://;
	    $val = 1;
	}
	if ($t =~ s/^(\w+)$/'$1'/) {
	    $t .= " => $val";
	}
	else {
	    my ($name,$rest) = $t =~ /^(\w+)(.*)$/s;
	    $rest =~ s/^<([^\s']*)>/'$1'/ or
	    $rest =~ s/^(<\S*>)/q$1/ or
	    $rest =~ s/^(<\s*\S+\s*>)/qw$1/ or
	    $rest =~ s/^(<.*>)/[qw$1]/;	# p5's => isn't scalar context
	    $t = "'$name' => $rest";
	}
	$self->ret($lvl,$t);
    }

}


{ package VAST::term__S_fatarrow; our @ISA = 'VAST::Base';
}


{ package VAST::term__S_identifier; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	if ($t[0] eq 'item') {
	    $t[0] = '\\';
	    $t[1] =~ s/^\s+//;
	}
        $self->ret($lvl,@t);
    }
}


{ package VAST::term__S_multi_declarator; our @ISA = 'VAST::Base';
}


{ package VAST::term__S_package_declarator; our @ISA = 'VAST::Base';
}


{ package VAST::term__S_regex_declarator; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	my $txt = $self->Str;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$txt =~ s/^/## /mg;
        $self->ret($lvl,$txt,@t);
    }
}


{ package VAST::term__S_routine_declarator; our @ISA = 'VAST::Base';
}


{ package VAST::term__S_scope_declarator; our @ISA = 'VAST::Base';
}


{ package VAST::term__S_statement_prefix; our @ISA = 'VAST::Base';
}


{ package VAST::term__S_term; our @ISA = 'VAST::Base';
}


{ package VAST::term__S_value; our @ISA = 'VAST::Base';
}


{ package VAST::term__S_variable; our @ISA = 'VAST::Base';
}


{ package VAST::terminator; our @ISA = 'VAST::Base';
    sub emit_p6 {  my $self = shift;
	my $lvl = shift;
        my @t = $self->SUPER::emit_p6($lvl+1);
        $self->ret($lvl,'');
    }
}

{ package VAST::terminator__S_BangBang; our @ISA = 'VAST::terminator'; }

{ package VAST::terminator__S_for; our @ISA = 'VAST::terminator'; }

{ package VAST::terminator__S_if; our @ISA = 'VAST::terminator'; }

{ package VAST::terminator__S_Ket; our @ISA = 'VAST::terminator'; }

{ package VAST::terminator__S_Ly; our @ISA = 'VAST::terminator'; }

{ package VAST::terminator__S_Semi; our @ISA = 'VAST::terminator'; }

{ package VAST::terminator__S_Thesis; our @ISA = 'VAST::terminator'; }

{ package VAST::terminator__S_unless; our @ISA = 'VAST::terminator'; }

{ package VAST::terminator__S_while; our @ISA = 'VAST::terminator'; }

{ package VAST::terminator__S_when; our @ISA = 'VAST::terminator'; }


{ package VAST::termish; our @ISA = 'VAST::Base';
}



{ package VAST::term; our @ISA = 'VAST::Base';
}

{ package VAST::term__S_name; our @ISA = 'VAST::Base';
}


{ package VAST::term__S_self; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = '$self';
        $self->ret($lvl,@t);
    }
}


{ package VAST::term__S_Star; our @ISA = 'VAST::Base';
}


{ package VAST::term__S_undef; our @ISA = 'VAST::Base';
}


{ package VAST::Tight_or; our @ISA = 'VAST::Base';
}

{ package VAST::Tight_and; our @ISA = 'VAST::Base';
}


{ package VAST::trait; our @ISA = 'VAST::Base';
}


{ package VAST::trait_auxiliary; our @ISA = 'VAST::Base';
}


{ package VAST::trait_auxiliary__S_does; our @ISA = 'VAST::Base';
}


{ package VAST::trait_auxiliary__S_is; our @ISA = 'VAST::Base';
}



{ package VAST::twigil; our @ISA = 'VAST::Base';
}

{ package VAST::twigil__S_Dot; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = 'self->';	# XXX
        $self->ret($lvl,@t);
    }
}


{ package VAST::twigil__S_Star; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = '::';
        $self->ret($lvl,@t);
    }
}


{ package VAST::type_constraint; our @ISA = 'VAST::Base';
}

{ package VAST::type_declarator__S_constant; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
        my @t = $self->SUPER::emit_p5($lvl+1);
	my $t = join('', @t);
	$t =~ s/constant/our/;
        $self->ret($lvl,$t);
    }
}



{ package VAST::typename; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	my @t;
	if (ref $context[-1] ne 'VAST::scoped') {
	    @t = $self->SUPER::emit_p5($lvl+1);
	}
        $self->ret($lvl,@t);
    }
}


{ package VAST::unitstopper; our @ISA = 'VAST::Base';
}


{ package VAST::unspacey; our @ISA = 'VAST::Base';
}


{ package VAST::unv; our @ISA = 'VAST::Base';
}


{ package VAST::val; our @ISA = 'VAST::Base';
}


{ package VAST::value; our @ISA = 'VAST::Base';
}


{ package VAST::value__S_number; our @ISA = 'VAST::Base';
}


{ package VAST::value__S_quote; our @ISA = 'VAST::Base';
}


{ package VAST::variable; our @ISA = 'VAST::Base';
}


{ package VAST::variable_declarator; our @ISA = 'VAST::Base';
}


{ package VAST::vws; our @ISA = 'VAST::Base';
}


{ package VAST::ws; our @ISA = 'VAST::Base';
}



{ package VAST::xblock; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift; my $lvl = shift;
	my @t = $self->SUPER::emit_p5($lvl+1);
	$t[0] = '(' . $t[0] . ')';
	$t[0] =~ s/(\s+)\)$/)$1/;
	$self->ret($lvl,@t);
    }
}

{ package VAST::XXX; our @ISA = 'VAST::Base';
}


if ($0 eq __FILE__) {
    ::MAIN(@ARGV);
}

# vim: ts=8 sw=4 noexpandtab smarttab
