5.3.issue.nqp

5.3.issue.nqp

use NQPHLL; 

grammar NQP::Grammar is HLL::Grammar {
    token TOP {
        :my $*CUR_BLOCK := QAST::Block.new(QAST::Stmts.new());
        <statementlist>
    }
    rule statementlist { [ <statement> \n+ ]+ }

    proto token statement {*}
    token statement:sym<echo> {
        <sym> <.ws> [
            | <EXPR>
            | '(' ~ ')' <EXPR>
        ] ';'?

    }
    token statement:sym<EXPR> { <EXPR> ';'? }

    token ws { <!ww> \h* || \h+ }

    proto token value {*}
    token value:sym<string> { <?["]> <quote_EXPR: ':q', ':b'> }
    token value:sym<integer> { '-'? \d+ }
    token value:sym<float> { '-'? \d+ '.' \d+ }

    token varname { '$' <[A..Za..z_]> <[A..Za..z0..9_]>* }

    my %multiplicative := nqp::hash('prec', 'u=', 'assoc', 'left');
    token infix:sym<*> { <sym> <O(|%multiplicative, :op<mul_n>)> }
    token infix:sym</> { <sym> <O(|%multiplicative, :op<div_n>)> }
    my %additive := nqp::hash('prec', 't=', 'assoc', 'left');
    token infix:sym<+> { <sym> <O(|%additive, :op<add_n>)> }
    token infix:sym<-> { <sym> <O(|%additive, :op<sub_n>)> }
    token infix:sym<.> { <sym> <O(|%additive, :op<concat>)> }
    token term:sym<value> { <value> }
    token term:sym<variable> {
        :my $*MAYBE_DECL := 0;
        <varname>
        [ <?before \s* '=' \s* <value> { $*MAYBE_DECL := 1 }> || <?> ]
    }
    my %assignment := nqp::hash('prec', 'i=', 'assoc', 'right');
    token infix:sym<=> { <sym> <O(|%assignment, :op<bind>)> }
}

class NQP::Actions is HLL::Actions {
    method TOP($/) {
        $*CUR_BLOCK.push( $<statementlist>.ast );
        make $*CUR_BLOCK;
    }
    method statementlist($/) {
         my $stmts := QAST::Stmts.new( :node($/) );
         for $<statement> {
             $stmts.push($_.ast)
         }
         make $stmts;
    }
    method statement:sym<echo>($/) {
         make QAST::Op.new(
              :op('print'),
              $<EXPR>.ast
         );
    }
    method statement:sym<EXPR>($/) {
        make $<EXPR>.ast;
    }
    method term:sym<variable>($/) {
        my $name := ~$<varname>;
        my %sym := $*CUR_BLOCK.symbol($name);
        if $*MAYBE_DECL && !%sym<declared> {
            $*CUR_BLOCK.symbol($name, :declared(1));
            make QAST::Var.new( :name($name), :scope('lexical'),
                                :decl('var') );
        } else {
            make QAST::Var.new( :name($name), :scope('lexical'));
        }
    }
    method value:sym<string>($/) {
        make $<quote_EXPR>.ast;
    }
    method value:sym<integer>($/) {
        make QAST::IVal.new( :value(+$/.Str) );
    }
    method value:sym<float>($/) {
        make QAST::NVal.new( :value(+$/.Str) );
    }
    method term:sym<value>($/) {
        make $<value>.ast;
    }   
}

class NQP::Compiler is HLL::Compiler { }

# NQP::Grammar.HOW.trace-on(NQP::Grammar);

sub MAIN(*@ARGS) {
    my $nqpcomp := NQP::Compiler.new();
    $nqpcomp.language('nqp');
    $nqpcomp.parsegrammar(NQP::Grammar);
    $nqpcomp.parseactions(NQP::Actions);
    $nqpcomp.command_line(@ARGS, :encoding('utf8'));
}