viv

#!/usr/bin/env perl

use v5;

=head1 NAME

viv - The STD.pm6 command line multitool

=head1 SYNOPSIS

viv [options] [file...]

 -e --evaluate TEXT          Use code from the command line
    --thaw                   Input is a --freeze dump, not Perl 6
 -o --output FILE            Send result to FILE, not stdout
    --noperl6lib             Disable use of the PERL6LIB variable
    --symlroot DIR           Use DIR as parsed module cache
    --concise                Pretty-print the parse tree (default)
 -c --check                  Just check syntax
    --freeze                 Generate Storable dump of parse tree
 -y --yaml                   Generate YAML parse tree
 -5 --p5                     Translate to Perl 5 syntax
 -6 --p6                     Translate back to Perl 6
    --psq                    Translate to Perlesque syntax
 -s --stab                   Include symbol table in output
 -m --match                  Include match tree in output
    --no-indent              Disable indentation of output
 -l --log                    Be verbose while generating output
 -k --keep-going             Don't stop if error found during output phase
    --compile-setting FILE   Preparse a CORE.setting file
    --help                   This message

=cut

use strict;
use v5.14;
use warnings FATAL => 'all';

use List::Util qw/sum min/;

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;
use Scalar::Util 'blessed', 'refaddr';
use Storable;
use Try::Tiny;

our $OPT_match = 0;
our $OPT_log = 0;
our $OPT_stab = 0;
our $OPT_thaw = 0;
our $OPT_keep_going = 0;
our $OPT_compile_setting = 0;
our $OPT_output_file = undef;
my $PROG = '';
our $ORIG;
my $U = 0;
my @did_ws;

my @context;
$::MULTINESS = '';
# XXX STD Global trait tables simulate inheritance
local $::PROTOENDSYM = {};
local $::PROTOSIG = {};

BEGIN {
    # Let's say you have a tricky optimization that breaks the build.  You want
    # to know exactly which rewrite is culpable?  Try bisecting with
    # VIV_OPTLIMIT, after wrapping the rewrite in if (DARE_TO_OPTIMIZE).
    my $optlimit = $ENV{VIV_OPTLIMIT};
    if (defined $optlimit) {
        *DARE_TO_OPTIMIZE = Sub::Name::subname(DARE_TO_OPTIMIZE => sub {
                $optlimit-- > 0
        });
    } else {
        constant->import(DARE_TO_OPTIMIZE => 1);
    }
}

our $OPT_output = 'concise';

use FindBin;
use File::Spec;
use Getopt::Long 2.34 'HelpMessage';

my ($boot, $symlroot);
{
    no warnings;
    $CursorBase::NOPERL6LIB;
}

my $r = GetOptions(
    "evaluate|e=s" => sub { $PROG .= Encode::decode_utf8($_[1]) . "\n" },
    "boot"         => \$boot,
    "noperl6lib"   => \$CursorBase::NOPERL6LIB,
    "symlroot"     => \$symlroot,
    "concise"      => sub { $OPT_output = 'concise' },
    "yaml|y"       => sub { $OPT_output = 'yaml' },
    "output|o=s"   => \$OPT_output_file,
    "p5|5"         => sub { $OPT_output = 'p5' },
    "p6|6"         => sub { $OPT_output = 'p6' },
    "psq"          => sub { $OPT_output = 'psq' },
    "freeze"       => sub { $OPT_output = 'store' },
    "check|c"      => sub { $OPT_output = 'none' },
    "stab|s"       => \$OPT_stab,
    "log|l"        => \$OPT_log,
    "pos|p"        => sub { },
    "no-indent"    => sub {
        no warnings 'redefine';
        *indent = \&no_indent;
        *hang = \&no_indent;
    },
    "match|m"      => \$OPT_match,
    "thaw"         => \$OPT_thaw,
    "keep-going|k" => \$OPT_keep_going,
    "compile-setting=s" => \$OPT_compile_setting,
    "help"         => sub { HelpMessage() }
);

unshift @INC, $FindBin::Bin;
if ($boot) {
    no warnings 'once';
    unshift @INC, File::Spec->catdir($FindBin::Bin, "boot");
    $CursorBase::SET_STD5PREFIX = "boot";
    $CursorBase::NOSTDSYML = 1;
}
if (defined $symlroot) {
    $CursorBase::SET_STD5PREFIX = $symlroot;
}

require Actions;
require STD;

sub spew {
    my $bits = shift;
    $bits .= "\n" unless $bits ~~ /\n\z/;
    if (defined $OPT_output_file) {
	open my $out, ">", $OPT_output_file
	    or die "cannot open $OPT_output_file for writing: $!";
	binmode $out, ":utf8";
	$out->print( $bits ) or die "cannot write: $!";
	close $out or die "cannot close: $!";
    } else {
	print $bits;
    }
}

sub no_indent { $_[0] }

sub hang {
    my ($arg, $leader) = @_;

    $arg =~ s/\n/\n$leader/g;

    return $arg;
}

sub listify {
    my $r = "";
    for my $i (0 .. $#_) {
	$r .= ($i == $#_) ? "\n└─" : "\n├─";
	$r .= hang($_[$i], $i == $#_ ? "  " : "│ ");
    }
    $r;
}

sub shred {
    my ($first, $rest, $tx) = @_;
    my $out = "";

    while (length $tx > $first) {
	$out .= substr($tx, 0, $first);
	$out .= "\n";
	$tx = substr($tx, $first);
	$first = $rest;
    }

    $out . $tx;
}

sub concise {
    my ($node, $width) = @_;

    $width = 30 if $width < 30;

    if (!ref $node) {
	return defined($node) ? shred($width, $width, "$node") : "undef";
    } elsif (blessed($node) && ref($node) =~ /^VAST/) {
	my @pos =
	    ref($node->{"."}) eq 'ARRAY' ? @{$node->{"."}} :
	    defined($node->{"."})        ? $node->{"."}    :
	    ();
	my %nam = %$node;

	delete $nam{"."};

	# don't list the same node twice
	my %inpos = map { ref($_) ? (refaddr($_) , 1) : () } @pos;

	@pos = map { concise($_, $width-2) } @pos;

	my @oobnam;
	my $title = blessed $node;
	my $x = length($title);
	for my $ch (sort keys %nam) {
	    next if $ch eq '_fate';
	    if (ref $nam{$ch}) {
		# hide named children that are just (lists of) positional children
		if ($inpos{refaddr($nam{$ch})}) { next }
		if (ref($nam{$ch}) eq 'ARRAY') {
		    my $all = 1;
		    for (@{$nam{$ch}}) { $all = 0 unless ref $_ && $inpos{refaddr $_} }
		    next if $all;
		}
	    }

	    my $repr = concise($nam{$ch}, $width-4);

	    if ($repr !~ /\n/ && length $repr < 30) {
		if ($x + length($ch) + length($repr) + 6 > $width) {
		    $title .= ",\n";
		    $x = 4;
		} else {
		    $title .= ", ";
		    $x += 2;
		}
		$title .= "$ch: $repr";
		$x += length("$ch: $repr");
	    } else {
		my $hang = " " x (length($ch)+2);
		push @oobnam, "$ch: " . hang($repr, $hang);
	    }
	}

	$title = hang($title, (@pos ? "│ " : "  ") . (@oobnam ? "│ " : "  "));

	my $result = $title;

	$result .= hang(listify(@oobnam), @pos ? "│ " : "  ");
	$result .= listify(@pos);

	return $result;
    } else {
	my $d = Dump($node);
	return substr($d, 4, length($d)-5);
    }
}
 
# 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);
}

# rules of thumb: a block (0 or more statements) is a chunk of text, use
# indent.  for expressions, the overall philosophy is that the indentation
# of a line should be proportional to the number of outstanding syntactic
# groups
sub indent {
    my $x = shift || '';
    my $i = shift || 1;
    my $s = '    ' x $i;
    $x =~ s/^/$s/mg;
    $x;
}

sub unsingle {
    my $in = $_[0];
    my $out = '';
    while ($in ne '') {
	$out .= $1 if $in =~ s/^\\([\\'])//;
	$out .= $1 if $in =~ s/^(.)//;
    }
    $out;
}

# XXX this is only used for backslash escapes in regexes
sub undouble {
    my $in = $_[0];
    my $out = '';
    my %trans = ( 'n' => "\n" );
    while ($in ne '') {
	$out .= $trans{$1} // $1 if $in =~ s/^\\(.)//;
	$out .= $1 if $in =~ s/^(.)//;
    }
    $out;
}

sub rd {
    my $in = shift;
    my $out = '';
    for my $ch (split //, $in) {
	$out .= $ch eq "\n" ? '\n' : quotemeta($ch);
    }
    $out;
}

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

{ package VAST::Base;

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

    sub kids { my $self = shift;
	my $key = shift() // '.';
	return () unless exists $self->{$key};
	my $entry = $self->{$key};
	return ref($entry) eq 'ARRAY' ? @$entry : $entry;
    }

    sub emit_p6 { my $self = shift;
	my @text;
	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);
		    die "in a weird place";
		}
		push @text, scalar $kid->p6;
		$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};
	}
	wantarray ? @text : join('', @text);
    }

    sub emit_p5 { my $self = shift;
	my @text;
	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);
		    die "in a weird place";
		}
		push @text, scalar $kid->p5;
		$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};
	}
	wantarray ? @text : join('', @text);
    }

    BEGIN {
	my $tpl = <<'TEMPLATE';
    sub VAST::Base::FORM { my $self = shift; my $lvl = @context;
	my @text;
	say STDERR ' ' x $lvl, ref $self, " from ",$self->{BEG}," to ",$self->{END} if $OPT_log;
	$context[$lvl] = $self;
	# print STDERR "HERE " . ref($self) . "\n";
	local $SIG{__DIE__} = sub {
	    my @args = @_;
	    $args[-1] =~ s/ at .*? line .*?\n$//s if $args[-1] =~ /\n$/s;
	    die Carp::longmess(@args);
	};
	my @bits = !$OPT_keep_going ? $self->emit_FORM(@_) : (::try {
	    $self->emit_FORM(@_);
	} ::catch {
	    my $char = $self->{BEG} // $self->{_from} // 0;
	    my $line = 1 + (substr($ORIG, 0, $char) =~ y/\n/\n/);
	    say STDERR "!!! FAILED at $char (L$line)";
	    print STDERR $_;
	    "<<< ERROR >>>";
	});
	my $val = join '', @bits;
	my @c = map { ref $_ } @context;
	my $c = "@c";
	$c =~ s/VAST:://g;
	say STDERR ' ' x ($lvl-1), "$c returns $val\n" if $OPT_log;
	# Note that we may have skipped levels, so you can't just pop
	splice(@context,$lvl);
	wantarray ? @bits : $val;
    }
TEMPLATE
	for my $format (qw/p5 p6 psq/) {
	    my $t = $tpl;
	    $t =~ s/FORM/$format/g;
	    eval $t;
	}
    }

    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);
    }

    sub base_re_quantifier { my $self = shift; my $x = shift; my $min = shift;
	my $qm = $self->{quantmod}->Str;
	$qm =~ s/:(.)/$1/;
	$qm ||= $::RATCHET ? ':' : '!';
	$qm =~ s/\+/!/;
	return [ $self->{SYM}, $qm, $x, $min ];
    }
}

{ package VAST::ViaDEEP;
    sub emit_psq {  my $self = shift;
	$self->_deep->psqexpr;
    }
}

{ package VAST::InfixCall;
    sub emit_psq {  my $self = shift;
	return DEEP::call("infix:<" . $self->{infix}{SYM} . ">",
	    map { DEEP::raw($_->psq) } $self->kids('args'))->psqexpr;
    }
}

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

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

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

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


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


{ package VAST::args; our @ISA = 'VAST::Base';
    sub deepn { my $self = shift;
	my $al = $self->{arglist}[0] // $self->{semiarglist}{arglist}[0];
	return unless $al;
	$al = $al->{EXPR} or return;

	if ($al->isa('VAST::infix__S_Comma')) {
	    return map { DEEP::raw($_->psq) } $al->kids('args');
	} else {
	    return DEEP::raw($al->psq);
	}
    }
}


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


{ package VAST::assertion__S_Bang; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	my $ast = $self->{assertion} ? $self->{assertion}->re_ast
	    : RE_noop->new;
	$ast->{nobind} = 1;
	RE_assertion->new(assert => '!', re => $ast);
    }
}


{ package VAST::assertion__S_Bra; our @ISA = 'VAST::Base';
    sub re_ast { my $self = shift;
	my $cclass = $self->Str;
        $cclass =~ s/\\x([0-9a-fA-F]{3,4})/\\x\{$1\}/g;
	RE_cclass->new(text => $cclass);
    }
}

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

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


