view release on metacpan or  search on metacpan

lib/Erlang/Parser/Parser.yp  view on Meta::CPAN

# Copyright 2011-2012 Yuki Izumi. ( anneli AT cpan DOT org )
# This is free software; you can redistribute it and/or modify it under the
# same terms as Perl itself.

%nonassoc KW_CATCH

# ???
%nonassoc LARROW LDARROW

%right MATCH SEND
%left KW_ORELSE
%left KW_ANDALSO
%nonassoc EQUAL NOT_EQUAL LTE GTE LT GT STRICTLY_EQUAL STRICTLY_NOT_EQUAL
%right LISTADD LISTSUBTRACT
%left ADD SUBTRACT KW_BOR KW_BXOR KW_BSL KW_BSR KW_OR KW_XOR
%left DIVIDE MULTIPLY KW_DIV KW_REM KW_AND KW_BAND
%left NEG POS KW_BNOT KW_NOT
%nonassoc OPENRECORD
%nonassoc COLON

%{
    use strict;
    use warnings;

    use Erlang::Parser::Node::Directive;
    use Erlang::Parser::Node::DefList;
    use Erlang::Parser::Node::Def;
    use Erlang::Parser::Node::WhenList;
    use Erlang::Parser::Node::Atom;
    use Erlang::Parser::Node::Integer;
    use Erlang::Parser::Node::BinOp;
    use Erlang::Parser::Node::List;
    use Erlang::Parser::Node::Variable;
    use Erlang::Parser::Node::Tuple;
    use Erlang::Parser::Node::Macro;
    use Erlang::Parser::Node::String;
    use Erlang::Parser::Node::Call;
    use Erlang::Parser::Node::Alt;
    use Erlang::Parser::Node::Try;
    use Erlang::Parser::Node::Literal;
    use Erlang::Parser::Node::FunRef;
    use Erlang::Parser::Node::FunLocal;
    use Erlang::Parser::Node::FunLocalCase;
    use Erlang::Parser::Node::Case;
    use Erlang::Parser::Node::RecordNew;
    use Erlang::Parser::Node::VariableRecordAccess;
    use Erlang::Parser::Node::VariableRecordUpdate;
    use Erlang::Parser::Node::Float;
    use Erlang::Parser::Node::BaseInteger;
    use Erlang::Parser::Node::BinaryExpr;
    use Erlang::Parser::Node::Binary;
    use Erlang::Parser::Node::UnOp;
    use Erlang::Parser::Node::Begin;
    use Erlang::Parser::Node::Comprehension;
    use Erlang::Parser::Node::If;
    use Erlang::Parser::Node::IfExpr;
    use Erlang::Parser::Node::Receive;
    use Erlang::Parser::Node::ReceiveAfter;

    sub new_node {
        my ($kind, %args) = @_;
        "Erlang::Parser::Node::$kind"->new(%args);
    }
%}

%%

# TODO: A few of these lists are flawed in that their optional type isn't done correctly
# (they allow constructs like [, 1, 2]). Fix this.

root:
                                { [] }
    | root rootstmt             { [@{$_[1]}, $_[2]] }
    ;

rootstmt:
      SUBTRACT ATOM LPAREN exprlist RPAREN PERIOD       { new_node 'Directive', directive => $_[2], args => $_[4] }
    | deflist PERIOD                                    { $_[1] }
    ;

deflist:
      def                       { new_node('DefList')->_append($_[1]) }
    | deflist SEMICOLON def     { $_[1]->_append($_[3]) }
    ;

def:
      ATOM LPAREN exprlist RPAREN whenlist RARROW stmtlist      { new_node 'Def', def => $_[1], args => $_[3], whens => $_[5]->_group, stmts => $_[7] }
    ;

whenlist:
                                { new_node 'WhenList' }
    | KW_WHEN expr              { new_node('WhenList')->_append($_[2]) }
    # TODO differentiate these. (a;b,c (A)||(B&&C))
    | whenlist COMMA expr       { $_[1]->_append($_[3]) }
    | whenlist SEMICOLON expr   { $_[1]->_group->_append($_[3]) }

