The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use perl5:Code::Perl::Expr (":easy");

use Perl::Compiler::CodeGen::NameGen;

class Perl::Compiler::CodeGen::Perl5_Str
    does Perl::Compiler::CodeGen {

    my $INS = 'Perl6::Internals';

    method generate (Perl::Compiler::PIL::PIL $tree is rw) {
        my $ng = ::Perl::Compiler::CodeGen::NameGen.new(template => { "\$P_$_" });
        say "{self} / $.WHAT()";
        self.gen($tree, $ng);
    }

    method gen (Perl::Compiler::PIL::PIL $tree is rw, PIL::Compiler::CodeGen::NameGen $ng is rw) {
        my $ret = do given $tree {
            say "Processing $tree / $tree.WHAT()";
            
            when ::Perl::Compiler::PIL::PILNil    { "; # Nil\n" }

            when ::Perl::Compiler::PIL::PILNoop   { "; # Noop\n" }
            
            when ::Perl::Compiler::PIL::PILLit    { self.gen(.value, $ng) }

            when ::Perl::Compiler::PIL::PILExp    { self.gen(.value, $ng) }

            when ::Perl::Compiler::PIL::PILPos    { self.gen(.value, $ng) }

            when ::Perl::Compiler::PIL::PILStmt   { self.gen(.value, $ng.fork('expr')) ~ $ng.r('expr') }

            when ::Perl::Compiler::PIL::PILThunk  { 
                $ng.ret("$INS\::p5_make_thunk( sub () \{ { self.gen(.value) } } )");  ''
            }

            when ::Perl::Compiler::PIL::PILCode   { 
                my $inner = self.gen(.statements);
                $ng.ret("$INS\::p5_make_code( sub \{ { 
                    (join "\n", map { 
                        "my " ~ self.pad_var($_)
                    }, $tree.pads)
                    ~ $inner
                } } )");  ''
            }

            when ::Perl::Compiler::PIL::PILVal    {
                my sub box (String $class, $value) {
                    callm(string($class), "new", $value);
                }
                $ng.ret(do given .value {
                    when Str { box("P5::PIL::Run::Str" => string($_)) }
                    when Num { box("P5::PIL::Run::Number" => number($_)) }
                    when Bool { &?OUTER::BLOCK(+$_) }
                    when undef { box("P5::PIL::Run::Undef" => perl("undef")) }
                    when List { box("P5::PIL::Run::List" => list(map { &OUTER::BLOCK($_) }, @$_)) }
                    when Error { box("P5::PIL::Run::Error", string($_.first), list(@( $_.second ))) }
                    when Junc { die "no junctions yet"; box("P5::PIL::Run::Junction", ...) }
                    default { die "a value of type {.WHAT} cannot appear in PIL. Your compiler must be sick." }
                }.perl); ''
            }

            when ::Perl::Compiler::PIL::PILVar    {
                # XXX shouldn't need $tree.pad.WHICH ; .pad.WHICH should do ($tree is topic)
                my $pad = $tree.pad;
                $ng.ret(self.pad_var($pad) ~ "->\{'{ $tree.value }'}"); ''
            }

            when ::Perl::Compiler::PIL::PILStmts  { 
                self.gen(.head, $ng.fork) ~ '; ' ~ self.gen(.tail, $ng.fork);
            }

            when ::Perl::Compiler::PIL::PILApp    {
                my $str = join ' ',
                    self.gen(.code, $ng.fork('code')),
                    map { self.gen($^arg, $^gen) }, zip([.args], [map { $ng.fork("arg$_") }, 0 ..^ .args]);
                $ng.ret(
                    $ng.r('code') ~ '->CALL(' 
                        ~ join(', ', map { $ng.r("arg$_") }, 0 ..^ .args) ~ ')'
                );
                $str;
            }

            when ::Perl::Compiler::PIL::PILAssign {
                my $str = self.gen(.right, $ng.fork('right')) ~ self.gen(.left, $ng.fork('left'));
                $ng.ret(
                    $ng.r('left') ~ "->ASSIGN( $ng.r('right') )"
                );
                $str;
            }
            
            when ::Perl::Compiler::PIL::PILBind   {
                my $str = self.gen(.right, $ng.fork('right')) ~ self.gen(.left, $ng.fork('left'));
                $ng.ret(
                    $ng.r('left') ~ "->BIND( $ng.r('right') )"
                );
                $str;
            }

            die "Unknown PIL node type: $tree.WHAT()";
        };

        say "RETVAL = $ret";
        return $ret;
    }

    method pad_var(Perl::Compiler::PIL::Util::Pad $pad) {
        "\$PAD_" ~ $pad.WHICH;
    }
}

# vim: ft=perl6 :