{ package VAST::assertion__S_Cur_Ly; our @ISA = 'VAST::Base';
    sub re_ast { my $self = shift;
        local $::NEEDMATCH = 0;
        my $text = $self->{embeddedblock}{statementlist}->p5;
        $text = "my \$M = \$C;\n" . $text if $::NEEDMATCH;
	RE_block->new(body => $text, context => 'bool');
    }
}


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


{ package VAST::assertion__S_method; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	my $ast = $self->{assertion}->re_ast;
	$ast->{nobind} = 1;
	$ast;
    }
}


{ package VAST::assertion__S_name; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	my $name = $self->{longname}->Str;

	if ($self->{nibbler}[0]) {
	    local $::DBA = $::DBA;
	    local $::RATCHET = $::RATCHET;
	    local $::SIGSPACE = $::SIGSPACE;
	    local $::IGNORECASE = $::IGNORECASE;
	    return RE_method_re->new(name => $name,
		re => $self->{nibbler}[0]{"."}->re_ast);
	}

	if ($self->{assertion}[0]) {
	    return RE_bindnamed->new(var => $name,
		atom => $self->{assertion}[0]->re_ast);
	}

	if ($name eq 'sym' && defined $::ENDSYM) {
	    return RE_sequence->new(
		RE_method->new(name => $name, sym => $::SYM),
		RE_method->new(name => $::ENDSYM, nobind => 1));
	}

	my $al = $self->{arglist}[0];
	local $::NEEDMATCH = 0;
	$al = defined $al ? "(" . $al->p5 . ")" : undef;
	RE_method->new(name => $name, ($name eq 'sym' ? (sym => $::SYM) : ()),
	    rest => $al, need_match => $::NEEDMATCH);
    }
}


{ package VAST::assertion__S_Question; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	my $ast = $self->{assertion} ? $self->{assertion}->re_ast
	    : RE_noop->new;
	$ast->{nobind} = 1;
	RE_assertion->new(assert => '?', re => $ast);
    }
}


{ package VAST::atom; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	if (exists $self->{TEXT}) {
	    RE_string->new(text => $self->{TEXT});
	} else {
	    $self->{metachar}->re_ast;
	}
    }
}


{ package VAST::Assignment; 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';
    sub emit_p5 { my $self = shift;
	my @t = $self->SUPER::emit_p5;
	$t[1] = "{$t[1]}";
	@t;
    }
}


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


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


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


{ package VAST::blockoid; our @ISA = 'VAST::Base';
    sub emit_p5 { my $self = shift;
	"{\n" . ::indent(scalar($self->{statementlist}->p5), 1) . "}";
    }
}


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


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


{ package VAST::Chaining; our @ISA = ('VAST::Base', 'VAST::InfixCall');
}


{ 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';
    sub adverbs { my $self = shift;
	if (Scalar::Util::blessed $self->{v} &&
		$self->{v}->isa('VAST::coloncircumfix')) {
	    my $s = $self->{v}->Str;
	    my $val = $s =~ /^<\s*(.*?)\s*>$/ ? ::unsingle($1) :
		      $s =~ /^«\s*(.*?)\s*»$/ ? ::undouble($1) :
		      $s =~ /^\['(.*)'\]$/ ? ::unsingle($1) :
		      die "Unparsable coloncircumfix";
	    return $self->{k} => $val;
	} elsif ($self->{v} == 1) {
	    return "sym" => $self->{k};
	} else {
	    die "Unsupported compile-time adverb " . $self->Str;
	}
    }
}


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


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


{ package VAST::Comparison; our @ISA = ('VAST::Base', 'VAST::InfixCall');
}


{ package VAST::comp_unit; our @ISA = 'VAST::Base';
    sub emit_p5 { my $self = shift;
	"use v5.14;\nuse utf8;\n" . $self->{statementlist}->p5, "\n";
    }
    sub emit_p6 { my $self = shift;
	substr($ORIG, 0, $self->{statementlist}{BEG}),
	$self->{statementlist}->p5;
    }
    sub emit_psq { my $self = shift;
	local %::PRELUDE;
	my $body = $self->{statementlist}->psq;
	for (sort keys %::PRELUDE) {
	    my $fn = $_;
	    $fn =~ s#::#/#g;
	    $body = "use \"$fn.psq\";\n$body";
	}
	$body;
    }
}

{ package VAST::Concatenation; our @ISA = ('VAST::Base', 'VAST::InfixCall');
}

{ package VAST::Assignment_operator; our @ISA = ('VAST::Base', 'VAST::InfixCall');
}


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


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


{ package VAST::declarator; our @ISA = 'VAST::Base';
    sub emit_p5 { my $self = shift;
	my $vd;
	if ($self->{signature}) {
	    $vd = "(" . join(", ", map { $_->{param_var}->Str }
		$self->{signature}->kids('parameter')) . ")";
	}
	elsif ($self->{variable_declarator}) {
	    $vd = $self->{variable_declarator}->emit_p5;
	} else {
	    return $self->SUPER::emit_p5;
	}
	$vd .= $self->{initializer}[0] ? join('', $self->{initializer}[0]->emit_p5) : "";
	return $vd;
    }

    sub emit_psq { my $self = shift;
	if ($self->{variable_declarator}) {
	    $self->{variable_declarator}->psq(@_);
	} elsif ($self->{signature}) {
	    $self->{signature}->psq(@_, declaring => 1);
	} elsif ($self->{routine_declarator}) {
	    $self->{routine_declarator}->psq(@_);
	} elsif ($self->{regex_declarator}) {
	    $self->{regex_declarator}->psq(@_);
	} elsif ($self->{type_declarator}) {
	    $self->{type_declarator}->psq(@_);
	}
    }
}


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


{ package VAST::deflongname; our @ISA = 'VAST::Base';
    sub adverbs { my $self = shift;
	map { $_->adverbs } $self->kids('colonpair');
    }
}


{ 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::infix_prefix_meta_operator__S_Bang; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[1] = '~' if $t[1] eq '=~';
	$t[1] = '=' if $t[1] eq '==';
	@t = ('ne', '') if $t[1] eq 'eq';
        @t;
    }
}

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

{ package VAST::SYM_infix__S_ColonColonEqual; our @ISA = 'VAST::Item_assignment';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = '=';	# XXX oversimplified
        @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 @t = $self->SUPER::emit_p5;
	$t[0] = '&';
        @t;
    }
}

{ package VAST::SYM_infix__S_eqv; our @ISA = 'VAST::Chaining';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = 'eq';
        @t;
    }
}

{ package VAST::SYM_infix__S_leg; our @ISA = 'VAST::Structural_infix';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = 'cmp';
        @t;
    }
}

{ package VAST::SYM_infix__S_EqualEqualEqual; our @ISA = 'VAST::Chaining';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = '=='; # only correct for objects (and ints)
        @t;
    }
}

{ package VAST::SYM_infix__S_orelse; our @ISA = 'VAST::Loose_or';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = ' or ';
        @t;
    }
}

{ package VAST::SYM_infix__S_andthen; our @ISA = 'VAST::Loose_and';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = ' and ';
        @t;
    }
}

{ package VAST::SYM_infix__S_PlusVert; our @ISA = 'VAST::Additive';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = '|';
        @t;
    }
}


{ package VAST::SYM_infix__S_Tilde; our @ISA = 'VAST::Concatenation';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = '.';
        @t;
    }
}


{ package VAST::SYM_infix__S_TildeTilde; our @ISA = 'VAST::Chaining';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = '=~';
        @t;
    }
}

{ package VAST::SYM_infix__S_TildeVert; our @ISA = 'VAST::Additive';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = '|';
        @t;
    }
}


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

{ package VAST::initializer__S_Equal; our @ISA = 'VAST::initializer';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = '= ';	# XXX oversimplified
        @t;
    }
}

{ package VAST::initializer__S_ColonEqual; our @ISA = 'VAST::initializer';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = '= ';	# XXX oversimplified
        @t;
    }
}

{ package VAST::initializer__S_ColonColonEqual; our @ISA = 'VAST::initializer';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = '= ';	# XXX oversimplified
        @t;
    }
}

{ package VAST::initializer__S_DotEqual; our @ISA = 'VAST::initializer';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = 'dot=';	# XXX wrong
        @t;
    }
}

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


{ package VAST::Item_assignment; our @ISA = ('VAST::Base', 'VAST::InfixCall');
}


{ package VAST::Junctive_and; our @ISA = ('VAST::Base', 'VAST::InfixCall');
}

{ package VAST::Junctive_or; our @ISA = ('VAST::Base', 'VAST::InfixCall');
}


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


{ package VAST::lambda; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = 'sub';
        @t;
    }
}


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


{ package VAST::List_assignment; our @ISA = ('VAST::Base', 'VAST::InfixCall');
}


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


{ package VAST::longname; our @ISA = 'VAST::Base';
    sub adverbs { my $self = shift;
	map { $_->adverbs } $self->kids('colonpair');
    }
}


{ package VAST::Loose_and; our @ISA = ('VAST::Base', 'VAST::InfixCall');
}


{ package VAST::Loose_or; our @ISA = ('VAST::Base', 'VAST::InfixCall');
}


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


{ package VAST::metachar; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	RE_meta->new(text => $self->Str);
    }
}


{ package VAST::metachar__S_Back; our @ISA = 'VAST::metachar';
    sub re_ast {  my $self = shift;
	RE_meta->new(text => $self->Str, min => 1);
    }
}


{ package VAST::metachar__S_Bra_Ket; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	local $::DBA = $::DBA;
	local $::RATCHET = $::RATCHET;
	local $::SIGSPACE = $::SIGSPACE;
	local $::IGNORECASE = $::IGNORECASE;
	local @::DECLAST;

	my $bodyast = $self->{nibbler}{"."}->re_ast;
	RE_bracket->new(decl => \@::DECLAST, re => $bodyast);
    }
}


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


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

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

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

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


{ package VAST::metachar__S_Cur_Ly; our @ISA = 'VAST::Base';
    sub re_ast { my $self = shift;
        local $::NEEDMATCH = 0;
        my $text = $self->{embeddedblock}{statementlist}->p5;
        $text = "my \$M = \$C;\n" . $text if $::NEEDMATCH;
	RE_block->new(body => $text, context => 'void');
    }
}


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


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


{ package VAST::metachar__S_Dot; our @ISA = 'VAST::metachar';
    sub re_ast {  my $self = shift;
	RE_meta->new(text => $self->Str, min => 1);
    }
}


{ package VAST::metachar__S_Double_Double; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	my $text = ::undouble($self->{quote}{nibble}->Str);
	RE_double->new(text => $text);
    }
}


{ package VAST::metachar__S_Lt_Gt; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	$self->{assertion}->re_ast;
    }
}


{ package VAST::metachar__S_mod; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	$self->{mod_internal}->re_ast;
    }
}


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


{ package VAST::metachar__S_Paren_Thesis; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	local $::DBA = $::DBA;
	local $::RATCHET = $::RATCHET;
	local $::SIGSPACE = $::SIGSPACE;
	local $::IGNORECASE = $::IGNORECASE;
	local @::DECLAST;

	my $bodyast = $self->{nibbler}{"."}->re_ast;
	# XXX STD gimme5 disables binding to $0 in $<foo> = (bar)
	my $inner = RE_paren->new(decl => \@::DECLAST, re => $bodyast);
	$::PARSENAME ? $inner : RE_bindpos->new(var => $::PAREN++, atom => $inner)
    }
}


{ package VAST::metachar__S_qw; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	# XXX
	my @elems = split(' ', $self->{circumfix}{nibble}->Str);
	shift @elems;
	my $l = ::min(1_000_000_000, map { length } @elems);
	RE_qw->new(min => $l, text => $self->Str);
    }
}


{ package VAST::sigmaybe__S_sigwhite; our @ISA = 'VAST::Base';
    sub re_ast {  # my $self = shift;
        $::SIGSPACE ?
            RE_method->new(name => 'ws', nobind => 1) :
            RE_noop->new;
    }
}

{ package VAST::sigmaybe__S_normspace; our @ISA = 'VAST::Base';
    sub re_ast {  # my $self = shift;
        $::SIGSPACE ?
            RE_method->new(name => 'ws', nobind => 1) :
            RE_noop->new;
    }
}


{ package VAST::metachar__S_Single_Single; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	my $text = ::unsingle($self->{quote}{nibble}->Str);
	RE_string->new(text => $text);
    }
}