lib/Erlang/Parser/Parser.yp  view on Meta::CPAN

    | expr NOT_EQUAL expr               { new_node 'BinOp', op => '/=',      a => $_[1], b => $_[3] }
    | expr KW_BSL expr                  { new_node 'BinOp', op => 'bsl',     a => $_[1], b => $_[3] }
    | expr KW_BSR expr                  { new_node 'BinOp', op => 'bsr',     a => $_[1], b => $_[3] }
    | expr KW_BOR expr                  { new_node 'BinOp', op => 'bor',     a => $_[1], b => $_[3] }
    | expr KW_BAND expr                 { new_node 'BinOp', op => 'band',    a => $_[1], b => $_[3] }
    | expr KW_BXOR expr                 { new_node 'BinOp', op => 'bxor',    a => $_[1], b => $_[3] }
    | expr KW_XOR expr                  { new_node 'BinOp', op => 'xor',     a => $_[1], b => $_[3] }
    | expr KW_REM expr                  { new_node 'BinOp', op => 'rem',     a => $_[1], b => $_[3] }
    | expr KW_ANDALSO expr              { new_node 'BinOp', op => 'andalso', a => $_[1], b => $_[3] }
    | expr KW_ORELSE expr               { new_node 'BinOp', op => 'orelse',  a => $_[1], b => $_[3] }
    | expr KW_AND expr                  { new_node 'BinOp', op => 'and',     a => $_[1], b => $_[3] }
    | expr KW_OR expr                   { new_node 'BinOp', op => 'or',      a => $_[1], b => $_[3] }
    | SUBTRACT expr %prec NEG           { new_node 'UnOp',  op => '-',       a => $_[2] }
    | ADD expr %prec POS                { new_node 'UnOp',  op => '+',       a => $_[2] }
    | KW_BNOT expr                      { new_node 'UnOp',  op => 'bnot',    a => $_[2] }
    | KW_NOT expr                       { new_node 'UnOp',  op => 'not',     a => $_[2] }
    | KW_CATCH expr                     { new_node 'UnOp',  op => 'catch',   a => $_[2] }

    # TODO: unhack this.
    | expr LARROW expr          { new_node 'BinOp', op => '<-', a => $_[1], b => $_[3] }
    | expr LDARROW expr         { new_node 'BinOp', op => '<=', a => $_[1], b => $_[3] }

    | call
    ;

parenexpr:
      LPAREN expr RPAREN                { $_[2] }
    ;

expr:
      unparenexpr
    | parenexpr
    ;

parenorimm:
      parenexpr
    | immexpr
    ;

immexpr:
      FLOAT                     { new_node 'Float', float => $_[1] }
    | BASE_INTEGER              { new_node 'BaseInteger', baseinteger => $_[1] }
    | INTEGER                   { new_node 'Integer', int => $_[1] }
    | string
    | variable OPENRECORD atom  { new_node 'VariableRecordAccess', variable => $_[1], record => $_[3] }
    | variable newrecord        { new_node 'VariableRecordUpdate', variable => $_[1], update => $_[2] }
    | LITERAL                   { new_node 'Literal', literal => substr($_[1], 1) }
    | list
    | tuple
    | newrecord
    | macro
    | variable
    | atom
    ;

atom:
      ATOM                      { new_node 'Atom', atom => $_[1] }
    ;

macro:
      MACRO                     { new_node 'Macro', macro => substr($_[1], 1) }
    ;

variable:
      VARIABLE                  { new_node 'Variable', variable => $_[1] }
    ;

string:
      STRING                    { new_node 'String', string => $_[1] }
    | string STRING             { $_[1]->_append($_[2]) }
    ;

call:
      intcall
    | extcall
    ;

intcall:
      parenorimm LPAREN exprlist RPAREN         { new_node 'Call', function => $_[1], args => $_[3] }
    ;

extcall:
      parenorimm COLON intcall                  { $_[3]->module($_[1]); $_[3] }
    ;

list:
      LISTOPEN exprlist listcdr LISTCLOSE       { new_node 'List', elems => $_[2], cdr => $_[3] }
    ;

# This is not a full node.
listcdr:
                                                { undef }
    | PIPE expr                                 { $_[2] }
    ;

comprehension:
      LISTOPEN expr COMPREHENSION exprlist LISTCLOSE            { new_node 'Comprehension', output => $_[2], generators => $_[4] }
    | OPENBINARY binary COMPREHENSION exprlist CLOSEBINARY      { new_node 'Comprehension', output => $_[2], generators => $_[4], binary => 1 }
    ;

tuple:
      TUPLEOPEN exprlist TUPLECLOSE     { new_node 'Tuple', elems => $_[2] }
    ;

case:
      KW_CASE expr KW_OF altlist KW_END { new_node 'Case', of => $_[2], alts => $_[4] }
    ;

altlist:
      alt                       { [$_[1]] }
    | altlist SEMICOLON alt     { [@{$_[1]}, $_[3]] }
    ;

alt:
      expr whenlist RARROW stmtlist     { new_node 'Alt', expr => $_[1], whens => $_[2]->_group, stmts => $_[4] }
    ;

fun:
      funlocal
    | KW_FUN atom COLON ATOM DIVIDE INTEGER     { new_node 'FunRef', module => $_[2], function => $_[4], arity => $_[6] }
    | KW_FUN macro COLON ATOM DIVIDE INTEGER    { new_node 'FunRef', module => $_[2], function => $_[4], arity => $_[6] }