File Coverage

blib/lib/Seis/Compiler.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Seis::Compiler;
use strict;
use warnings;
use utf8;
use 5.010_001;

use Perl6::PVIP 0.07;
use Carp ();
use Data::Dumper ();
use Encode ();
use Seis::Runtime;

use constant {
    G_VOID => 1,
    G_SCALAR => 2,
    G_ARRAY  => 3,
};

# `no warnings 'misc'` suppress `"our" variable $x redeclared` message
# in `our $x; { my $x; { our $x}}`
our $HEADER = <<'...';
package # Hide from PAUSE
    Main;
use strict;
use 5.018_000;
use utf8;
no warnings "experimental::smartmatch";
no warnings "experimental::lexical_subs";
use feature "lexical_subs";
use Seis::Autobox;
use List::Util qw(min max);
use Seis::Runtime;
use POSIX qw(floor);
no warnings 'misc', 'void';
BEGIN {
    *gcd = *Seis::BuiltinFunctions::gcd;
    *Int = *Seis::Runtime::Int;
    *Mu = *Seis::Runtime::Mu;
    *Array = *Seis::Runtime::Array;
    *True = *Bool::True;
}

...

sub new {
    my $class = shift;
    return bless {}, $class;
}

sub compile {
    my ($self, $src, $filename) = @_;
    $filename //= '-e';
    local $self->{filename} = $filename;
    local $self->{line_number} = 0;
    my $parser = Perl6::PVIP->new();
    my $node = $parser->parse_string($src)
        or Seis::Exception::ParsingError->throw("Can't parse $filename:\n"  . $parser->errstr);
    return join('',
        $HEADER,
        qq{#line 1 "$filename"\n},
        $self->do_compile($node)
    );
}

sub do_compile {
    my ($self, $node, $gimme) = @_;
    $gimme //= G_SCALAR;
    Carp::confess "Invalid node" unless ref $node;

    my $v = $node->value;
    my $type = $node->type;

    if ($type == PVIP_NODE_STATEMENTS) {
        my $ret;
        for (my $i=0; $i<@$v; $i++) {
            next if $v->[$i]->type == PVIP_NODE_NOP;
            # $ret .= sprintf("# NODE:%d SELF:%d\n", $v->[$i]->line_number, $self->{line_number});
            while ($self->{line_number} < $v->[$i]->line_number) {
                $ret .= "\n";
                $self->{line_number}++;
            }
            my $stmt = $self->do_compile($v->[$i], $i==@$v-1 ? G_SCALAR : G_VOID);
            if ($stmt =~ /\n\z/ && $i!=@$v-1) {
                $ret .= $stmt;
            } else {
                $ret .= "$stmt;\n";
                $self->{line_number}++;
            }
        }
        $ret;
    } elsif ($type == PVIP_NODE_UNDEF) {
        undef;
    } elsif ($type == PVIP_NODE_RANGE) {
        if ($gimme == G_ARRAY) {
            $self->do_compile($v->[0]) . '..' . $self->do_compile($v->[1]);
        } else {
            '[' . $self->do_compile($v->[0]) . '..' . $self->do_compile($v->[1]) .']';
        }
    } elsif ($type == PVIP_NODE_REDUCE) {
        my $body;
        if ($v->[0]->value =~ /[a-z]/) {
            $body = sprintf '$seis_reduce_ret = %s($seis_reduce_ret, $seis_reduce_stuff)', $v->[0]->value;
        } else {
            $body = sprintf '$seis_reduce_ret %s= $seis_reduce_stuff', $v->[0]->value;
        }
        # XXX I should care the other cases?
        my $initial = $v->[0]->value eq '*' ? 1 : 0;
        sprintf('do { my @seis_reduce_ary = %s; my $seis_reduce_ret = @seis_reduce_ary==0 ? %s : shift @seis_reduce_ary; for my $seis_reduce_stuff (@seis_reduce_ary) { %s } $seis_reduce_ret; }', $self->do_compile($v->[1], G_ARRAY), $initial, $body);
    } elsif ($type == PVIP_NODE_INT) {
        $node->value;
    } elsif ($type == PVIP_NODE_NUMBER) {
        $node->value;
    } elsif ($type == PVIP_NODE_DIV) {
        '(' . $self->do_compile($v->[0]) . ')/(' . $self->do_compile($v->[1]) . ')';
    } elsif ($type == PVIP_NODE_MUL) {
        '(' . $self->do_compile($v->[0]) . ')*(' . $self->do_compile($v->[1]) . ')';
    } elsif ($type == PVIP_NODE_ADD) {
        '(' . $self->do_compile($v->[0]) . ')+(' . $self->do_compile($v->[1]) . ')';
    } elsif ($type == PVIP_NODE_SUB) {
        '(' . $self->do_compile($v->[0]) . ')-(' . $self->do_compile($v->[1]) . ')';
    } elsif ($type == PVIP_NODE_IDENT) {
        if ($v eq '::Array') {
            'Seis::Class->_new(name => "Array")'
        } elsif ($v eq 'self') {
            '$self'
        } elsif ($v eq '::Hash') {
            'Seis::Class->_new(name => "Hash")'
        } elsif ($v eq 'Buf') {
            'Buf::'
        } elsif ($v eq 'Exception') {
            'Seis::Class->_new(name => "Exception")'
        } elsif ($v eq 'Real') {
            'Seis::Real::'
        } elsif ($v eq 'Duration') {
            'Seis::Duration::'
        } elsif ($v eq 'Pair') {
            'Pair::'
        } elsif ($v eq 'Instant') {
            'Seis::Instant::'
        } elsif ($v eq 'IO::Handle') {
            'IO::Handle::'
        } elsif ($v eq 'Bool::False') {
            'Bool::False()'
        } elsif ($v eq 'Bool::True') {
            'Bool::True()'
        } elsif ($v eq 'True') {
            'Bool::True()'
        } elsif ($v eq 'False') {
            'Bool::False()'
        } elsif ($v eq 'IO::Path::Cygwin') {
            'IO::Path::Cygwin::'
        } else {
            $v;
        }
    } elsif ($type == PVIP_NODE_FUNCALL) {
        if ($v->[0]->type == PVIP_NODE_IDENT) {
            # builtin functions
            if ($v->[0]->value eq 'shift' || $v->[0]->value eq 'pop') {
                # shift(@array)
                local $self->{args_list} = 1;
                sprintf('%s(%s)',
                    $self->do_compile($v->[0]),
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'elems') {
                # TODO You may optimize this function... elems(3) can be caluculate while compilation time.
                sprintf('Seis::Runtime::builtin_elems(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'eval') {
                my $is_perl5 = do {
                    my @args = @{$v->[1]->value};
                    if (@args==2) {
                        my $pair = $args[1];
                        if (
                            $pair->type == PVIP_NODE_PAIR
                            && $pair->value->[0]->value eq 'lang'
                            && $pair->value->[1]->value eq 'perl5'
                        ) {
                            1;
                        }
                    } else {
                        0;
                    }
                };
                if ($is_perl5) {
                    sprintf('CORE::eval(%s)',
                        $self->do_compile($v->[1]->value->[0]),
                    );
                } else {
                    join('',
                        'do {',
                        'my $__rg_compiler = Seis::Compiler->new();',
                        'my $__rg_compiled = $__rg_compiler->compile(',
                        $self->do_compile($v->[1]),
                        ');',
                        'my $__rg_ret = eval $__rg_compiled;',
                        'if ($@) {',
                            'Seis::Exception::CompilationFailed->throw("$@");',
                        '}',
                        '$__rg_ret;}',
                    );
                }
            } elsif ($v->[0]->value eq 'now') {
                'Seis::BuiltinFunctions::now()';
            } elsif ($v->[0]->value eq 'kv') {
                sprintf('(%s)->kv',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'list') {
                sprintf('List->new(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'copy') {
                sprintf('Seis::BuiltinFunctions::copy(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'reduce') {
                sprintf('Seis::BuiltinFunctions::reduce(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'gcd') {
                sprintf('Seis::BuiltinFunctions::gcd(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'chdir') {
                if (@{$v->[1]->value} == 0) {
                    Seis::Exception::CompilationFailed->throw(
                        'You need pass 1 argument for chdir function'
                    );
                }
                sprintf('CORE::chdir(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'connect') {
                sprintf('Seis::BuiltinFunctions::connect(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'any') {
                sprintf('Seis::BuiltinFunctions::any(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'get') {
                sprintf('Seis::BuiltinFunctions::get(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'sign') {
                sprintf('(%s)->sign',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'ords') {
                sprintf('Seis::BuiltinFunctions::ords(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'is-prime') {
                sprintf('Seis::BuiltinFunctions::is_prime(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'open') {
                sprintf('Seis::BuiltinFunctions::open(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'end') {
                # TODO support the 'list' style.
                sprintf('Seis::BuiltinFunctions::end(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'lines') {
                sprintf('Str::lines(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'slurp') {
                sprintf('Seis::BuiltinFunctions::slurp(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'hash') {
                sprintf('+{%s}',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'push') {
                # (funcall (ident "push") (args (variable "@a") (string "e")))
                if (
                    $v->[1]->type == PVIP_NODE_ARGS && @{$v->[1]->value}==2 && $v->[1]->value->[0]->type == PVIP_NODE_VARIABLE && $v->[1]->value->[0]->value =~ /\A\@/) {
                    sprintf('CORE::push(%s,%s)',
                        $self->do_compile($v->[1]->value->[0], G_ARRAY),
                        $self->do_compile($v->[1]->value->[1]),
                    );
                } else {
                    sprintf('CORE::push(%s)',
                        $self->do_compile($v->[1]),
                    );
                }
            } elsif ($v->[0]->value eq 'values') {
                # (args (variable "@array"))
                if (
                    $v->[1]->type == PVIP_NODE_ARGS && @{$v->[1]->value}==1 && $v->[1]->value->[0]->type == PVIP_NODE_VARIABLE && $v->[1]->value->[0]->value =~ /\A\@/) {
                    # values(@a)
                    if ($gimme == G_ARRAY) {
                        sprintf('CORE::values(%s)',
                            $self->do_compile($v->[1]->value->[0], G_ARRAY),
                        );
                    } else {
                        sprintf('[CORE::values(%s)]',
                            $self->do_compile($v->[1]->value->[0], G_ARRAY),
                        );
                    }
                } else {
                    sprintf('CORE::values(%s)',
                        $self->do_compile($v->[1]),
                    );
                }
            } elsif ($v->[0]->value eq 'keys') {
                # (args (variable "@array"))
                if (
                    $v->[1]->type == PVIP_NODE_ARGS && @{$v->[1]->value}==1 && $v->[1]->value->[0]->type == PVIP_NODE_VARIABLE && $v->[1]->value->[0]->value =~ /\A\@/) {
                    # keys(@a)
                    if ($gimme == G_ARRAY) {
                        sprintf('CORE::keys(%s)',
                            $self->do_compile($v->[1]->value->[0], G_ARRAY),
                        );
                    } else {
                        sprintf('[CORE::keys(%s)]',
                            $self->do_compile($v->[1]->value->[0], G_ARRAY),
                        );
                    }
                } else {
                    sprintf('CORE::keys(%s)',
                        $self->do_compile($v->[1]),
                    );
                }
            } elsif ($v->[0]->value eq 'getc') {
                sprintf('Seis::BuiltinFunctions::getc(%s)',
                    $self->do_compile($v->[1]),
                );
            } elsif ($v->[0]->value eq 'close') {
                sprintf('Seis::BuiltinFunctions::close(%s)',
                    $self->do_compile($v->[1]),
                );
            } else {
                sprintf('%s(%s)',
                    $self->do_compile($v->[0]),
                    $self->do_compile($v->[1]),
                );
            }
        } else {
            sprintf('(%s)->(%s)',
                $self->do_compile($v->[0]),
                $self->do_compile($v->[1]),
            );
        }
    } elsif ($type == PVIP_NODE_ARGS) {
        my @args = map {
            if ($_->type == PVIP_NODE_IDENT && $_->value eq 'Hash') {
                'Seis::Hash::'
            } elsif ($_->type == PVIP_NODE_IDENT && $_->value eq 'Array') {
                'Array::'
            } elsif ($_->type == PVIP_NODE_IDENT && $_->value eq 'IO::Path') {
                'IO::Path::'
            } elsif ($_->type == PVIP_NODE_IDENT && $_->value eq 'True') {
                'Bool::True()'
            } elsif ($_->type == PVIP_NODE_IDENT && $_->value eq 'False') {
                'Bool::False()'
            } elsif ($_->type == PVIP_NODE_IDENT) {
                my $v = $_->value;
                $v =~ s/\A:://;
                sprintf('Seis::Class->_new(name => %s)', $self->compile_string($v));
            } elsif ($_->type == PVIP_NODE_VARIABLE && $_->value =~ /\A\@/) {
                my $v = $_->value;
                $v =~ s/−/ー/g;
                "\\$v";
            } else {
                $self->do_compile($_)
            }
        } @$v;
        if ($self->{args_list}) {
            join(",", map { "$_" } @args);
        } else {
            join(",", map { "scalar($_)" } @args);
        }
    } elsif ($type == PVIP_NODE_STRING) {
        $self->compile_string($v);
    } elsif ($type == PVIP_NODE_MOD) {
        sprintf('(%s)%%(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_VARIABLE) {
        $v =~ s!-!ー!g;
        $v;
    } elsif ($type == PVIP_NODE_MY) {
        if (@$v==1) {
            # (my (list (variable "$a") (variable "$b") (variable "$c")))
            if ($v->[0]->type == PVIP_NODE_LIST) {
                sprintf('my (%s)',
                    join(',', map { $self->do_compile($_) } @{$v->[0]->value})
                );
            } else {
                die "NYI: (1)" . $node->as_sexp
            }
        } else {
            my ($type, $vars) = @$v;
            if ($vars->type == PVIP_NODE_VARIABLE) {
                # (my (nop) (variable "$i"))
                sprintf('my %s',
                    $self->do_compile($vars)
                );
            } elsif ($vars->type == PVIP_NODE_FUNC) {
                # (my (nop) (func (ident "vtest") (params (param (nop) (variable "$cmp") (nop)) (param (vargs (variable "@v")))) (nop) (block (statements (list_assignment (my (nop) (variable "$x")) (funcall (ident "shift") (args (variable "@v")))) (while (variable "@v") (block (statements (list_assignment (my (nop) (variable "$y")) (funcall (ident "shift") (args (variable "@v")))) (funcall (ident "is") (args (cmp (methodcall (ident "Version") (ident "new") (args (variable "$x"))) (methodcall (ident "Version") (ident "new") (args (variable "$y")))) (variable "$cmp") (string_concat (string_concat (string_concat (string_concat (string_concat (string "") (variable "$x")) (string " cmp ")) (variable "$y")) (string " is ")) (variable "$cmp")))) (list_assignment (variable "$x") (variable "$y")))))))))
                sprintf('my %s', $self->do_compile($vars));
            } elsif ($vars->type == PVIP_NODE_LIST) {
                # my ($a, $b);
                sprintf('my %s', $self->do_compile($vars, G_ARRAY));
            } else {
                die "NYI: " . $node->as_sexp
            }
        }
    } elsif ($type == PVIP_NODE_OUR) {
        my @vars = map { $self->do_compile($_) } @$v;
        sprintf('our (%s)',
            join(',', map { "($_)" } @vars)
        );
    } elsif ($type == PVIP_NODE_BIND) {
        # TODO: This may not compatible with Perl6.
        sprintf('%s=(%s)',
            $self->do_compile($v->[0], G_ARRAY),
            $self->do_compile($v->[1], G_ARRAY),
        );
    } elsif ($type == PVIP_NODE_LIST_ASSIGNMENT) {
        sprintf('%s=(%s)',
            $self->do_compile($v->[0], G_ARRAY),
            $self->do_compile($v->[1],
                $self->is_list_lvalue($v->[0]) ? G_ARRAY : G_SCALAR
            ),
        );
    } elsif ($type == PVIP_NODE_STRING_CONCAT) {
        sprintf('(%s).(%s)',
            $v->[0]->type == PVIP_NODE_STATEMENTS ? $self->do_compile($v->[0]->value->[0]) : $self->do_compile($v->[0]),
            $v->[1]->type == PVIP_NODE_STATEMENTS ? $self->do_compile($v->[1]->value->[0]) : $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_IF) {
        # (if (int 1) (statements (int 5)) (else (int 4)))
        my $ret = 'if (' . $self->do_compile($v->[0]) . ') {' . $self->do_compile($v->[1]) . '}';
        shift @$v; shift @$v;
        while (@$v) {
            $ret .= $self->do_compile(shift @$v);
        }
        $ret;
    } elsif ($type == PVIP_NODE_EQV) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_EQV is not implemented")
    } elsif ($type == PVIP_NODE_ARRAY) {
        sprintf('[%s]',
            join(',', map { "($_)" } map { $self->do_compile($_, G_ARRAY) } @$v)
        );
    } elsif ($type == PVIP_NODE_ATPOS) {
        my $invocant = $self->do_compile($v->[0]);
        my $pos = $self->do_compile($v->[1]);
        if (
            ($v->[0]->type == PVIP_NODE_VARIABLE && $v->[0]->value =~ /\A@/)
        ) {
            # @a[0]
            sprintf('%s[(%s)]',
                $invocant,
                $pos,
            );
        } else {
            # $a[0]
            sprintf('(%s)->[(%s)]',
                $invocant,
                $pos,
            );
        }
    } elsif ($type == PVIP_NODE_METHODCALL) {
        my $invocant = $self->do_compile($v->[0]);
        if ($v->[0]->type != PVIP_NODE_IDENT) {
            $invocant = "($invocant)";
        }

        my $method = $self->do_compile($v->[1]);
        my $params = defined($v->[2]) ? $self->do_compile($v->[2]) : '';

        $method =~ s!-!ー!g;

        if ($v->[0]->type == PVIP_NODE_WHATEVER) {
            return sprintf('(sub { shift->%s(%s) })',
                $method,
                $params
            );
        }

        if ($v->[1]->type == PVIP_NODE_STRING || $v->[1]->type == PVIP_NODE_STRING_CONCAT) {
            sprintf('%s->${\(%s)}(%s)',
                $invocant,
                $method,
                $params,
            );
        } else {
            sprintf('%s->%s(%s)',
                $invocant,
                $method,
                $params,
            );
        }
    } elsif ($type == PVIP_NODE_FUNC) {
        my $name = $self->do_compile($v->[0]);
        my $exportable = $v->[2]->type == PVIP_NODE_EXPORT;

        my $ret = '';
        $ret .= "sub $name {";
        $ret .= "\n"; $self->{line_number}++;
        $ret .= $self->do_compile($v->[1]);
        $ret .= $self->do_compile($v->[3]);
        $ret .= "}\n"; $self->{line_number}++;
        if ($exportable) {
            $ret .= sprintf("push \@__RG_EXPORT, %s;", $self->compile_string($name));
        }
        $ret;
    } elsif ($type == PVIP_NODE_PARAMS) {
        # (params (param (nop) (variable "$n") (nop)))
        # (params (param (ident "Int") (variable "$n") (nop) (int 0)))
        my $ret = '';
        my $is_vargs = 0;
        my $min_args = 0;
        my $max_args = 0;
        for my $param (@$v) {
            $ret .= $self->do_compile($param) . ";";
            if ($param->value->[1]->type == PVIP_NODE_VARGS) {
                $is_vargs++;
            } else {
                if ($param->value->[2] == PVIP_NODE_NOP) {
                    # no default value.
                    $min_args++;
                    $max_args++;
                } else {
                    # has default value.
                    $max_args++;
                }
                if ($param->value->[0]->type == PVIP_NODE_IDENT) {
                    my $type = $self->compile_string($param->value->[0]->value);
                    $ret .= sprintf('Seis::Exception::ArgumentType->throw("invalid argument type(expected %s)") unless %s->isa(%s);', $param->value->[0]->value, $param->value->[1]->value, $type);
                }
            }
        }
        unless ($is_vargs) {
            $ret .= sprintf('Seis::Exception::ArgumentCount->throw("Invalid argument count(Expected %d to %d but " . (0+@_) . ")") unless %d <= @_ && @_<=%d;', $min_args, $max_args, $min_args, $max_args);
        }
        $ret .= "undef;";
    } elsif ($type == PVIP_NODE_PARAM) {
        # (params (param (nop) (variable "$n") (nop)))
        # (param (nop) (vargs (variable "@a")) (nop) (int 0))
        if (@$v==4) {
            if ($v->[1]->type == PVIP_NODE_VARGS) {
                sprintf('%s;', $self->do_compile($v->[1]));
            } elsif ($v->[1]->value =~ /\A\@/) {
                # (param (ident "Int") (variable "$x") (nop))
                sprintf('my %s=@_;', $self->do_compile($v->[1]));
            } else {
                sprintf('my %s=shift;', $self->do_compile($v->[1]));
            }
        } else {
            die "Should not reach here : " . $node->as_sexp;
        }
    } elsif ($type == PVIP_NODE_RETURN) {
        'return (' . join(',', map { "($_)" } map {$self->do_compile($_)} @$v) . ')';
    } elsif ($type == PVIP_NODE_ELSE) {
        'else { ' . join(';', map { $self->do_compile($_) } @$v) . '}';
    } elsif ($type == PVIP_NODE_WHILE) {
        sprintf("while (%s) %s",
            $self->do_compile($v->[0]),
            $self->maybe_block($v->[1]));
    } elsif ($type == PVIP_NODE_UNTIL) {
        sprintf("until (%s) %s",
            $self->do_compile($v->[0]),
            $self->maybe_block($v->[1]));
    } elsif ($type == PVIP_NODE_DIE) {
        sprintf('die (%s)', $self->do_compile($v->[0]));
    } elsif ($type == PVIP_NODE_ELSIF) {
        sprintf('elsif (%s) { %s }', $self->do_compile($v->[0]), $self->do_compile($v->[1]));
    } elsif ($type == PVIP_NODE_NOW) {
        'Seis::BuiltinFunctions::now()'
    } elsif ($type == PVIP_NODE_RAND) {
        'rand()'
    } elsif ($type == PVIP_NODE_TIME) {
        'time()'
    } elsif ($type == PVIP_NODE_LIST) {
        if ($gimme == G_SCALAR) {
            # In scalar context, create arrayref automatically.
            sprintf('[%s]',
                join(',', map { "($_)" } map { $self->do_compile($_) } @$v)
            );
        } else {
            sprintf('(%s)',
                join(',', map { "($_)" } map { $self->do_compile($_, G_ARRAY) } @$v)
            );
        }
    } elsif ($type == PVIP_NODE_FOR) {
        my $iteratee = $self->do_compile($v->[0], G_ARRAY);
        if ($v->[1]->type == PVIP_NODE_LAMBDA) {
            # (for (list (int 1) (int 2) (int 3)) (lambda (params (param (nop) (variable "$x") (nop))) (statements (inplace_add (variable "$i") (variable "$x")))))
            # (for (variable "@list") (lambda (params) (block (statements (funcall (ident "isnt") (args (variable "$_") (string "a") (string "$_ does not get set implicitly if a pointy is given")))))))
            my $varname = $v->[1]->value->[0]->value->[0]->value->[1]->value;
            sprintf('for my %s (%s) %s',
                $varname,
                $iteratee,
                $self->maybe_block($v->[1]->value->[1])
            );
        } else {
            sprintf('for (%s) %s',
                $iteratee,
                $self->maybe_block($v->[1])
            );
        }
    } elsif ($type == PVIP_NODE_UNLESS) {
        my $ret = 'unless (' . $self->do_compile($v->[0]) . ') {' . $self->do_compile($v->[1]) . '}';
        shift @$v; shift @$v;
        while (@$v) {
            $ret .= $self->do_compile(shift @$v);
        }
        $ret;
    } elsif ($type == PVIP_NODE_NOT) {
        if ($self->is_array_variable($v->[0])) {
            sprintf('!(0+%s)',
                $self->do_compile($v->[0]->value)
            );
        } else {
            # I want to do this with PL_check hack.
            sprintf('Seis::Runtime::_not(%s)',
                $self->do_compile($v->[0])
            );
        }
    } elsif ($type == PVIP_NODE_CONDITIONAL) {
        sprintf('(%s)?(%s):(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
            $self->do_compile($v->[2]),
        );
    } elsif ($type == PVIP_NODE_NOP) {
        return "()";
    } elsif ($type == PVIP_NODE_POW) {
        sprintf('(%s)**(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_CLARGS) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_CLARGS is not implemented")
    } elsif ($type == PVIP_NODE_HASH) {
        if ($gimme == G_ARRAY) {
            '(' .  join(',', map { $self->do_compile($_, G_ARRAY) } @$v) . ')';
        } else {
            '{' . join(',', map { $self->do_compile($_, G_ARRAY) } @$v) . '}';
        }
    } elsif ($type == PVIP_NODE_PAIR) {
        if ($gimme == G_SCALAR) {
            sprintf('Pair->_new(scalar(%s),scalar(%s))',
                $v->[0]->type == PVIP_NODE_IDENT ? $self->compile_string($v->[0]) : $self->do_compile($v->[0]),
                $self->do_compile($v->[1]),
            );
        } else {
            my $key = $v->[0]->type == PVIP_NODE_IDENT
                ? $self->compile_string($v->[0]->value)
                : $self->do_compile($v->[0]);
            sprintf('(%s)=>scalar(%s)',
                $key,
                $self->do_compile($v->[1]),
            );
        }
    } elsif ($type == PVIP_NODE_ATKEY) {
        if ($v->[0]->type == PVIP_NODE_VARIABLE && $v->[0]->value =~ /\A%/) {
            my $target = $self->do_compile($v->[0]);
            $target =~ s/\A%/\$/;
            sprintf('%s{(%s)}',
                $target,
                $self->do_compile($v->[1]),
            );
        } elsif ($v->[0]->type == PVIP_NODE_VARIABLE && $v->[0]->value =~ /\A\$/) {
            sprintf('(%s)->{(%s)}',
                $self->do_compile($v->[0]),
                $self->do_compile($v->[1]),
            );
        } elsif ($v->[0]->type == PVIP_NODE_TW_ENV || ($v->[0]->type == PVIP_NODE_VARIABLE && $v->[0]->value =~ /\A$/)) {
            sprintf('(%s)->{(%s)}',
                $self->do_compile($v->[0]),
                $self->do_compile($v->[1]),
            );
        } else {
            sprintf('(%s){(%s)}',
                $self->do_compile($v->[0]),
                $self->do_compile($v->[1]),
            );
        }
    } elsif ($type == PVIP_NODE_LOGICAL_AND) {
        sprintf('(%s)&&(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_LOGICAL_OR) {
        sprintf('(%s)||(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_LOGICAL_XOR) {
        sprintf('do { my $a = (%s); my $b = (%s); if ($a) { $b ? !!0 : $a } else { $b ? $b : !!0 } }',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_BIN_AND) {
        sprintf('(%s)&(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_BIN_OR) {
        sprintf('(%s)|(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_BIN_XOR) {
        sprintf('(%s)^(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_BLOCK) {
        my $ret = '';
        # $ret .= sprintf("# %d %d\n", $node->line_number, $self->{line_number});
        if (@$v) {
            $ret .= '{' . $self->do_compile($v->[0]) . '}';
        } else {
            $ret .= '{ }';
        }
        $ret;
    } elsif ($type == PVIP_NODE_LAMBDA) {
        # (lambda (params (param (nop) (variable "$n") (nop))) (statements (mul (variable "$n") (int 2))))
        # (lambda (block (statements (logical_or (chain (mod (variable "$_") (int 3)) (eq (int 0))) (chain (mod (variable "$_") (int 5)) (eq (int 0)))))))
        if (@$v==1) {
            if ($v->[0]->type == PVIP_NODE_BLOCK) {
                my $ret = 'sub ';
                $ret .= $self->do_compile($v->[0]);
                $ret;
            } elsif ($v->[0]->type == PVIP_NODE_HASH) {
                # (lambda (hash (pair (ident "out") (string "(IO)\n"))))
                my $ret = 'sub ';
                $ret .= $self->do_compile($v->[0]);
                $ret;
            } else {
                ...
            }
        } else {
            my $ret = 'sub {';
            $ret .= $self->do_compile($v->[0]);
            $ret .= $self->do_compile($v->[1]);
            $ret .= "}";
            $ret;
        }
    } elsif ($type == PVIP_NODE_USE) {
        if ($v->[0]->value eq 'v6') {
            $self->{line_number}++;
            "# use v6;\n";
        } else {
            'use ' . $self->do_compile($v->[0]);
        }
    } elsif ($type == PVIP_NODE_MODULE) {
        sprintf('package %s; our @__RG_EXPORT; use parent qw(Seis::Exporter);', $v->[0]->value);
    } elsif ($type == PVIP_NODE_CLASS) {
        # (class (ident "Foo7") (nop) (statements (method (ident "bar") (nop) (statements (int 5963)))))
        # (class (ident "Foo8") (list (is (ident "Foo7"))) (statements))
        state $ANON_CLASS = 0;
        my $pkg = $v->[0]->type == PVIP_NODE_NOP ? "Seis::_AnonClass" . $ANON_CLASS++ : $self->do_compile($v->[0]);
        my $retval = $gimme == G_VOID ? '' : "Seis::Class->_new(name => '$pkg')";
        my $body = $self->do_compile($v->[2]);
        if ($body eq '{ }') {
            $body = '';
        }
        sprintf(q!do {
            package %s;
            BEGIN {
                our @ISA;
                unshift @ISA, "Seis::Object";
                %s;
            }
            %s;
            %s
        }!, $pkg, join(";\n", map { $self->do_compile($_) } @{$v->[1]->value}), $body, $retval);
    } elsif ($type == PVIP_NODE_METHOD) {
        # (method (ident "bar") (nop) (statements))
        # TODO: support arguments
        # (method (ident "bar") (params (param (nop) (variable "$n") (nop))) (statements (mul (variable "$n") (int 3))))
        my $name = $self->do_compile($v->[0]);
        join('',
            'sub ' . $name . ' {',
            'my $self=shift;',
            $self->do_compile($v->[1]),
            ';undef;',
            $self->do_compile($v->[2]),
            ';}'
        );
    } elsif ($type == PVIP_NODE_UNARY_PLUS) {
        if ($v->[0]->type == PVIP_NODE_LIST) {
            sprintf('0+@{[%s]}', $self->do_compile($v->[0], G_ARRAY));
        } else {
            sprintf('(%s)->Int()', $self->do_compile($v->[0]));
        }
    } elsif ($type == PVIP_NODE_UNARY_MINUS) {
        sprintf('-(%s)', $self->do_compile($v->[0]));
    } elsif ($type == PVIP_NODE_IT_METHODCALL) {
        sprintf('$_->%s(%s)',
            $self->do_compile($v->[0]),
            defined($v->[1]) ? $self->do_compile($v->[1]) : '',
        );
    } elsif ($type == PVIP_NODE_LAST) {
        'last';
    } elsif ($type == PVIP_NODE_NEXT) {
        'next';
    } elsif ($type == PVIP_NODE_REDO) {
        'redo';
    } elsif ($type == PVIP_NODE_POSTINC) {
        sprintf('(%s)++',
            $self->do_compile($v->[0]),
        );
    } elsif ($type == PVIP_NODE_POSTDEC) {
        sprintf('(%s)--',
            $self->do_compile($v->[0]),
        );
    } elsif ($type == PVIP_NODE_PREINC) {
        sprintf('++(%s)',
            $self->do_compile($v->[0]),
        );
    } elsif ($type == PVIP_NODE_PREDEC) {
        sprintf('--(%s)',
            $self->do_compile($v->[0]),
        );
    } elsif ($type == PVIP_NODE_UNARY_BITWISE_NEGATION) {
        sprintf('~(%s)',
            $self->do_compile($v->[0]),
        );
    } elsif ($type == PVIP_NODE_BRSHIFT) {
        sprintf('(%s)>>(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_BLSHIFT) {
        sprintf('(%s)<<(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_CHAIN) {
        my $compile = sub {
            my ($lhs, $type, $rhs) = @_;
            my $op = +{
                PVIP_NODE_EQ() => '==',
                PVIP_NODE_NE() => '!=',
                PVIP_NODE_LT() => '<',
                PVIP_NODE_LE() => '<=',
                PVIP_NODE_GT() => '>',
                PVIP_NODE_GE() => '>=',
                PVIP_NODE_STREQ() => 'eq',
                PVIP_NODE_STRNE() => 'ne',
                PVIP_NODE_STRNE() => 'ne',
                PVIP_NODE_STRGT() => 'gt',
                PVIP_NODE_STRGE() => 'ge',
                PVIP_NODE_STRLT() => 'lt',
                PVIP_NODE_STRLE() => 'le',
                PVIP_NODE_EQV()   => 'eq', # TODO
                PVIP_NODE_SMART_MATCH()   => '~~',
            }->{$type};
            if ($type == PVIP_NODE_NOT_SMART_MATCH) {
                # Perl5 does not support `!~~` operator!
                sprintf("(!((%s)~~(%s)))", $lhs, $rhs);
            } else {
                unless ($op) {
                    Seis::Exception::NotImplemented->throw(sprintf "PVIP_NODE_%s is not implemented in chaning", $type)
                }
                sprintf("(%s)%s(%s)", $lhs, $op, $rhs);
            }
        };
        if (@$v == 1) {
            return $self->do_compile($v->[0]);
        } elsif (@$v == 2) {
            # optimized for simple case
            $compile->(
                $self->do_compile($v->[0]),
                $v->[1]->type,
                $self->do_compile($v->[1]->value->[0]),
            );
        } else {
            my $ret = 'do { my $_rg_chain_ret = 1; my $_rg_chain_rhs; my $_rg_chain_lhs = ';
            $ret .= $self->do_compile(shift @$v);
            $ret .= ';';

            while (my $rhs_node = shift @$v) {
                $ret .= sprintf('$_rg_chain_rhs=%s;', $self->do_compile($rhs_node->value->[0]));
                $ret .= sprintf('unless (%s) { $_rg_chain_ret=0; goto _RG_CHAIN_END; }', $compile->('$_rg_chain_lhs', $rhs_node->type, '$_rg_chain_rhs'));
                $ret .= '$_rg_chain_lhs=$_rg_chain_rhs;';
            }
            $ret .= '_RG_CHAIN_END: $_rg_chain_ret; }';
            return $ret;
        }
    } elsif ($type == PVIP_NODE_INPLACE_ADD) {
        '(' . $self->do_compile($v->[0]) . ')+=(' . $self->do_compile($v->[1]) . ')';
    } elsif ($type == PVIP_NODE_INPLACE_SUB) {
        '(' . $self->do_compile($v->[0]) . ')-=(' . $self->do_compile($v->[1]) . ')';
    } elsif ($type == PVIP_NODE_INPLACE_MUL) {
        '(' . $self->do_compile($v->[0]) . ')*=(' . $self->do_compile($v->[1]) . ')';
    } elsif ($type == PVIP_NODE_INPLACE_DIV) {
        '(' . $self->do_compile($v->[0]) . ')/=(' . $self->do_compile($v->[1]) . ')';
    } elsif ($type == PVIP_NODE_INPLACE_POW) {
        '(' . $self->do_compile($v->[0]) . ')**=(' . $self->do_compile($v->[1]) . ')';
    } elsif ($type == PVIP_NODE_INPLACE_MOD) {
        '(' . $self->do_compile($v->[0]) . ')%=(' . $self->do_compile($v->[1]) . ')';
    } elsif ($type == PVIP_NODE_INPLACE_BIN_OR) {
        sprintf('(%s)|=(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_INPLACE_BIN_AND) {
        sprintf('(%s)&=(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_INPLACE_BIN_XOR) {
        sprintf('(%s)^=(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_INPLACE_BLSHIFT) {
        sprintf('(%s)<<=(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_INPLACE_BRSHIFT) {
        sprintf('(%s)>>=(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_INPLACE_CONCAT_S) {
        '(' . $self->do_compile($v->[0]) . ').=(' . $self->do_compile($v->[1]) . ')';
    } elsif ($type == PVIP_NODE_REPEAT_S) {
        '(' . $self->do_compile($v->[0]) . ')x(' . $self->do_compile($v->[1]) . ')';
    } elsif ($type == PVIP_NODE_INPLACE_REPEAT_S) {
        '(' . $self->do_compile($v->[0]) . ')x=(' . $self->do_compile($v->[1]) . ')';
    } elsif ($type == PVIP_NODE_STRINGIFY) {
        # STRINGIFY, stringification
        if ($self->is_array_variable($v->[0]) || $v->[0]->type == PVIP_NODE_LIST) {
            sprintf(q{join(' ', (%s))}, $self->do_compile($v->[0], G_ARRAY));
        } else {
            sprintf(q{(%s)->Str()}, $self->do_compile($v->[0]));
        }
    } elsif ($type == PVIP_NODE_TRY) {
        "eval " . $self->do_compile($v->[0]);
    } elsif ($type == PVIP_NODE_REF) {
        sprintf(q{\(%s)}, $self->do_compile($v->[0]));
    } elsif ($type == PVIP_NODE_MULTI) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_MULTI is not implemented")
    } elsif ($type == PVIP_NODE_UNARY_BOOLEAN) {
        sprintf 'Seis::Runtime::boolean(%s)', $self->do_compile($v->[0]);
    } elsif ($type == PVIP_NODE_UNARY_UPTO) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_UNARY_UPTO is not implemented")
    } elsif ($type == PVIP_NODE_ARRAY_DEREF) {
        '@{' . $self->do_compile($v->[0]) . '}';
    } elsif ($type == PVIP_NODE_STDOUT) {
        '*STDOUT'
    } elsif ($type == PVIP_NODE_STDERR) {
        '*STDERR'
    } elsif ($type == PVIP_NODE_SCALAR_DEREF) {
        '${' . $self->do_compile($v->[0]) . '}';
    } elsif ($type == PVIP_NODE_TW_ENV) {
        '(\%ENV)'
    } elsif ($type == PVIP_NODE_TW_TMPDIR) {
        'IO::Path->new(File::Spec->tmpdir())'
    } elsif ($type == PVIP_NODE_TW_INC) {
        if ($gimme == G_SCALAR) {
            '\\@Seis::INC';
        } else {
            '@Seis::INC';
        }
    } elsif ($type == PVIP_NODE_META_METHOD_CALL) {
        # (meta_method_call (class (nop) (nop) (statements)) (ident "methods") (nop))
        sprintf('(%s)->meta()->%s(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
            $self->do_compile($v->[2]),
        );
    } elsif ($type == PVIP_NODE_REGEXP) {
        $self->compile_regexp($v);
    } elsif ($type == PVIP_NODE_SMART_MATCH) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_SMART_MATCH is not implemented")
    } elsif ($type == PVIP_NODE_NOT_SMART_MATCH) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_NOT_SMART_MATCH is not implemented")
    } elsif ($type == PVIP_NODE_PERL5_REGEXP) {
        sprintf('qr!%s!', $v);
    } elsif ($type == PVIP_NODE_FALSE) {
        '(Bool::false())'
    } elsif ($type == PVIP_NODE_TRUE) {
        '(Bool::True())'
    } elsif ($type == PVIP_NODE_TW_VM) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_TW_VM is not implemented")
    } elsif ($type == PVIP_NODE_HAS) {
        # (has (public_attribute "x"))
        # support private variable
        if ($v->[0]->type == PVIP_NODE_ATTRIBUTE_VARIABLE) {
            sprintf(q!__PACKAGE__->meta->add_attribute(%s)!, $self->compile_string($v->[0]->value));
        } else {
            die "Should not reach here";
        }
    } elsif ($type == PVIP_NODE_ATTRIBUTE_VARIABLE) {
        # (public_attribute "x")
        sprintf('$self->{%s}', $self->compile_string($v));
    } elsif ($type == PVIP_NODE_FUNCREF) {
        sprintf('\&%s', $self->do_compile($v->[0]));
    } elsif ($type == PVIP_NODE_PATH) {
        sprintf('IO::Path->new(%s)',
            $self->compile_string($node)
        );
    } elsif ($type == PVIP_NODE_TW_PACKAGE) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_TW_PACKAGE is not implemented")
    } elsif ($type == PVIP_NODE_TW_CLASS) {
        'Seis::MetaClass->new(name => __PACKAGE__)'
    } elsif ($type == PVIP_NODE_TW_MODULE) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_TW_MODULE is not implemented")
    } elsif ($type == PVIP_NODE_TW_OS) {
        '($^O)';
    } elsif ($type == PVIP_NODE_E) {
        '(exp(1))';
    } elsif ($type == PVIP_NODE_TW_PID) {
        '($$)';
    } elsif ($type == PVIP_NODE_TW_PERLVER) {
        '6'
    } elsif ($type == PVIP_NODE_TW_OSVER) {
       'do {require Config; $Config::Config{osvers} }';
    } elsif ($type == PVIP_NODE_TW_CWD) {
        '(IO::Path->new(Cwd::getcwd()))'
    } elsif ($type == PVIP_NODE_TW_EXECUTABLE_NAME) {
        '($0)'
    } elsif ($type == PVIP_NODE_TW_ROUTINE) {
        'Sub->_new(__SUB__)';
    } elsif ($type == PVIP_NODE_SLANGS) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_SLANGS is not implemented")
    } elsif ($type == PVIP_NODE_LOGICAL_ANDTHEN) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_LOGICAL_ANDTHEN is not implemented")
    } elsif ($type == PVIP_NODE_VALUE_IDENTITY) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_VALUE_IDENTITY is not implemented")
    } elsif ($type == PVIP_NODE_CMP) {
        sprintf('(%s)cmp(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_SPECIAL_VARIABLE_REGEXP_MATCH) {
        '@Seis::Runtime::REGEXP_MATCH'
    } elsif ($type == PVIP_NODE_SPECIAL_VARIABLE_EXCEPTIONS) {
        # Perl5's $@ contains "" if there is no errors.
        # It's incompatible with Perl6.
        '($@ ? $@ : undef)';
    } elsif ($type == PVIP_NODE_ENUM) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_ENUM is not implemented")
    } elsif ($type == PVIP_NODE_NUM_CMP) {
        sprintf('(%s)<=>(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_UNARY_FLATTEN_OBJECT) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_UNARY_FLATTEN_OBJECT is not implemented")
    } elsif ($type == PVIP_NODE_COMPLEX) {
        sprintf('Seis::Complex->_new(%s)', $self->compile_string($v));
    } elsif ($type == PVIP_NODE_ROLE) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_ROLE is not implemented")
    } elsif ($type == PVIP_NODE_IS) {
        # (is (ident "Foo7"))
        sprintf q!push @ISA, '%s'!, $self->do_compile($v->[0]);
    } elsif ($type == PVIP_NODE_DOES) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_DOES is not implemented")
    } elsif ($type == PVIP_NODE_JUNCTIVE_AND) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_JUNCTIVE_AND is not implemented")
    } elsif ($type == PVIP_NODE_JUNCTIVE_SAND) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_JUNCTIVE_SAND is not implemented")
    } elsif ($type == PVIP_NODE_JUNCTIVE_OR) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_JUNCTIVE_OR is not implemented")
    } elsif ($type == PVIP_NODE_UNICODE_CHAR) {
        sprintf(q!"\N{%s}"!, $v);
    } elsif ($type == PVIP_NODE_STUB) {
        '...';
    } elsif ($type == PVIP_NODE_EXPORT) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_EXPORTABLE is not implemented")
    } elsif ($type == PVIP_NODE_BITWISE_OR) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_BITWISE_OR is not implemented")
    } elsif ($type == PVIP_NODE_BITWISE_AND) {
        sprintf('(%s)&(%s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_BITWISE_XOR) {
        Seis::Exception::NotImplemented->throw("PVIP_NODE_BITWISE_XOR is not implemented")
    } elsif ($type == PVIP_NODE_VARGS) {
        # (vargs (variable "@a"))
        sprintf('my %s = @_;', $self->do_compile($v->[0]));
    } elsif ($type == PVIP_NODE_TW_A) {
        '($Seis::Runtime::TW_A)';
    } elsif ($type == PVIP_NODE_TW_B) {
        '($Seis::Runtime::TW_B)';
    } elsif ($type == PVIP_NODE_TW_C) {
        '($Seis::Runtime::TW_C)';
    } elsif ($type == PVIP_NODE_WHATEVER) {
        '(Seis::Whatever->new())';
    } elsif ($type == PVIP_NODE_NEED) {
        sprintf("BEGIN { require %s }", $self->do_compile($v->[0]));
    } elsif ($type == PVIP_NODE_END) {
        "END " . $self->do_compile($v->[0]);
    } elsif ($type == PVIP_NODE_GCD) {
        sprintf('Seis::BuiltinFunctions::gcd(%s, %s)',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1]),
        );
    } elsif ($type == PVIP_NODE_BEGIN) {
        "BEGIN " . $self->do_compile($v->[0]);
    } elsif ($type == PVIP_NODE_PACKAGE) {
        sprintf('package %s %s',
            $self->do_compile($v->[0]),
            $self->do_compile($v->[1])
        );
    } else {
        Seis::Exception::UnknownNode->throw(
             ("Unknown node: PVIP_NODE_" . uc($node->name))
        );
    }
}

sub binop {
    my ($self, $op, $v) = @_;
    sprintf('(%s)%s(%s)',
        $self->do_compile($v->[0]),
        $op,
        $v,
        $self->do_compile($v->[1]),
    );
}

sub maybe_block {
    my ($self, $node) = @_;
    if ($node->type == PVIP_NODE_BLOCK) {
        return $self->do_compile($node);
    } else {
        return '{' . $self->do_compile($node) . "}";
    }
}

sub compile_string{
    my ($self, $v) = @_;

    local $Data::Dumper::Terse = 1;
    local $Data::Dumper::Useqq = 1;
    local $Data::Dumper::Purity = 1;
    local $Data::Dumper::Indent = 0;
    Data::Dumper::Dumper(Encode::decode_utf8($v));
}

sub is_list_lvalue {
    my ($self, $node) = @_;
    my $is_list_var = sub {
        my $c = shift;
        return $c->type == PVIP_NODE_VARIABLE && $c->value =~ /\A[%@]/;
    };
    if ($node->type == PVIP_NODE_MY) {
        # my, nop, list
        # my, nop, var
        if (@{$node->value}==2) {
            my $c = $node->value->[1];
            if ($is_list_var->($c)) {
                # my @x = ...
                1
            } elsif ($c->type == PVIP_NODE_LIST) {
                # my ($x, $y) = ...
                1
            } elsif ($c->type == PVIP_NODE_TW_INC) {
                1; # @*INC
            } else {
                # my $x = ...
                0
            }
        } elsif (@{$node->value}==1) {
            my $c = $node->value->[0];
            if ($c->type == PVIP_NODE_LIST) {
                1
            } elsif ($c->type == PVIP_NODE_TW_INC) {
                1; # @*INC
            } else {
                0;
            }
        } else {
            0;
        }
    } else {
        # @x = ...
        if ($is_list_var->($node)) {
            # my @x = ...
            1
        } elsif ($node->type == PVIP_NODE_TW_INC) {
            1; # @*INC
        } else {
            # my $x = ...
            0
        }
    }
}

sub compile_regexp {
    my ($class, $regexp) = @_;
    my $ret = '';
    while (length($regexp)) {
        if ($regexp =~ s/\A//) {
            $ret .= '\p{PosixAlpha}';
        } elsif ($regexp =~ s/\A +//) {
            next;
        } elsif ($regexp =~ s/\A!//) {
            $ret .= '\!';
        } elsif ($regexp =~ s/\A(.)//s) {
            $ret .= $1;
        } else {
            die "Should not reache here: " . Data::Dumper::Dumper($regexp);
        }
    }
    sprintf('qr!%s!sxp', $ret);
}

sub is_array_variable {
    my ($self, $node) = @_;
    return $node->type == PVIP_NODE_VARIABLE && $node->value =~ /\A\@/;
}

1;