{ package VAST::metachar__S_var; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	# We don't un6 because some things need to un6 specially - backrefs
	if ($self->{binding}) {
	    local $::PARSENAME = 1;
	    $self->{SYM} =~ /^\$<(.*)>$/ or die "Cannot bind backref to " . $self->{SYM};
	    RE_bindnamed->new(var => $1, atom =>
		$self->{binding}{quantified_atom}->re_ast);
	} else {
	    RE_var->new(var => scalar $self->{variable}->p5);
	}
    }
}


{ package VAST::Methodcall; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
	my @t = $self->SUPER::emit_p5;
	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[1] =~ /^[[{]/) {
	    $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);
	$t;
    }
}


{ package VAST::method_def; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
	my $name = $self->{longname} ? $self->{longname}->p5 . " " : "";
	my $sig  = $self->{multisig}[0] ? $self->{multisig}[0]->p5 : "";
	my $body = $self->{blockoid}{statementlist}->p5;

	if ($::MULTINESS eq 'multi') {
	    $::MULTIMETHODS{$name} .= <<EOT
{
    local \@_ = \@_;
    return scalar do { # work around #38809
        my \$self = shift;
EOT
	    . ::indent($sig . $body, 2) . <<EOT
    };
}
EOT
	    ;
	    return '';
	}

	# not quite right, this should be an expression
	($name eq 'EXPR' ? # XXX STD
	    "sub EXPR__PEEK { \$_[0]->_AUTOLEXpeek(\'EXPR\',\$retree) }\n" : '').
	"sub " . $name . "{\n" . 
	    ::indent("no warnings 'recursion';\nmy \$self = shift;\n" .
		$sig . $body, 1)
	. "}";
    }
}


{ 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_p6adv; our @ISA = 'VAST::Base';
    sub re_ast { my $self = shift;
	my $key = $self->{quotepair}{k};

	if ($key eq 'dba') {
	    $::DBA = eval ($self->{quotepair}{circumfix}[0]->Str);
	} elsif ($key eq 'lang') {
	    my $lang = $self->{quotepair}{circumfix}[0]->p5;
	    return RE_decl->new(body => <<BODY);
my \$newlang = $lang;
\$C = bless(\$C, (ref(\$newlang) || \$newlang));
BODY
	} else {
	    die "unhandled internal adverb $key";
	}

	RE_noop->new;
    }
}

{ package VAST::mod_internal__S_Coloni; our @ISA = 'VAST::Base';
    sub re_ast { # my $self = shift;
	$::IGNORECASE = 1;
	RE_noop->new;
    }
}

{ package VAST::mod_internal__S_Colonr; our @ISA = 'VAST::Base';
    sub re_ast { # my $self = shift;
	$::RATCHET = 1;
	RE_noop->new;
    }
}


{ package VAST::mod_internal__S_Colonmy; our @ISA = 'VAST::Base';
    sub re_ast { my $self = shift;
        local $::NEEDMATCH = 0;
        my $text = $self->{statement}->p5 . ";";
        $text = "my \$M = \$C;\n" . $text if $::NEEDMATCH;

	push @::DECLAST, RE_decl->new(body => $text);
	RE_noop->new;
    }
}


{ package VAST::mod_internal__S_Colons; our @ISA = 'VAST::Base';
    sub re_ast { # my $self = shift;
	$::SIGSPACE = 1;
	RE_noop->new;
    }
}


{ package VAST::mod_internal__S_ColonBangs; our @ISA = 'VAST::Base';
    sub re_ast { # my $self = shift;
	$::SIGSPACE = 0;
	RE_noop->new;
    }
}


{ 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';
    sub emit_psq { my $self = shift;
	if ($self->{declarator}) {
	    $self->{declarator}->psq(@_, multiness => $self->{SYM});
	} else {
	    $self->{routine_def}->psq(@_, multiness => $self->{SYM});
	}
    }
}


{ package VAST::multi_declarator__S_multi; our @ISA = 'VAST::multi_declarator';
    sub emit_p5 {  my $self = shift;
	local $::MULTINESS = 'multi';
	$self->{"."}->p5;
    }
}


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


{ package VAST::multi_declarator__S_proto; our @ISA = 'VAST::multi_declarator';
    sub emit_p5 {  my $self = shift;
	local $::MULTINESS = 'proto';
	$self->{"."}->p5;
    }
}


{ package VAST::Multiplicative; our @ISA = ('VAST::Base', 'VAST::InfixCall');
}

# We don't currently do MMD so no need for later sigs
{ package VAST::multisig; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
	$self->{signature}[0]->p5;
    }
}


{ 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::Not_operator; our @ISA = 'VAST::Base';
}



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


{ package VAST::number; our @ISA = 'VAST::Base';
    sub emit_psq { my $self = shift;
	die "unsupported literal format" unless $self->{integer}{decint};
	my $str = $self->{integer}{decint}->Str;
	$str =~ y/_//d;
	$str;
    }
}


{ 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';
    sub emit_psq {  my $self = shift;
	local $::PKGDECL = $self->{SYM};
	$self->{package_def}->psq;
    }
}


{ package VAST::package_declarator__S_class; our @ISA = 'VAST::package_declarator';
    sub emit_p5 {  my $self = shift;
	local $::PKGDECL = 'class';
        $self->{package_def}->p5;
    }
}


{ package VAST::package_declarator__S_grammar; our @ISA = 'VAST::package_declarator';
    sub emit_p5 {  my $self = shift;
	local $::PKGDECL = 'grammar';
        $self->{package_def}->p5;
    }
}


{ package VAST::package_declarator__S_role; our @ISA = 'VAST::package_declarator';
    sub emit_p5 {  my $self = shift;
	local $::PKGDECL = 'role';
        $self->{package_def}->p5;
    }
}

{ package VAST::package_declarator__S_knowhow; our @ISA = 'VAST::package_declarator';
    sub emit_p5 {  my $self = shift;
	local $::PKGDECL = 'knowhow';
        $self->{package_def}->p5;
    }
}


{ package VAST::package_def; our @ISA = 'VAST::Base';
    sub module_name {  my $self = shift;
	my $def_module_name = $self->{longname}[0]{name}->Str;
	if ($self->{decl}{inpkg}[0] =~ /GLOBAL::(.*)/) {
	    my $mod = $1;
	    for ($mod) { s/::::/::/g; s/^:://; s/::$//; } # XXX STD misparse?
	    $::OUR{$def_module_name} = "${mod}::$def_module_name";
	    $def_module_name = "${mod}::$def_module_name";
	}
	$def_module_name;
    }
    sub superclasses {  my $self = shift;
	my @extends;
	for (@{$self->{trait}}) {
	    my $t = $_->Str;
	    push(@extends, $t =~ /^is\s+(\S+)/);
	}
	@extends = map { $::OUR{$_} // $_ } @extends;
	@extends = 'Cursor' if $::PKGDECL eq 'grammar' && !@extends;
	@extends;
    }
    sub roles { my $self = shift;
	my @does;
	for (@{$self->{trait}}) {
	    my $t = $_->Str;
	    push(@does,    $t =~ /^does\s+(\S+)/);
	}
	@does    = map { $::OUR{$_} // $_ } @does;
    }
    sub emit_p5_header {  my $self = shift;
	my $header = "";
	#my $name = $::PKG;

	my $meta = $::PKGDECL eq 'role' ? 'Moose::Role' : 'Moose';

	$header .= <<"END";
use $meta ':all' => { -prefix => "moose_" };
use Encode;
END

	$header .= <<"END" for $self->superclasses;
moose_extends('$_');
END

	$header .= <<"END" for $self->roles;
moose_with('$_');
END

	if (! $self->roles) {
	    $header .= "our \$ALLROLES = { '$::PKG', 1 };\n";
	}

	$header .= "our \$REGEXES = {\n";
	$::PROTORX_HERE{ALL} = [ sort keys %::OVERRIDERX ];
	for my $p (sort keys %::PROTORX_HERE) {
	    $header .= "    $p => [ qw/" . join(" ",
		@{ $::PROTORX_HERE{$p} }) . "/ ],\n";
	}
	$header .= "};\n\n";

	$header .= <<"END";

no warnings 'qw', 'recursion';
my \$retree;

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

use YAML::XS;

END
	$header;
    }

    sub emit_p5 {  my $self = shift;
	my $block = $self->{blockoid}{statementlist} // $self->{statementlist};
	local $::RETREE = {};
	local $::PKG = $self->module_name;
	local $::MULTIRX_SEQUENCE = 0;
	local %::PROTORX_HERE;
	local %::OVERRIDERX;
	local %::MULTIMETHODS;
	my $body3 = $block->p5;
	my $body1 = $self->emit_p5_header;
	my $body2 = '';

	if (%{$::RETREE}) {
	    $body2 = "\$retree = YAML::XS::Load(Encode::encode_utf8(<<'RETREE_END'));\n" .
		Encode::decode_utf8(::Dump($::RETREE)) . "RETREE_END\n";
	}
	my $body = $body1 . $body2 . $body3;
	my $name  = $::PKG;

	if (my ($sig) = $self->kids('signature')) {
	    my @parm = map { $_->Str } $sig->kids('parameter');
	    my $plist = join ", ", @parm;

	    $body = <<EOT . $body;
    package $name;
    require "mangle.pl";
    our \%INSTANTIATED;
    sub __instantiate__ { my \$self = shift;
        my ($plist) = \@_;
        my \$mangle = ::mangle($plist);
        my \$mixin = "${name}::" . \$mangle;
        return \$mixin if \$INSTANTIATED{\$mixin}++;
        ::deb("         instantiating \$mixin") if \$::DEBUG & DEBUG::mixins;
        my \$eval = "package \$mixin" . q{;
	    sub _PARAMS { { ${\ join(", ", map { "'$_' => $_" } @parm) } } }
EOT
	    $body .= <<EOT;
	};
	eval \$eval;
	die \$@ if \$@;
	return \$mixin;
    }
EOT
	} else {
	    $body = "package $name;\n" . $body;
	}

	my $finalmulti = '';

	for my $mm (sort keys %::MULTIMETHODS) {
	    $finalmulti .= "moose_around $mm => sub {\n    my \$orig = shift;\n    no warnings 'recursion';\n" .
		::indent($::MULTIMETHODS{$mm}, 1) . <<EOFINAL
    \$orig->(\@_);
};

EOFINAL
		;
	}

	"{ $body $finalmulti 1; }";
    }

    sub psq_finish_multis { # my $self = shift;
	die "multis not yet implemented for psq";
    }

    sub psq_retree { # my $self = shift;
	die "LTM not yet implemented for psq";
    }

    sub psq_parameterized { # my $self = shift;
	die "roles not yet implemented for psq";
    }

    sub psq_plain { my $self = shift; my $body = shift;
	die "roles not yet implemented for psq"
	    if $::PKGDECL eq 'role' or $self->roles;
	die "multiple inheritance not available in psq"
	    if $self->superclasses > 1;
	my ($is) = $self->superclasses;
	"class " . $::PKG . " " . ($is ? "is $is " : "") .
	    "{\n" . ::indent($body) . "\n}";
    }

    sub emit_psq {  my $self = shift;
	my $block = $self->{blockoid}{statementlist} // $self->{statementlist};
	local $::RETREE = {};
	local $::PKG = $self->module_name;
	local $::MULTIRX_SEQUENCE = 0;
	local %::MULTIMETHODS;

	my $body = $block->psq;
	$body = $body . $self->psq_finish_multis
	    if %::MULTIMETHODS;
	$body = $self->psq_retree . $body
	    if %$::RETREE;

	if (my ($sig) = $self->kids('signature')) {
	    $body = $self->psq_parameterized($body,
		map { $_->Str } $sig->kids('parameter'));
	} else {
	    $body = $self->psq_plain($body);
	}

	$body;
    }
}

# Perl5 invocations don't carry enough context for a proper binder; in
# particular we can't distinguish named stuff from positionals
{ package VAST::parameter; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
	my $pvar = $self->{param_var};
	my @names;
	my $posit = 0;

	my $np = $self->{named_param};
	while ($np) {
	    $pvar = $np->{param_var};
	    push @names, $np->{name} ? $np->{name}{TEXT}
		: $np->{param_var}{name}[0]{TEXT};
	    $np = $np->{named_param_term}{named_param};
	}
	$posit = 1 unless @names;
	my $pname = $pvar->{name}[0]{TEXT};
	my $sigil = $pvar->{sigil}{SYM};
#	print YAML::XS::Dump($self) unless $sigil;
	my $twigil = $pvar->{twigil}[0] ? $pvar->{twigil}[0]{SYM} : '';
	my ($dv) = $self->kids('default_value');

	# Is it valid?
	my $check = '';
	if (($self->{quant} eq '!' || $self->{quant} eq '' && $posit) && !$dv) {
	    $check .= $::MULTINESS eq 'multi' ? "last " :
		"die 'Required argument $pname omitted' ";
	    $check .= $posit ? 'unless @_'
		: 'unless ' . join(" || ", map ("exists \$args{$_}", @names));
	    $check .= ";\n"
	}

	# Get the value
	my $value = "undef";
	if ($dv) {
	    $value = $dv->{"."}->p5;
	}
	if ($posit) {
	    $value = '@_ ? shift() : ' . $value;
	}
	for (reverse @names) {
	    $value = "exists \$args{$_} ? delete \$args{$_} : $value";
	}
	if ($self->{quant} eq '*') {
	    $value = ($sigil eq '%') ? '%args' : '@_';
	    $posit = 0 if $sigil eq '%';
	}

	# Store it somewhere useful
	if ($twigil eq '*' && $pname eq 'endsym') {
	    # XXX this optimization needs to be refactored, I think
	    my ($dv) = $self->kids('default_value');
	    $::ENDSYM = $dv->{"."}->Str;
	    $::ENDSYM = substr($::ENDSYM, 1, length($::ENDSYM)-2);
	    return (0, '');
	}

	my $assn;
	if ($twigil eq '*') {
	    $assn = "local ${sigil}::${pname} = $value";
	} else {
	    $assn = "my ${sigil}${pname} = $value";
	}

	(!$posit), ($check . $assn);
    }
}


{ 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 @t = $self->SUPER::emit_p5;
	$t[0] = "{'";
	$t[-1] = "'}";
        @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 @t = $self->SUPER::emit_p5;
	$t[0] = '0+';
        @t;
    }
}

{ package VAST::SYM_prefix__S_Vert; our @ISA = 'VAST::Symbolic_unary';
    sub emit_p5 {  # my $self = shift;
	('');
    }
}


{ package VAST::prefix__S_temp; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
	my $arg = $self->{arg}->p5;
	"local $arg = $arg";
    }
}


{ package VAST::quantified_atom; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	my $quantifier = $self->{quantifier}[0];
	my $sym = $quantifier ? ($quantifier->{SYM}//'') : '';

	if ($quantifier and $sym eq '~') {
	    return $self->_tilde;
	}

	my $ast = $self->{atom}->re_ast;

	my $sigwhite = $self->{sigmaybe}[0];
	if ($sigwhite) {
	    if (ref($sigwhite) =~ /sigwhite/) {
		# quantify over sigspace too
		$ast = RE_sequence->new($ast, $sigwhite->re_ast);
	    }
	}
	if (not $quantifier) {
	    return $ast;
	}

	if ($sym eq ':') {
	    $ast->{r} = 1;
	    return $ast;
	}

	my $quant = $quantifier->re_quantifier;

	my $separator = $self->{separator}[0];
	if ($separator) {
	    $quant->[2] = $separator->{quantified_atom}->re_ast;
	    # say ::Dump($separator);
	    # say ::Dump($quant);
	}

	my $r = RE_quantified_atom->new(atom => $ast, quant => $quant);
	$r->{r} = 0 if $quant->[1] ne ':';

	my $sigfinal = $self->{sigfinal}[0];
	if ($sigfinal) {
	    if (ref($sigfinal) =~ /sigwhite/) {
		# handle sigspace after quantifier
		$r = RE_sequence->new($r, $sigfinal->re_ast);
	    }
	}

	$r;
    }

    sub _tilde {  my $self = shift;
	my $opener = $self->{atom}->re_ast;
	my $sigwhite = $self->{sigmaybe}[0];
	if ($sigwhite) {
	    if (ref($sigwhite) =~ /sigwhite/) {
		# quantify over sigspace too
		$opener = RE_sequence->new($opener, $sigwhite->re_ast);
	    }
	}
	my $closer = $self->{quantifier}[0]{quantified_atom}[0]->re_ast;
	my $inner  = $self->{quantifier}[0]{quantified_atom}[1]->re_ast;

	my $closertext = $closer->{text}; #XXX
	$closertext = $closer->{zyg}[0]{text} unless defined $closertext;
	if ($closertext) {
	    $closertext = '"' . quotemeta($closertext) . '"';
	}
	else {
	    $closertext = $closer->{var};
	}

	my $begin = <<TEXT;
local \$::GOAL = $closertext;
my \$goalpos = \$C;
TEXT
	if ($closertext !~ /^[])}]$/) {
	    $begin .= <<TEXT;
my \$newlang = \$C->unbalanced(\$::GOAL);
\$C = bless(\$C, (ref(\$newlang) || \$newlang));
TEXT
	}

	my @expn;
	push @expn, $opener;
	# XXX STD break LTM for gimme5 bug-compatibility
	push @expn, RE_block->new(body => '', context => 'void');
	push @expn, $inner;
	push @expn, RE_bracket->new(decl => [], re => RE_first->new(
		RE_var->new(var => '$::GOAL'),
		RE_method->new(name => 'FAILGOAL', nobind => 1,
		    rest => "(\$::GOAL, '$::DBA', \$goalpos)")));

	RE_bracket->new(decl => [RE_decl->new(body => $begin)], re =>
	    RE_sequence->new(@expn));
    }
}

{ package VAST::quant_atom_list; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	my @kids = map { $_->re_ast } $self->kids("quantified_atom");
	RE_sequence->new(@kids);
    }
}


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


{ package VAST::quantifier__S_Plus; our @ISA = 'VAST::Base';
    sub re_quantifier { my $self = shift;
	$self->base_re_quantifier("", 1);
    }
}


{ package VAST::quantifier__S_Question; our @ISA = 'VAST::Base';
    sub re_quantifier { my $self = shift;
	$self->base_re_quantifier("", 0);
    }
}


{ package VAST::quantifier__S_Star; our @ISA = 'VAST::Base';
    sub re_quantifier { my $self = shift;
	$self->base_re_quantifier("", 0);
    }
}


{ package VAST::quantifier__S_StarStar; our @ISA = 'VAST::Base';
    sub re_quantifier { my $self = shift;
	my ($range) = $self->Str =~ /.*(\d+\.\.\d+)$/;
	$self->base_re_quantifier($self->{embeddedblock} //
	    $range // $self->{quantified_atom}->re_ast, 1);
    }
}


{ 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 @t = $self->SUPER::emit_p5;
	$t[0] =~ s/</qw</;
#	print STDERR ::Dump(\@t);
	@t;
    }
}

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


{ package VAST::circumfix__S_Fre_Nch; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
	'[split(/ /, "' . $self->{nibble}->p5 . '", -1)]'
    }
}


{ 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';
    sub emit_psq { my $self = shift;
	my $str = $self->Str;
	$str;
    }
}


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


{ package VAST::Range; 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;
	local $::RATCHET = 0;
	local $::SIGSPACE = 0;
	local $::REGEX_DECLARATOR = 'regex';
	my $comment = substr($ORIG, $self->{BEG},100);
	$comment =~ s/\n.*//s;
        "## $comment\n" . $self->{regex_def}->p5;
    }
}


{ package VAST::regex_declarator__S_rule; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
	local $::RATCHET = 1;
	local $::SIGSPACE = 1;
	local $::REGEX_DECLARATOR = 'rule';
	my $comment = substr($ORIG, $self->{BEG},100);
	$comment =~ s/\n.*//s;
        "## $comment\n" . $self->{regex_def}->p5;
    }
}


{ package VAST::regex_declarator__S_token; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
	local $::RATCHET = 1;
	local $::SIGSPACE = 0;
	local $::REGEX_DECLARATOR = 'token';
	my $comment = substr($ORIG, $self->{BEG}, 100);
	$comment =~ s/\n.*//s;
        "## $comment\n" . $self->{regex_def}->p5;
    }
}

{ package VAST::regex_def; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	RE_ast->new(kind => $::REGEX_DECLARATOR, decl => \@::DECLAST,
	    re => $self->{regex_block}{nibble}{"."}->re_ast);
    }
    sub protoregex {  my $self = shift;  my $name = shift;
	$::RETREE->{$name . ":*"} = { dic => $::PKG };
	for my $t ($self->kids("trait")) {
	    if ($t->{trait_mod}{longname} &&
		$t->{trait_mod}{longname}->Str eq 'endsym') {
		    $::PROTOENDSYM->{$name} =
			$t->{trait_mod}{circumfix}[0]{nibble}->Str;
	    }
	}
	$::PROTOSIG->{$name} = ($self->kids("signature"))[0];
	<<EOT;
sub ${name}__PEEK { \$_[0]->_AUTOLEXpeek('$name:*',\$retree); }
sub $name {
    my \$self = shift;
    my \$subs;

    local \$::CTX = \$self->callm() if \$::DEBUG & DEBUG::trace_call;

    my \$C = \$self->cursor_xact('RULE $name');
    my \$S = \$C->{'_pos'};

    my \@result = do {
        my (\$tag, \$try);
        my \@try;
        my \$relex;
        my \$x;
        if (my \$fate = \$C->{'_fate'}) {
            if (\$fate->[1] eq '$name') {
                \$C->deb("Fate passed to $name: ", ::fatestr(\$fate)) if \$::DEBUG & DEBUG::fates;
                (\$C->{'_fate'}, \$tag, \$try) = \@\$fate;
                \@try = (\$try);
                \$x = 'ALT $name';
            }
            else {
                \$x = 'ALTLTM $name';
            }
        }
        else {
            \$x = 'ALTLTM $name';
        }
        my \$C = \$C->cursor_xact(\$x);
        my \$xact = \$C->{_xact};

        my \@gather = ();
        for (;;) {
            unless (\@try) {
                \$relex //= \$C->cursor_fate('$::PKG', '$name:*', \$retree);
                \@try = \$relex->(\$C) or last;
            }
            \$try = shift(\@try) // next;

            if (ref \$try) {
                (\$C->{'_fate'}, \$tag, \$try) = \@\$try;       # next candidate fate
            }

            \$C->deb("$name trying \$tag \$try") if \$::DEBUG & DEBUG::try_processing;
            push \@gather, \$C->\$try(\@_);
            last if \@gather;
            last if \$xact->[-2];  # committed?
        }
        \$self->_MATCHIFYr(\$S, "$name", \@gather);
    };
    \@result;
}
EOT
    }

    sub emit_p5 {  my $self = shift;
	my $name = $self->{deflongname}[0]{name}->Str;
	$::OVERRIDERX{$name} = 1;
	if (defined $::MULTINESS && $::MULTINESS eq 'proto') {
	    return $self->protoregex($name);
	}
	my $p5name = $name;
	my %adv = $self->{deflongname}[0]->adverbs;
	local $::SYM = $adv{sym};
	local $::ENDSYM = $::PROTOENDSYM->{$name};
	local $::REV = '';
	local $::PLURALITY = 1;
	local @::DECL;
	local @::DECLAST;
	local $::NEEDORIGARGS = 0;
	local $::IGNORECASE = 0;
	local $::PAREN = 0;
	local %::BINDINGS;

	my $spcsig = $self->kids('signature') ?
	    (($self->kids('signature'))[0])->p5 : '';
	my $defsig = $::PROTOSIG->{$name} ? $::PROTOSIG->{$name}->p5 : '';
	if (defined $adv{sym}) {
	    $p5name = sprintf "%s__S_%03d%s", $name, $::MULTIRX_SEQUENCE++,
		::mangle(split " ", $adv{sym});
	    push @{$::PROTORX_HERE{$name}}, $p5name . "__PEEK";
	}
	local $::DBA = $name;
	local $::DECL_CLASS = $::PKG;
	local $::NAME = $p5name;
	local $::ALT = 0;
	my $ast = $self->re_ast->optimize;

	$::RETREE->{$p5name} = $ast;

	my $urbody = $ast->walk;
	say STDERR "<<< " . $urbody . ": " . $urbody->p5expr if $OPT_log;
	my ($body, $ratchet) = $urbody->uncut;
	say STDERR "<<< " . $body . ": " . $body->p5expr if $OPT_log;
	$ast->{dba_needed} = 1;
	$ast->clean;

	<<HDR
sub ${p5name}__PEEK { \$_[0]->_AUTOLEXpeek('$p5name', \$retree) }
sub $p5name {
HDR
	. ::indent(<<IHDR
no warnings 'recursion';
my \$self = shift;

IHDR
	. ($::NEEDORIGARGS ? "    my \@origargs = \@_;\n" : "")
	. ::indent($defsig || $spcsig, 1)
	. ::indent(join("", @::DECL), 1)
	. <<TEXT

local \$::CTX = \$self->callm() if \$::DEBUG & DEBUG::trace_call;

my \$C = \$self->cursor_xact("RULE $p5name");
my \$xact = \$C->xact;
my \$S = \$C->{'_pos'};
TEXT
	    . join("", map  { "\$C->{'$_'} = [];\n" }
		       grep { $::BINDINGS{$_} > 1 }
		       sort keys %::BINDINGS)
	    . ($::SYM ? '$C->{sym} = "' . ::rd($::SYM) . "\";\n" : '')
	    . <<END
\$self->_MATCHIFY$ratchet(\$S, "$p5name", ${\ $body->p5expr });
END
	    , 1) . "}\n";
    }
}


{ package VAST::Replication; our @ISA = ('VAST::Base', 'VAST::InfixCall');
}


{ 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 $comment = substr($ORIG, $self->{BEG},100);
	$comment =~ s/\s*\{.*//s;
        "## $comment\n" . $self->{method_def}->p5;
    }
}


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

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


{ package VAST::regex_infix__S_Vert; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	my $altname = $::NAME . "_" . $::ALT++;

	RE_any->new(altname => $altname,
	    zyg => [map { $_->re_ast } $self->kids('args')]);
    }
}


{ package VAST::regex_infix__S_VertVert; our @ISA = 'VAST::Base';
    sub re_ast {  my $self = shift;
	RE_first->new(map { $_->re_ast } $self->kids('args'));
    }
}


# type erase
{ package VAST::scoped; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
	if (@{$self->{typename}}) {
	    " " . $self->{multi_declarator}->p5;
	} else {
	    $self->SUPER::emit_p5;
	}
    }

    sub emit_psq {  my $self = shift;  my $scope = shift;
	if ($self->{multi_declarator}) {
	    $self->{multi_declarator}->psq(scope => $scope,
		typename => $self->{typename}[0]->psq);
	} elsif ($self->{regex_declarator}) {
	    $self->{regex_declarator}->psq(scope => $scope);
	} elsif ($self->{package_declarator}) {
	    $self->{package_declarator}->psq(scope => $scope);
	} else {
	    $self->{declarator}->psq(scope => $scope);
	}
    }
}


{ package VAST::scope_declarator; our @ISA = 'VAST::Base';
    sub emit_psq { my $self = shift;
	$self->{scoped}->psq($self->{SYM});
    }
}


{ package VAST::scope_declarator__S_has; our @ISA = 'VAST::scope_declarator';
    sub emit_p5 {  my $self = shift;
	my $scoped = $self->{scoped};
	my $typename = $scoped->{typename}[0];
	my $multi = $scoped->{multi_declarator};
	my $decl = $scoped->{declarator} // $multi->{declarator};
	my $vdecl = $decl->{variable_declarator};
	my $var = $vdecl->{variable};
	"moose_has '" . $var->{desigilname}->Str . "' => (" . join (", ",
	    ($typename ? ("isa => '" . $typename->Str . "'") : ()),
	    ("is => 'rw'")
	) . ")";
    }
}


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


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


{ 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';
    my %psq_hash = ( '$', 'S', '@', 'A', '%', 'H', '&', 'C' );
    sub psq_mangle { my $self = shift;
	return $psq_hash{$self->{SYM}};
    }
}


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


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


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


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


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


{ package VAST::signature; our @ISA = 'VAST::Base';
    sub emit_p5 { my $self = shift;
	for ($self->kids('param_sep')) {
	    next if $_->{TEXT} =~ /,/;
	    die "Unusual parameter separators not yet supported";
	}

	# signature stuff is just parsing code
	my @seg = ('', '');
	for my $pv ($self->kids('parameter')) {
	    my ($named, $st) = $pv->p5;
	    $seg[$named] .= $st . ";\n";
	}

	if ($seg[1]) { $seg[1] = "my %args = \@_;\n" . $seg[1]; }

	$seg[0] . $seg[1];
    }
}


{ 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 @t = $self->SUPER::emit_p5;
	$t[0] = '$C';
        @t;
    }
}


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


{ package VAST::statement; our @ISA = 'VAST::Base';
    sub emit_psq {  my $self = shift;
	if ($self->{label}) {
	    return $self->{label}{identifier}->Str . ":\n" .
		$self->{statement}->psq;
	}

	if ($self->{statement_control}) {
	    return $self->{statement_control}->psq;
	}

	return "" if !$self->{EXPR};

	my $body = $self->{EXPR}->psq . ";";
	for my $m ($self->kids('statement_mod_cond'),
		     $self->kids('statement_mod_loop')) {
	    $body = $m->psq . " {\n" . ::indent($body) . "\n}";
	}
	$body;
    }
}


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


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


{ package VAST::statement_control__S_use; our @ISA = 'VAST::Base';
    sub emit_psq { my $self = shift;
	$::PRELUDE{$self->{module_name}->Str} = 1;
	"";
    }
}


{ 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';
    sub emit_p5 {  my $self = shift;
	join("\n", ("if " . $self->{xblock}->p5)
		 , (map { "elsif " .$_->p5 } @{$self->{elsif}})
		 , (map { "else " . $_->p5 } @{$self->{else}}));
    }
}


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


{ package VAST::statement_control__S_when; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	if ($t[1] =~ s/^\s*\(\s*\*\s*\)//) { $t[0] = 'default'; }
        @t;
    }
}


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


{ package VAST::statementlist; our @ISA = 'VAST::Base';
    sub emit_p5 { my $self = shift;
	my @stmts = $self->kids('statement');
	# XXX mostly for the benefit of hashes
	if (@stmts == 1) {
	    return $stmts[0]->p5;
	}
	join("", map { $_->p5 . ";\n" } @stmts);
    }
    sub emit_psq { my $self = shift;
	my @stmts = $self->kids('statement');
	local @::LEXVARS;
	my $b = join("", map { $_->psq . "\n" } @stmts);
	join("", @::LEXVARS, $b);
    }
}


{ 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';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = 'eval';
        @t;
    }
}


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


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


{ package VAST::Structural_infix; our @ISA = ('VAST::Base', 'VAST::InfixCall');
}


{ 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';
}

{ 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 $t = $self->SUPER::emit_p5;
	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";
	}
	$t;
    }

}


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


{ package VAST::term__S_identifier; our @ISA = ('VAST::ViaDEEP', 'VAST::Base');
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	if ($t[0] eq 'item') {
	    $t[0] = '\\';
	    $t[1] =~ s/^\s+//;
	}
	if ($t[0] eq 'map' || $t[0] eq 'grep' || $t[0] eq 'sort') {
	    # XXX this should be more robust, but it belongs in DEEP after
	    # all arguments are collected anyway
	    $t[1] =~ s/}\s*,/} /;
	}
	if ($t[0] eq 'invert') {
	    $t[0] = 'reverse';
	}
	if ($t[0] eq 'chars') {
	    $t[0] = 'length';
	}
	if ($t[0] eq 'note') {
	    $t[0] = 'print STDERR';
	}
	if ($t[0] eq 'False') {
	    $t[0] = '0';
	}
	if ($t[0] eq 'True') {
	    $t[0] = '1';
	}
	if ($t[0] eq 'Nil') {
	    $t[0] = '()';
	}
        @t;
    }

    sub _deep { my $self = shift;
	my $id = $self->{identifier}->Str;
	my @args = $self->{args}->deepn;

	DEEP::call($id, @args);
    }
}


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


{ package VAST::term__S_package_declarator; our @ISA = 'VAST::Base';
    sub emit_psq { $_[0]{package_declarator}->psq }
}


{ package VAST::term__S_regex_declarator; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;;
        $self->{regex_declarator}->p5;
    }
}


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


{ package VAST::term__S_scope_declarator; our @ISA = 'VAST::Base';
    sub emit_psq {  my $self = shift;
	$self->{scope_declarator}->psq;
    }
}


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


{ package VAST::term__S_value; our @ISA = 'VAST::Base';
    sub emit_psq { $_[0]{value}->psq}
}


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


{ package VAST::terminator; our @ISA = 'VAST::Base';
    sub emit_p6 {  # my $self = shift;
        '';
    }
}

{ 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__S_name; our @ISA = ('VAST::Base');
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	if (my ($pkg) = ($t[0] =~ /^::(.*)/)) {
	    $pkg = $::OUR{$pkg} // $pkg;
	    if (defined $t[1] && $t[1] =~ /^\s*\[/) {
		$t[1] =~ s/^\s*\[/->__instantiate__(/;
		$t[1] =~ s/\]\s*$/)/;
		$t[0] = "$pkg";
	    } else {
		$t[0] = "'$pkg'";
	    }
	}
        @t;
    }
}


{ package VAST::term__S_self; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = '$self';
        @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', 'VAST::InfixCall');
}

{ package VAST::Tight_and; our @ISA = ('VAST::Base', 'VAST::InfixCall');
}


{ 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 @t = $self->SUPER::emit_p5;
	$t[0] = 'self->';	# XXX
        @t;
    }
}


{ package VAST::twigil__S_Star; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = '::';
        @t;
    }
}

{ package VAST::twigil__S_Caret; our @ISA = 'VAST::Base';
    sub emit_p5 {  my $self = shift;
        my @t = $self->SUPER::emit_p5;
	$t[0] = ''; #XXX only correct for sorts
        @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 $t = $self->SUPER::emit_p5;
	$t =~ s/constant/our/;
        $t;
    }
}



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

    sub emit_psq { my $self = shift;
	my $s = $self->Str;
	$s eq 'Str' &&           return 'str';
	$s eq 'Int' &&           return 'int';
	$s;
    }
}


{ 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';
    sub emit_psq { $_[0]{number}->psq}
}


{ package VAST::value__S_quote; our @ISA = 'VAST::Base';
    sub emit_psq { $_[0]{quote}->psq}
}


{ package VAST::variable; our @ISA = 'VAST::Base';
    sub emit_p5 { my $self = shift;
	my @t = $self->SUPER::emit_p5;
	if (@t >= 2) { # $t[0] eq '$' but XXX STD uses %<O><prec> (erroneously?)
	    if ($t[1] =~ /^\d+$/) {
		$t[1] = "M->{$t[1]}";
		$::NEEDMATCH = 1;
	    } elsif ($t[1] =~ /^{/) {
		$t[0] = "\$M->";
		$::NEEDMATCH = 1;
	    }
	}
	@t;
    }

    sub emit_psq { my $self = shift;
	return '$' . $self->{sigil}->psq_mangle . '_' . $self->{desigilname}->Str;
    }
}


{ package VAST::variable_declarator; our @ISA = 'VAST::Base';
    sub emit_psq { my $self = shift; my %args = @_;
	my $scope = $args{scope};
	my $type  = $args{typename};
	my $var   = $self->{variable}->psq;
	my $s     = $self->{variable}{sigil}{SYM};

	if ($scope eq 'my') {
	    die "Variables in Perlesque *must* be typed" unless $type;
	    push @::LEXVARS, "my $type $var;\n" if $s eq '$';
	    push @::LEXVARS, "my List[$type] $var = List[$type].new();\n"
		if $s eq '@';
	    push @::LEXVARS, "my Dictionary[str,$type] $var = Dictionary[str,$type].new();\n" if $s eq '%';
	    return $var;
	}
    }
}


{ 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 @t = $self->SUPER::emit_p5;
	$t[0] = '(' . $t[0] . ')';
	$t[0] =~ s/(\s+)\)$/)$1/;
	@t;
    }
}

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

{ package REbase;
    sub kids { }
    sub clone {
	my $self = shift;
	my $dopp = bless { %$self }, ref($self);
	for my $dkid ($dopp->kids) {
	    $$dkid = $$dkid->clone;
	}
	$dopp;
    }
    sub new {  my $class = shift;
	my $self = bless { a => 0, i => $::IGNORECASE ? 1 : 0,
	    r => $::RATCHET ? 1 : 0, s => $::SIGSPACE ? 1 : 0,
	    dba => $::DBA, dic => $::DECL_CLASS, @_ }, $class;
	$self;
    }

    sub optimize { my $self = shift;
	for my $kid ($self->kids) {
	    $$kid = $$kid->optimize;
	}
	$self;
    }

    sub clean { my $self = shift;
	for my $kid ($self->kids) {
	    $$kid->clean;
	}
	delete $self->{r};
	delete $self->{s};
	delete $self->{a};
	delete $self->{i} unless $self->{i_needed};
	delete $self->{i_needed};
	delete $self->{dba} unless $self->{dba_needed};
	delete $self->{dic} unless $self->{dba_needed};
	delete $self->{dba_needed};
    }

    sub walk {  my $self = shift;
	say STDERR "--> $self" if $OPT_log;
	my $exp = $self->_walk;
	if ($self->{r} && $exp->maybacktrack) {
	    $exp = DEEP::cut($exp);
	}
	say STDERR "<-- $exp: ", $exp->p5expr if $OPT_log;
	$exp;
    }

    sub _walk {
        my $self = shift;
        my $result = "";
        if ($$self{zyg}) {
            foreach my $kid (@{$$self{zyg}}) {
                my $x = $kid->walk->p5;
                $result .= $x if defined $x;
            }
        }
        else {
            return ref $self;
        }
        return DEEP::raw($result);
    }

    sub bind { shift; my $re = shift;
	return $re unless @_;
	DEEP::bind($re, @_);
    }

    sub remove_leading_ws { }   # this tree node not interested
    sub has_trailing_ws { 0 }
}

{ package RE_double; use base "REbase";
    sub _walk {
        my $self = shift;
        my $text = $$self{text};
	$$self{i_needed} = 1;
	# XXX needs interpolation
	if ($$self{i}) {
	    $text = $::REV ? "(?<=" . ::rd($text) . ")" : ::rd($text);
	    DEEP::raw('$C->_PATTERN(qr/\\G(?i:' . $text . ')/")', precut => 1);
	}
	else {
	    DEEP::raw("\$C->_EXACT(\"" . ::rd($text) . "\")", precut => 1);
	}
    }
}

{ package RE_string; use base "REbase";
    sub _walk {
        my $self = shift;
	$$self{i_needed} = 1;
	my $text = ::rd($$self{text});
	$text = "(?<=$text)" if $::REV;
	$text = "(?i:$text)" if $$self{i};
	DEEP::p5regex($text, has_meta => ($::REV || $$self{i}),
	    needs_bracket => !($::REV || $$self{i}) && (length($$self{text}) != 1));
    }
}

{ package RE_sequence;
    sub new {
	my ($class, @zyg) = @_;
	$class->SUPER::new(zyg => \@zyg);
    }

    sub wrapone { shift;
        my ($outer, $inner) = @_;
	my ($out1, $outr) = $outer->uncut;
	if ($outr) {
	    DEEP::ratchet($inner, $out1);
	} else {
	    DEEP::raw(::hang("LazyMap::lazymap(" . DEEP::chunk($inner)->p5expr .
		",\n" . $outer->p5expr . ")", "    "));
	}
    }

    sub _walk {
        my $self = shift;
        my @result;
        my @decl;
        if ($$self{zyg}) {
            my @kids = @{$$self{zyg}};
	    my @ckids;

            while (@kids and ref $kids[0] eq 'RE_decl') {
                push @decl, shift(@kids)->walk->p5block;
            }

	    @kids = map { $_->walk } @kids;

	    while (@kids) {
		my $rx = '';
		my $hm = 0;

		while (@kids && $kids[0]->isa('DEEP::p5regex')) {
		    my $rk = shift(@kids);
		    $rx .= $rk->cutre(0);
		    $hm ||= $rk->{has_meta};
		}

		if ($rx ne '') {
		    push @ckids, DEEP::p5regex($rx, needs_bracket => 1,
			has_meta => $hm);
		}

		if (@kids) {
		    push @ckids, shift(@kids);
		}
	    }

            @ckids = reverse @ckids if $::REV;
	    @result = @ckids;
        }
        my $result = pop @result;
        for (reverse @result) {
            $result = $self->wrapone($_,$result);
        }
	@decl ?
	    DEEP::raw(join('', @decl, $result ? $result->p5expr . "\n" : ''), isblock => 1) :
	    $result // DEEP::raw('', isblock => 1);
    }

    sub kids { my $self = shift; map { \$_ } @{$self->{zyg}} }

    sub optimize { my $self = shift;
	my @ok;

	my $afterspace = 0;
	for my $kid ($self->kids) {
	    $$kid->remove_leading_ws if $afterspace;
	    $afterspace = $$kid->has_trailing_ws($afterspace);
	}

	$self = $self->SUPER::optimize;

	for my $k (@{$self->{zyg}}) {
	    next if $k->isa('RE_noop');
	    if ($k->isa('RE_sequence')) {
		push @ok, @{$k->{zyg}};
	    } else {
		push @ok, $k;
	    }
	}

	return RE_noop->new if @ok == 0;
	return $ok[0] if @ok == 1;
	$self->{zyg} = \@ok;
	$self;
    }

    sub remove_leading_ws {
        my $self = shift;

	for my $kid ($self->kids) {
	    my $l = $$kid->has_trailing_ws(1);
	    $$kid->remove_leading_ws;
	    last unless $l;
	}
    }

    sub has_trailing_ws {
	my $self = shift;
	my $before = shift;

	for my $kid ($self->kids) {
	    $before = $$kid->has_trailing_ws($before);
	}

	$before;
    }
}

{ package RE_any; use base "REbase";
    sub _walk {
        my $self = shift;
        my @result;
        my $alt = 0;
        my $altname = $self->{altname};
        if ($$self{zyg}) {
	    my %B = %::BINDINGS;
            for my $kid (@{$$self{zyg}}) {
		local %::BINDINGS;
                my $r = $kid->walk;
		for my $b (keys %::BINDINGS) {
		    $B{$b} = 2 if $::BINDINGS{$b} > 1 or $B{$b};
		}
                push @result, $r;
                $kid->{alt} = $altname . ' ' . $alt++;
            }
	    %::BINDINGS = %B;
        }
        if (@result == 1) {
	    $result[0];
        }
        else {
	    $::RETREE->{$self->{altname}} = $self;
	    $self->{dba_needed} = 1;
            my $result = <<"END";
do {
    my (\$tag, \$try);
    my \@try;
    my \$relex;

    my \$fate;
    my \$x;
    if (\$fate = \$C->{'_fate'} and \$fate->[1] eq '$altname') {
        \$C->deb("Fate passed to $altname: ", ::fatestr(\$fate)) if \$::DEBUG & DEBUG::fates;
        (\$C->{'_fate'}, \$tag, \$try) = \@\$fate;
        \@try = (\$try);
        \$x = 'ALT $altname';    # some outer ltm is controlling us
    }
    else {
        \$x = 'ALTLTM $altname'; # we are top level ltm
    }
    my \$C = \$C->cursor_xact(\$x);
    my \$xact = \$C->{_xact};

    my \@gather = ();
    for (;;) {
        unless (\@try) {
            \$relex //= \$C->cursor_fate('$::PKG', '$altname', \$retree);
            \@try = \$relex->(\$C) or last;
        }
        \$try = shift(\@try) // next;

        if (ref \$try) {
            (\$C->{'_fate'}, \$tag, \$try) = \@\$try;   # next candidate fate
        }

        \$C->deb("$altname trying \$tag \$try") if \$::DEBUG & DEBUG::try_processing;
        push \@gather, ((
END
                for my $i (0 .. @result - 1) {
                    $result .= ::indent(DEEP::chunk($result[$i])->p5expr, 3);
                    if ($i != @result - 1) {
			$result .= ",";
                    }
		    $result .= "\n";
                }
                $result .= <<END;
        )[\$try])->(\$C);
        last if \@gather;
        last if \$xact->[-2];  # committed?
    }
    \@gather;
};
END
            DEEP::raw($result, isblock => 1);
        }
    }

    sub kids { my $self = shift; map { \$_ } @{$self->{zyg}} }

    sub optimize { my $self = shift()->SUPER::optimize;
	my @ok;

	for my $k (@{$self->{zyg}}) {
	    if ($k->isa('RE_any')) {
		push @ok, @{$k->{zyg}};
	    } else {
		push @ok, $k;
	    }
	}

	return $ok[0] if @ok == 1;
	$self->{zyg} = \@ok;
	$self;
    }

    # yes, this affects LTM, but S05 specs it
    sub remove_leading_ws {
        my $self = shift;
        for my $kid (@{$$self{zyg}}) {
            $kid->remove_leading_ws();
        }
    }

    sub has_trailing_ws {
	my $self = shift;
	my $before = shift;
	my $after = 1;

	for my $kid ($self->kids) {
	    $after &&= $$kid->has_trailing_ws($before);
	}

	$after;
    }
}

{ package RE_first; use base "REbase";
    sub new {
	my ($class, @zyg) = @_;
	$class->SUPER::new(zyg => \@zyg);
    }

    sub _walk {
        my $self = shift;
        my @result;
        if ($$self{zyg}) {
	    my %B = %::BINDINGS;
            foreach my $kid (@{$$self{zyg}}) {
		local %::BINDINGS;
                push @result, $kid->walk->p5expr;
		for my $b (keys %::BINDINGS) {
		    $B{$b} = 2 if $::BINDINGS{$b} > 1 or $B{$b};
		}
            }
	    %::BINDINGS = %B;
        }
        if (@result == 1) {
	    DEEP::raw($result[0]);
        }
        else {
            die("Cannot reverse serial disjunction") if $::REV;
            for (@result) { $_ = "do {\n" . ::indent("push \@gather, $_\n") . "}"; }
	    # We need to force the scope here because of the my $C
            my $result = "do {" . ::indent(
		"my \$C = \$C->cursor_xact('ALT ||');\n" .
		"my \$xact = \$C->xact;\nmy \@gather;\n" .
		join("\nor \$xact->[-2] or\n", @result) . ";\n" .
                "\@gather;\n") . "}";
	    DEEP::raw($result);
        }
    }

    sub kids { my $self = shift; map { \$_ } @{$self->{zyg}} }

    sub remove_leading_ws {
        my $self = shift;
        for my $kid (@{$$self{zyg}}) {
            $kid->remove_leading_ws();
        }
    }

    sub has_trailing_ws {
	my $self = shift;
	my $before = shift;
	my $after = 1;

	for my $kid ($self->kids) {
	    $after &&= $$kid->has_trailing_ws($before);
	}

	$after;
    }
}

{ package RE_method; use base "REbase";
    sub clean { my $self = shift;
	$self->SUPER::clean;
	delete $self->{nobind};
	delete $self->{need_match};
	$self->{rest} = defined $self->{rest};
    }
    sub _walk {
        my $self = shift;
        local $::NEEDMATCH = 0;
        my $name = $$self{name};
        die "Cannot reverse $name" if $::REV;
	my $re;

        if ($name eq "sym") {
	    $$self{i_needed} = 1;
            $$self{sym} = $::SYM;
            $$self{endsym} = $::ENDSYM if defined $::ENDSYM;
	    if ($$self{i}) {
		return DEEP::p5regex("(?i:" . ::rd($::SYM) . ")");
	    }
	    else {
		return DEEP::p5regex(::rd($::SYM), has_meta => 0);
	    }
        }
        elsif ($name eq "alpha") {
            return DEEP::p5regex("[_[:alpha:]]");
        }
        elsif ($name eq "_ALNUM") {
            return DEEP::p5regex("\\w");
        }
        elsif ($name eq "nextsame") {
            $::NEEDORIGARGS++;
            $re = '$self->SUPER::' . $::NAME . '(@origargs)';
        }
        elsif ($name =~ /^\w/) {
            my $al = $self->{rest} // '';
            $re = '$C->' . $name . $al;
        }
        else {
            my $al = $self->{rest} // '';
            $re = <<"END";
do {
  if (not $name) {
    \$C;
  }
  elsif (ref $name eq 'Regexp') {
    if (\$::ORIG =~ m/$name/gc) {
      \$C->cursor(\$+[0]);
    }
    else {
      ();
    }
  }
  else {
    \$C->$name$al;
  }
}
END
        }
        $re = "do {\n" . ::indent("my \$M = \$C;\n$re") . "\n}" if $self->{need_match};
	$re = DEEP::raw($re);
	if ($name =~ /^\w/ and not $self->{nobind}) {
	    $::BINDINGS{$name} += $::PLURALITY;
	    $re = $self->bind($re, $name);
	}
	$re;
    }

    sub has_trailing_ws {
	my $self = shift;
	return $self->{name} eq 'ws';
    }

    sub remove_leading_ws {
	my $self = shift;
	if ($self->{name} eq 'ws' && $self->{nobind}) {
	    bless $self, 'RE_noop';
	}
    }
}

{ package RE_ast; use base "REbase";
    sub clean { my $self = shift;
	$self->SUPER::clean;
	delete $self->{decl};
	delete $self->{kind};
    }
    sub _walk {
        my $self = shift;
        if ($$self{decl}) {
            for my $decl (@{$$self{decl}}) {
                push @::DECL, $decl->walk->p5block;
            }
        }
        if ($$self{re}) {
            $$self{re}->walk;
        }
    }

    sub kids { my $self = shift; \$self->{re}, map { \$_ } @{$self->{decl}}; }
}

{ package RE_quantified_atom; use base "REbase";
    # handles cutting itself
    sub clean { my $self = shift;
	$self->SUPER::clean;
	splice @{$self->{quant}}, ($self->{quant}[0] eq '**' ? 3 : 1);
    }
    sub _walk {
        my $self = shift;
	local $::PLURALITY = 2;
	my $quant = "";
	my $rep = "_REP";
	my $q = $$self{quant};
	my $bind = $::BINDINSIDE;
	undef $::BINDINSIDE;
	my $atom = $$self{atom}->walk;
	if ($bind) { #XXX STD
	    $atom = $self->bind($atom, $bind);
	}
#	my $atom_is_cut = !$atom->maybacktrack;
	my ($qfer,$how,$rest) = @$q;
	$qfer = '**' if ref $rest and ref $rest ne 'RE_block';
	my $hc = $how eq '!' ? 'g' :
		 $how eq '?' ? 'f' :
			       'r';
	my $hr = $how eq '!' ? '' :
		 $how eq '?' ? '?' :
			       '+';
	if ($atom->isa('DEEP::p5regex') && $hc eq 'r' && !$::REV && $qfer ne '**') {
	    return DEEP::p5regex($atom->cutre(1) . "$qfer$hr", needs_bracket => 1);
	}

	if ($qfer eq '*') {
	    $quant = "\$C->_STAR$hc$::REV(";
	}
	elsif ($qfer eq '+') {
	    $quant = "\$C->_PLUS$hc$::REV(";
	}
	elsif ($qfer eq '?') {
	    $quant = "\$C->_OPT$hc$::REV(";
	}
	elsif ($qfer eq '**') {
	    if (ref $rest) {
		if (ref $rest eq "RE_block") {
		    $rep = "_REPINDIRECT$::REV";
		    $rest = $rest->walk;
		}
		else {
		    $rep = "_REPSEP$::REV";
		    $rest = DEEP::chunk($rest->walk)->p5expr;
		}
	    }
	    else {
		$rest = "'$rest'";
	    }
	    $quant = "\$C->$rep$hc( $rest, ";
	}
	return DEEP::raw($quant . ::hang(DEEP::chunk($atom)->p5expr, "    ") . ")", precut => ($hc eq 'r'));
    }

    sub kids { my $self = shift; \$self->{atom} }

    sub optimize {
	my $self = shift()->SUPER::optimize;
	if ($self->{quant}[0] eq '*' &&
		$self->{quant}[1] ne ':' &&
		$self->{atom}->isa('RE_meta') &&
		$self->{atom}{text} eq '.') {
	    delete $self->{atom};
	    $self->{text} = ($self->{quant}[1] eq '?') ? '.*?' : '.*';
	    delete $self->{quant};
	    bless $self, 'RE_meta';
	}
	$self;
    }
}

{ package RE_qw; use base "REbase";
    sub _walk {
        my $self = shift;
	DEEP::raw("\$C->_ARRAY$::REV( qw$$self{text} )");
    }
}

{ package RE_method_re; use base "REbase";
    sub _walk {
        my $self = shift;
        my $re = $$self{re};
        my $name = $$self{name};
        die("Cannot reverse $name") if $::REV and $name ne 'before';
        local $::REV = $name eq 'after' ? '_rev' : '';
	{
	    local %::BINDINGS;
	    $re = $re->walk->p5block;
	    if (%::BINDINGS) {
		for my $binding ( keys %::BINDINGS ) {
		    next unless $::BINDINGS{$binding} > 1;
		    $re = <<"END" . $re;
\$C->{'$binding'} = [];
END
		}
	    }
	}
        $::REV = '';

        $re = DEEP::raw('$C->' . $name . "(" . ::hang(DEEP::chunk(DEEP::raw($re, isblock => 1))->p5expr, "    ") . ")");
	if ($name =~ /^\w/ and not $self->{nobind}) {
	    $re = $self->bind($re, $name);
	    $::BINDINGS{$name} += $::PLURALITY;
	}
	$re;
    }

    sub kids { my $self = shift; \$self->{re} }
}

{ package RE_assertion; use base "REbase";
    sub _walk {
        my $self = shift;
        if ($$self{assert} eq '!') {
            my $re = $$self{re}->walk;
	    DEEP::raw("\$C->_NOTBEFORE(" . ::hang(DEEP::chunk($re)->p5expr, "    ") .")");
        }
        else {
            my $re = $$self{re}->walk;
            return $re if $re->p5expr =~ /^\$C->before/; #XXX
            DEEP::raw("\$C->before(" . ::hang(DEEP::chunk($re)->p5expr, "    ") . ")");
        }
    }
    # TODO: Investigate what the LTM engine is doing with assertions and
    # optimize harder.

    sub has_trailing_ws { shift;
	my $before = shift;

	$before; # Transparent
    }

    sub remove_leading_ws {
	my $self = shift;

	$self->{re}->remove_leading_ws;
    }

    sub kids { my $self = shift; \$self->{re} }
}

{ package RE_meta; use base "REbase";
    sub _walk {
        my $self = shift;
        my $text = $$self{text};
        my $not = 0;
        my $code = "";
	my $bt = 0;
        if ($text =~ /^(\\[A-Z])(.*)/) {
            $text = lc($1) . $2;
            $not = 1;
        }
	# to return yourself, you must either be a symbol or handle $not
        if ($text eq '.') {
	    if ($::REV) {
		return DEEP::p5regex("(?<=(?s:.)");
	    }
	    else {
		$code = "\$C->cursor_incr()";
	    }
        }
        elsif ($text eq '.*') {
            $code = "\$C->_SCANg$::REV()";
	    $bt = 1;
        }
        elsif ($text eq '.*?') {
            $code = "\$C->_SCANf$::REV()";
	    $bt = 1;
        }
        elsif ($text eq '^') {
	    return DEEP::p5regex('\A');
        }
        elsif ($text eq '^^') {
	    return DEEP::p5regex('(?m:^)');
        }
        elsif ($text eq '$') {
	    return DEEP::p5regex('\z');
        }
        elsif ($text eq '$$') {
	    return DEEP::p5regex('(?m:$)');
        }
        elsif ($text eq ':') {
	    my $extra = $self->{extra} || '';
            $code = "(($extra), \$C)[-1]";
        }
        elsif ($text eq '::') {
            $code = "\$C->_COMMITLTM$::REV()";
        }
        elsif ($text eq '::>') {
            $code = "\$C->_COMMITBRANCH$::REV()";
        }
        elsif ($text eq ':::') {
            $code = "\$C->_COMMITRULE$::REV()";
        }
        elsif ($text eq '\\d') {
	    if ($::REV) {
		return DEEP::p5regex($not ? '(?<=\D)' : '(?<=\d)');
	    }
	    else {
		return DEEP::p5regex($not ? '\D' : '\d');
	    }
        }
        elsif ($text eq '\\w') {
	    if ($::REV) {
		return DEEP::p5regex($not ? '(?<=\W)' : '(?<=\w)');
	    }
	    else {
		return DEEP::p5regex($not ? '\W' : '\w');
	    }
        }
        elsif ($text eq '\\s') {
	    if ($::REV) {
		return DEEP::p5regex($not ? '(?<=\W)' : '(?<=\w)');
	    }
	    else {
		return DEEP::p5regex($not ? '\S' : '\s');
	    }
        }
        elsif ($text eq '\\h') {
	    if ($::REV) {
		return DEEP::p5regex($not ? '(?<=[^\x20\t\r])' : '(?<=[\x20\t\r])');
	    }
	    else {
		return DEEP::p5regex($not ? '[^\x20\t\r]' : '[\x20\t\r]');
	    }
        }
        elsif ($text eq '\\v') {
	    if ($::REV) {
		return DEEP::p5regex($not ? '(?<=[^\n])' : '(?<=[\n])');
	    }
	    else {
		return DEEP::p5regex($not ? '[^\n]' : '\n');
	    }
        }
        elsif ($text eq '»') {
	    return DEEP::p5regex('\b');
        }
        elsif ($text eq '«') {
	    return DEEP::p5regex('\b');
        }
        elsif ($text eq '>>') {
            $code = "\$C->_RIGHTWB$::REV()";
        }
        elsif ($text eq '<<') {
            $code = "\$C->_LEFTWB$::REV()";
        }
        elsif ($text eq '<(') {
            $code = "\$C->_LEFTRESULT$::REV()";
        }
        elsif ($text eq ')>') {
            $code = "\$C->_RIGHTRESULT$::REV()";
        }
        elsif ($text eq '<~~>') {
            $code = "\$C->$::NAME()";
	    $bt = 1;
        }
        else {
            $code = "\$C->_EXACT$::REV(\"$text\")";
        }
        if ($not) { # XXX or maybe just .NOT on the end...
            $code = "\$C->_NOTCHAR( sub { my \$C=shift;\n" . ::indent($code) . "\n})";
        }
	DEEP::raw($code, precut => !$bt);
    }
}

{ package RE_cclass; use base "REbase";
    sub _walk {
        my $self = shift;
        my $text = $$self{text};
	$self->{i_needed} = 1;
        $text =~ s!(\/|\\\/)!\\$1!g;
        $text =~ s/\s//g;
        $text =~ s/\.\./-/g;
	$text =~ s/^-\[/[^/;
	$text = "(?<=$text)" if $::REV;
	if ($$self{i}) {
	    DEEP::p5regex("(?i:$text)");
	}
	else {
	    DEEP::p5regex($text, needs_bracket => 1);
	}
    }
}

{ package RE_noop; use base "REbase";
    sub _walk {
        # my $self = shift;
	DEEP::raw('$C', precut => 1);
    }

    sub has_trailing_ws { shift;
	my $before = shift;

	$before;
    }
}

{ package RE_decl; use base "REbase";
    # because cutting one of these would be a disaster
    sub new {
	my $class = shift;
	my $self  = $class->SUPER::new(@_);
	$self->{r} = 0;
	$self;
    }
    sub clean { my $self = shift;
	$self->SUPER::clean;
	delete $self->{body};
    }
    sub _walk {
        my $self = shift;
	DEEP::raw($$self{body}, isblock => 1);
    }

    sub has_trailing_ws { shift;
	my $before = shift;

	$before;
    }
}

{ package RE_block; use base "REbase";
    sub clean { my $self = shift;
	$self->SUPER::clean;
	delete $self->{context};
	delete $self->{body};
    }
    sub _walk {
        my $self = shift;
        my $ctx = $$self{context};
        my $text = ::indent($$self{body});
        if ($ctx eq 'void') {
            return DEEP::raw("scalar(do {\n" . ::indent($text) . "}, \$C)", precut => 1);
        }
        elsif ($ctx eq 'bool') {
            return DEEP::raw("((\$C) x !!do {\n" . ::indent($text) . "})", precut => 1);
        }
        else {
            return DEEP::raw("sub {\n" . ::indent("my \$C=shift;\n" . $text) . "}", precut => 1);
        }
    }

    sub has_trailing_ws { shift;
	my $before = shift;

	$before;
    }
}

{ package RE_bracket; use base "REbase";
    sub clean { my $self = shift;
	$self->SUPER::clean;
	delete $self->{decl};
    }
    sub _walk {
        my $self = shift;
	my ($re, $r) = $$self{re}->walk->uncut;
	my @decl = map { $_->walk } @{$$self{decl}};
	DEEP::raw("\$C->_BRACKET$r(" . ::hang(DEEP::chunk($re, @decl)->p5expr, "    ") . ")");
    }

    sub kids { my $self = shift; \$self->{re} }

    sub remove_leading_ws {
        my $self = shift;
        my $re = $$self{re};
        $re->remove_leading_ws();
    }

    sub has_trailing_ws {
	my $self = shift;
	my $before = shift;
	$$self{re}->has_trailing_ws($before);
    }
}

{ package RE_var; use base "REbase";
    sub _walk {
        my $self = shift;
        my $var = $$self{var};
        if ($var =~ /^\$/) {
            if ($var =~ /^\$M->{(.*)}/) {
		my $p = (substr($1,0,1) eq "'") ? "n" : "p";
		DEEP::raw("\$C->_BACKREF$p$::REV($1)");
            }
            else {
		DEEP::raw("\$C->_EXACT$::REV($var)");
            }
        }
        elsif ($var =~ /^\@/) {
	    DEEP::raw("\$C->_ARRAY$::REV($var)");
        }
        elsif ($var =~ /^\%/) {
	    DEEP::raw("\$C->_HASH$::REV($var)");
        }
    }
}

{ package RE_paren; use base "REbase";
    sub clean { my $self = shift;
	$self->SUPER::clean;
	delete $self->{decl};
    }
    sub _walk {
        my $self = shift;
	my $re;
	{
	    local %::BINDINGS;
	    $re = $$self{re}->walk->p5block;
	    if (%::BINDINGS) {
		for my $binding ( keys %::BINDINGS ) {
		    next unless $::BINDINGS{$binding} > 1;
		    my $re = <<"END" . $re;
\$C->{'$binding'} = [];
END
		}
	    }
	}
        $re = "\$C->_$::REV"."PAREN( " . ::hang(DEEP::chunk(DEEP::raw($re))->p5expr, "    ") . ")";
	DEEP::raw($re);
    }

    sub kids { my $self = shift; \$self->{re} }

    # yes, () would capture the ws, but we're guaranteed to be past it already
    sub remove_leading_ws {
        my $self = shift;
        my $re = $$self{re};
        $re->remove_leading_ws();
    }

    sub has_trailing_ws {
	my $self = shift;
	my $before = shift;
	$$self{re}->has_trailing_ws($before);
    }
}

{ package RE_bindpos; use base "REbase";
    sub clean { my $self = shift;
	$self->SUPER::clean;
	delete $self->{var};
    }
    sub _walk {
        my $self = shift;
        my $var = $$self{var};
	$::BINDINGS{$var} += $::PLURALITY;
        my $re = $$self{atom}->walk;
        $self->bind($re, $var);
    }

    sub kids { my $self = shift; \$self->{atom} }

    sub remove_leading_ws {
        my $self = shift;
        my $re = $$self{atom};
        $re->remove_leading_ws();
    }

    sub has_trailing_ws {
	my $self = shift;
	my $before = shift;
	$$self{atom}->has_trailing_ws($before);
    }
}

{ package RE_bindnamed; use base "REbase";
    sub clean { my $self = shift;
	$self->SUPER::clean;
	delete $self->{var};
    }
    sub _walk {
        my $self = shift;
        my $var = $$self{var};
	# XXX STD for gimme5 bug-compatibility, names push inside quantifiers
	$::BINDINGS{$var} += $::PLURALITY;
	if ($$self{atom}->isa('RE_quantified_atom')) {
	    local $::BINDINSIDE = $var;
	    return $$self{atom}->walk;
	}
	if ($$self{atom}->isa('RE_block') && $$self{atom}{context} eq 'void') {
            return DEEP::raw("\$C->_SUBSUMEblock('" . $var . "', sub {\n" . ::indent("my \$C = shift;\n" . $$self{atom}{body}) . "})", precut => 1);
	}
        my $re = $$self{atom}->walk;
        $self->bind($re, $var);
    }

    sub kids { my $self = shift; \$self->{atom} }

    sub remove_leading_ws {
        my $self = shift;
        my $re = $$self{atom};
        $re->remove_leading_ws();
    }

    sub has_trailing_ws {
	my $self = shift;
	my $before = shift;
	$$self{atom}->has_trailing_ws($before);
    }
}

# DEEP is the lowest level of desugaring used by viv, but it still keeps a tree
# structure.  Not all DEEP nodes are interchangeable; some represent expression
# bits, others statements with no sensible return value.
{ package DEEPbase;
}

{ package DEEPexpr;
    sub maybacktrack { 1 }

    sub uncut { my $self = shift; $self, ($self->maybacktrack ? '' : 'r') }

    # p5 should return (is a block?), text; takes arguments sh (can shadow $C?)
    # and ov (can overwrite $C?); non-block returns may not shadow
    sub p5expr { my $self = shift;
	my ($isbl, $text) = $self->p5(@_, sh => 1);
	$isbl ? ("do {\n" . ::indent($text) . "\n}") : $text;
    }

    sub p5block { my $self = shift;
	my ($isbl, $text) = $self->p5(@_);
	$isbl ? $text : ($text . "\n");
    }

    # psq returns the same as p5 for now
    sub psqexpr { my $self = shift;
	my ($isbl, $text) = $self->psq(@_, sh => 1);
	$isbl ? ("do {\n" . ::indent($text) . "\n}") : $text;
    }
}

{ package DEEP::raw; our @ISA = 'DEEPexpr';
    sub DEEP::raw {
	my $text = shift;
	bless { text => $text, @_ }, "DEEP::raw";
    }

    sub maybacktrack {
	my $self = shift;
	return !$self->{precut};
    }

    sub p5 { my $self = shift;
	$self->{isblock}, $self->{text};
    }

    sub psq { my $self = shift;
	$self->{isblock}, $self->{text};
    }
}

{ package DEEP::cut; our @ISA = 'DEEPexpr';
    sub DEEP::cut {
	my $child = shift;
	if (!$child->maybacktrack) {
	    return $child;
	}
	if ($child->isa('DEEP::bind')) {
	    return DEEP::bind(DEEP::cut($child->{child}), @{$child->{names}});
	}
	bless { child => $child }, "DEEP::cut";
    }

    sub p5 { my $self = shift;
	1, "if (my (\$C) = (" . ::hang($self->{child}->p5expr, "    ") . ")) { (\$C) } else { () }\n";
    }

    sub maybacktrack { 0 }

    sub uncut {
	my $self = shift;
	my ($child_uncut) = $self->{child}->uncut;
	$child_uncut, 'r';
    }
}

{ package DEEP::bind; our @ISA = 'DEEPexpr';
    sub DEEP::bind {
	my $child = shift;
	my @names = @_;
	if ($child->isa('DEEP::bind')) {
	    push @names, @{$child->{names}};
	    $child = $child->{child};
	}
	bless { child => $child, names => \@names }, "DEEP::bind";
    }

    sub maybacktrack { $_[0]{child}->maybacktrack }

    sub p5 { my $self = shift;
	my ($chinner, $r) = $self->{child}->uncut;
	0, "\$C->_SUBSUME$r([" .
	    join(',', map {"'$_'"} @{$self->{names}}) .
	    "], sub {\n" . ::indent("my \$C = shift;\n" .
	    $chinner->p5block(cl => 1, sh => 1)) . "})";
    }
}

{ package DEEP::ratchet; our @ISA = 'DEEPexpr';
    sub DEEP::ratchet {
	my $child = shift;
	my @before = @_;
	if (::DARE_TO_OPTIMIZE) {
	    if ($child->isa('DEEP::ratchet')) {
		push @before, @{$child->{before}};
		$child = $child->{child};
	    }
	    my ($chinner, $chr) = $child->uncut;
	    if ($chr && $chinner != $child) {
		push @before, $chinner;
		$child = DEEP::raw('$C', precut => 1);
	    }
	}
	bless { child => $child, before => \@before }, "DEEP::ratchet";
    }

    sub maybacktrack { $_[0]{child}->maybacktrack }

    sub p5 { my $self = shift; my %a = @_;
	if (@{$self->{before}} == 1) {
	    my $pre = $self->{before}[0];
	    return 1, "if (my (\$C) = (" . ::hang($pre->p5expr, " " x 8). ")) {\n" .
		::indent($self->{child}->p5block) . "} else { () }\n";
	}
	my $conditional = join ::hang("\nand ", "    "),
	    map { "(\$C) = (" . ::hang($_->p5expr, " " x 8) . ")" }
	    @{$self->{before}};

	my $guts = ($conditional ?
	    "if ($conditional) {\n" .
		::indent($self->{child}->p5block) . "} else { () }\n"
	    : $self->{child}->p5block(cl => 1, sh => 1));

	$guts = "my \$C = \$C;\n" . $guts unless $a{cl};
	$guts = "do {\n" . ::indent($guts) . "};\n" unless $a{sh};
	1, $guts;
    }
}
# NOT a regex bit, but a value
{ package DEEP::chunk; our @ISA = 'DEEPexpr';
    sub DEEP::chunk {
	my $child = shift;
	bless { child => $child, decl => \@_ }, "DEEP::chunk";
    }

    sub p5 {
	my $self = shift;
        0, "sub {\n" . ::indent(
	    "my \$C=shift;\n" .
	    join("", map { $_->p5block } @{ $self->{decl} }) .
	    $self->{child}->p5block(cl => 1, sh => 1)) . "}";
    }
}

{ package DEEP::p5regex; our @ISA = 'DEEPexpr';
    sub DEEP::p5regex {
	my $text = shift;
	bless { text => $text, has_meta => 1, @_ }, "DEEP::p5regex";
    }

    sub p5 {
	my $self = shift;
	0, $self->{has_meta} ?
	    "\$C->_PATTERN(qr/\\G" . $self->{text} . "/)" :
	    "\$C->_EXACT(\"" . $self->{text} . "\")";
    }

    sub cutre {
	my $self = shift;
	my $btoo = shift;
	$self->{needs_cut} ? "(?>" . $self->{text} . ")"
			   : ($btoo && $self->{needs_bracket}
				? "(?:" . $self->{text} . ")"
				: $self->{text});
    }

    sub maybacktrack { 0 }
}

{ package DEEP::call; our @ISA = 'DEEPexpr';
    sub DEEP::call {
	my ($name, @args) = @_;
	bless { name => $name, args => \@args }, "DEEP::call";
    }

    my %psq_map = (
	'note' 		=> "System.Console.Error.WriteLine"
    );

    sub psq { my $self = shift;
	my $n = $self->{name};
	my $np = $psq_map{$n};
	if (!ref $np) {
	    my $n2 = $psq_map{$n} // $n;
	    if ($n2 =~ /infix:<(.*)>/) {
		my $op = " $1 ";
		$np = sub { my ($a1, $a2) = @_;
		    "(" . $a1->psqexpr . $op . $a2->psqexpr . ")"; };
	    }
	    elsif ($n2 =~ /prefix:<(.*)>/) {
		my $op = $1;
		$np = sub { my ($a) = @_;
		    "(" . $op . $a->psqexpr . ")"; };
	    }
	    elsif ($n2 =~ /postfix:<(.*)>/) {
		my $op = $1;
		$np = sub { my ($a) = @_;
		    "(" . $a->psqexpr . $op . ")"; };
	    }
	    else {
		$np = sub { $n2 . "(" . join(", ",
			map { $_->psqexpr } @_) . ")" };
	    }
	    $psq_map{$n} = $np;
	}
	return 0, $np->(@{$self->{args}});
    }
}

unless (caller) {
    if ($OPT_compile_setting) {
        STD->parsefile($OPT_compile_setting, setting => "NULL");
        exit 0;
    }

    HelpMessage() unless @ARGV || $PROG;
    my $r;
    if ($OPT_thaw) {
	my $raw = retrieve($_[0]);
	$ORIG = $raw->{ORIG};
	$r = $raw->{AST};
	$STD::ALL = $raw->{STABS};
	for my $cl (keys %{$raw->{GENCLASS}}) {
	    Actions::gen_class($cl, $raw->{GENCLASS}->{$cl});
	}
    }
    elsif (@ARGV and -f $ARGV[0]) {
	$r = STD->parsefile($ARGV[0], text_return => \$ORIG,
	    actions => 'Actions')->{'_ast'};
    }
    else {
	if (not $PROG) {
	    local $/;
	    @ARGV = @_;
	    $PROG = <>;
	}
	$ORIG = $PROG;
	$r = STD->parse($PROG, actions => 'Actions')->{'_ast'};
    }
    unless ($OPT_thaw) {
	$ORIG =~ s/\n;\z//;
    }
    if ($OPT_stab) {
	no warnings;
	$r->{stabs} = $STD::ALL;
    }
    if ($OPT_output eq 'yaml') {
	my $x = Dump($r);
#	$x =~ s/\n.*: \[\]$//mg;
	spew $x;
    }
    elsif ($OPT_output eq 'concise') {
	spew concise($r, 80);
    }
    elsif ($OPT_output eq 'p6') {
	spew $r->p6;
    }
    elsif ($OPT_output eq 'psq') {
	spew $r->psq;
    }
    elsif ($OPT_output eq 'p5') {
	spew fixpod($r->p5);
    }
    elsif ($OPT_output eq 'none') {
	say "@ARGV syntax OK";
    }
    elsif ($OPT_output eq 'store') {
	delete $r->{stabs};
        no warnings 'once';
	my $data = { AST => $r, GENCLASS => \%Actions::GENCLASS,
	    ORIG => $ORIG, STABS => $STD::ALL };
	defined($OPT_output_file) ? store($data, $OPT_output_file)
	    : Storable::store_fd($data, \*STDOUT);
    }
    else {
	die "Unknown output mode";
    }
}

1;

# vim: ts=8 sw=4 noexpandtab smarttab