File Coverage

blib/lib/MarpaX/Languages/ECMAScript/AST/Grammar/ECMAScript_262_5/Program.pm

Criterion	Covered	Total	%
statement	30	179	16.7
branch	0	72	0.0
condition	0	42	0.0
subroutine	10	25	40.0
pod	4	4	100.0
total	44	322	13.6

#
# Here is the exhaustive list of difficulties with the ECMAScript grammar:
#
# * The list of reserved keywords is context sensitive (depend on strict mode)
# * The source CAN be not ok v.s. semi-colon: automatic semi-colon insertion will then happen
# * Allowed separators is contextual (sometimes no line terminator is allowed)
# * RegularExpressionLiteral ambiguity with AssignmentExpression or MultiplicativeExpression
#
use strict;
use warnings FATAL => 'all';

package MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::Program;
use parent qw/MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::Base/;
use MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::Program::Semantics;
use MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::Lexical::RegularExpressionLiteral;
use MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::Lexical::StringLiteral;
use MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::Lexical::NumericLiteral;
use MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::CharacterClasses;
use MarpaX::Languages::ECMAScript::AST::Exceptions qw/:all/;
#use Log::Any qw/$log/;
use SUPER;

# ABSTRACT: ECMAScript-262, Edition 5, lexical program grammar written in Marpa BNF

our $VERSION = '0.019'; # VERSION

our $WhiteSpace        = qr/(?:[\p{MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::CharacterClasses::IsWhiteSpace}])/;
our $LineTerminator    = qr/(?:[\p{MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::CharacterClasses::IsLineTerminator}])/;
our $SingleLineComment = qr/(?:\/\/[\p{MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::CharacterClasses::IsSourceCharacterButNotLineTerminator}]*)/;
our $MultiLineComment  = qr/(?:(?:\/\*)(?:(?:[\p{MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::CharacterClasses::IsSourceCharacterButNotStar}]+|\*(?![\p{MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::CharacterClasses::IsSourceCharacterButNotSlash}]))*)(?:\*\/))/;
our $UnicodeLetter = qr/[\p{MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::CharacterClasses::IsUnicodeLetter}]/;
our $HexDigit4 = qr/[\p{MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::CharacterClasses::IsHexDigit}]{4}/;

our $S                 = qr/(?:$WhiteSpace|$LineTerminator|$SingleLineComment|$MultiLineComment)/;
our $isPostLineTerminatorLength = qr/\G$S+/;
our $isPreSLength = qr/\G$S+/;
our $isRcurly = qr/\G$S*\}/;
our $isEnd = qr/\G$S*$/;
our $isDecimalDigit = qr/\G[\p{MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::CharacterClasses::IsDecimalDigit}]/;
our $isIdentifierStart = qr/\G(?:$UnicodeLetter|\$|_|\\u$HexDigit4)/;
our @Keyword =
    qw/break      do       instanceof typeof
       case       else     new        var
       catch      finally  return     void
       continue   for      switch     while
       debugger   function this       with
       default    if       throw
       delete     in       try/;

our @FutureReservedWord =
    qw/class      enum     extends    super
       const      export   import/;

our @FutureReservedWordStrict =
    qw/implements let      private    public    yield
       interface  package  protected  static/;

our @NullLiteral = qw/null/;

our @BooleanLiteral = qw/true false/;

#
# Force eventual higher priority
#
our %PRIORITY = (FUNCTION => 2);

our $grammar_content = do {local $/; };

#
# It is clearer to have reserved words in an array. But for efficienvy the hash is better,
# so I create on-the-fly associated hashes using the arrays. Convention is: the lexeme name of
# a reserved word is this word, but in capital letters (since none of them is in capital letter)
#
our %Keyword                  = map {($_, uc($_))} @Keyword;
our %FutureReservedWord       = map {($_, uc($_))} @FutureReservedWord;
our %FutureReservedWordStrict = map {($_, uc($_))} @FutureReservedWordStrict;
our %NullLiteral              = map {($_, uc($_))} @NullLiteral;
our %BooleanLiteral           = map {($_, uc($_))} @BooleanLiteral;

#
# ... And we inject in the grammar those that exist (FutureReservedWord do not)
#
$grammar_content .= "\n";
# ... Priorities
map {$grammar_content .= ":lexeme ~ <$_> priority => " . ($PRIORITY{$_} || 1) . "\n"} values %Keyword;
map {$grammar_content .= ":lexeme ~ <$_> priority => " . ($PRIORITY{$_} || 1) . "\n"} values %NullLiteral;
map {$grammar_content .= ":lexeme ~ <$_> priority => " . ($PRIORITY{$_} || 1) . "\n"} values %BooleanLiteral;
# ... Definition
map {$grammar_content .= uc($_) . " ~ '$_'\n"} @Keyword;
map {$grammar_content .= uc($_) . " ~ '$_'\n"} @NullLiteral;
map {$grammar_content .= uc($_) . " ~ '$_'\n"} @BooleanLiteral;
#
# Injection of grammars.
#
our $StringLiteral = MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::Lexical::StringLiteral->new();
our $RegularExpressionLiteral = MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::Lexical::RegularExpressionLiteral->new();
our $NumericLiteral = MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::Lexical::NumericLiteral->new();
$grammar_content .= $StringLiteral->extract;
$grammar_content .= $NumericLiteral->extract;
$grammar_content .= $RegularExpressionLiteral->extract;

#
# For convenience in the IDENTIFIER$ lexeme callback, we merge Keyword, FutureReservedWord, NullLiteral, BooleanLiteral into
# a single hash ReservedWord.
#
our %ReservedWord = map {$_ => 1} (keys %Keyword, keys %FutureReservedWord, keys %NullLiteral, keys %BooleanLiteral);



sub make_grammar_content {
    my ($class) = @_;
    return $grammar_content;
}


sub make_semantics_package {
    my ($class) = @_;
    return join('::', $class, 'Semantics');
}


sub spacesAny {
    my $self = shift;
    if (@_) {
	$self->{_spacesAny} = shift;
    }
    return $self->{_spacesAny};
}


sub parse {
    my ($self, $source, $impl) = @_;
    #
    # Because of Automatic Semicolon Insertion that may happen at the end,
    # a space is appended to a copy of the source to be parsed.
    #
    $self->{programCompleted} = 0;
    $source .= ' ';
    return $self->SUPER($source, $impl,
                        {
                         callback => \&_eventCallback,
                         callbackargs => [ $self ],
                         failure => \&_failureCallback,
                         failureargs => [ $self ],
                         end => \&_endCallback,
                         endargs => [ $self ],
                        });
}

sub _eventCallback {
  my ($self, $source, $pos, $max, $impl) = @_;

  #
  # $pos is the exact position where SLIF stopped because of an event
  #
  my $rc = $pos;
  my %lastLexeme = ();
  my $lastLexemeDoneb = 0;

  #
  # Cache of some call results
  #
  $self->{_isIdentifierStart} = {};
  $self->{_isDecimalDigit} = {};
  $self->{_preSLength} = {};
  $self->{_isEnd} = {};
  $self->{_postLineTerminatorLength} = {};

  foreach (@{$impl->events()}) {
    my ($name) = @{$_};
    #
    # Events are always in this order:
    #
    # ---------------------------------
    # 1. Completion events first (XXX$)
    # ---------------------------------
    #
    if ($name eq 'Program$') {
	#
	# Program$ will happen rarely, so even it does cost it is ok to do so
	#
	$self->{programCompleted} = ($self->{_isEnd}->{$pos} //= $self->_isEnd($source, $pos, $impl));
    }
    elsif ($name eq 'NumericLiteral$') {
      #
      # The source character immediately following a NumericLiteral must not be
      # an IdentifierStart or DecimalDigit
      #
      if (($self->{_isIdentifierStart}->{$pos} //= $self->_isIdentifierStart($source, $pos, $impl)) ||
          ($self->{_isDecimalDigit}->{$pos} //= $self->_isDecimalDigit($source, $pos, $impl))) {
        my ($start, $end) = $impl->last_completed_range('NumericLiteral');
        my $lastNumericLiteral = $impl->range_to_string($start, $end);
        SyntaxError(error => "NumericLiteral $lastNumericLiteral must not be immediately followed by an IdentifierStart or DecimalDigit");
      }
    }
    elsif ($name eq 'IDENTIFIER$') {
	if (! $lastLexemeDoneb) {
	    $self->getLastLexeme(\%lastLexeme, $impl);
	    $lastLexemeDoneb = 1;
	}
	if (exists($ReservedWord{$lastLexeme{value}})) {
	    SyntaxError(error => "Identifier $lastLexeme{value} is a reserved word");
	}
    }
    #
    # ------------------------
    # 2. nulled events (XXX[])
    # ------------------------
    #
    # ------------------------------------
    # 3. prediction events (^XXX or ^^XXX)
    # ------------------------------------
    #
    elsif ($name eq '^INVISIBLE_SEMICOLON') {
      #
      # In the AST, we explicitely associate the ';' to the missing semicolon
      #
	if (! $lastLexemeDoneb) {
	    $self->getLastLexeme(\%lastLexeme, $impl);
	    $lastLexemeDoneb = 1;
	}
	my $Slength = ($self->{_preSLength}->{$rc} //= $self->_preSLength($source, $rc, $impl));
	$self->_insertInvisibleSemiColon($impl, $rc, $Slength);
	$rc += $Slength;
    }
    #
    # ^PLUSPLUS_POSTFIX, ^MINUSMINUS_POSTFIX
    # --------------------------------------
    elsif ($name eq '^PLUSPLUS_POSTFIX' || $name eq '^MINUSMINUS_POSTFIX') {
	if (! $lastLexemeDoneb) {
	    $self->getLastLexeme(\%lastLexeme, $impl);
	    $lastLexemeDoneb = 1;
	}
      my $postLineTerminatorPos = $lastLexeme{start} + $lastLexeme{length};
      my $postLineTerminatorLength = ($self->{_postLineTerminatorLength}->{$postLineTerminatorPos} //= $self->_postLineTerminatorLength($source, $postLineTerminatorPos, $impl));
      my $asi = 0;
      if ($postLineTerminatorLength > 0) {
	  if (! $impl->lexeme_read('SEMICOLON', $postLineTerminatorPos, $postLineTerminatorLength, ';')) {
	      SyntaxError(error => "SEMICOLON lexeme_read failure at position $rc");
	  }
	  $asi = 1;
      }
      my $lname = $name;
      substr($lname, 0, 1, '');
      my $lvalue = ($lname eq 'PLUSPLUS_POSTFIX') ? '++' : '--';
      #
      # The value does not change if ASI was performed. But the name, yes.
      #
      if ($asi) {
	  $lname = ($lname eq 'PLUSPLUS_POSTFIX') ? 'PLUSPLUS' : 'MINUSMINUS';
      }
      if (! $impl->lexeme_read($lname, $rc, 2, $lvalue)) {
	  SyntaxError(error => "$lname lexeme_read failure at position $rc");
      }
      $rc += 2;
    }
    #
    # ^^DIV (because of REGULAREXPRESSIONLITERAL that can eat it)
    # -----------------------------------------------------------
    elsif ($name eq '^^DIV') {
	my $realpos = $rc + ($self->{_preSLength}->{$rc} //= $self->_preSLength($source, $rc, $impl));
      if (index($source, '/',  $realpos) == $realpos &&
          index($source, '/=', $realpos) != $realpos &&
          index($source, '//', $realpos) != $realpos &&
          index($source, '/*', $realpos) != $realpos) {
        if (! $impl->lexeme_read('DIV', $realpos, 1, '/')) {
	    SyntaxError(error => "DIV lexeme_read failure at position $rc");
	}
        $rc = $realpos + 1;
      }
    }
    #
    # ^^DIVASSIGN  (because of REGULAREXPRESSIONLITERAL that can eat it)
    # ------------------------------------------------------------------
    elsif ($name eq '^^DIVASSIGN') {
	my $realpos = $rc + ($self->{_preSLength}->{$rc} //= $self->_preSLength($source, $rc, $impl));
      if (index($source, '/=', $realpos) == $realpos &&
          index($source, '//', $realpos) != $realpos &&
          index($source, '/*', $realpos) != $realpos) {
        if (! $impl->lexeme_read('DIVASSIGN', $realpos, 2, '/=')) {
	    SyntaxError(error => "DIVASSIGN lexeme_read failure at position $rc");
	}
        $rc = $realpos + 2;
      }
    }
  }

  #
  # Remove cache
  #
  delete($self->{_isIdentifierStart});
  delete($self->{_isDecimalDigit});
  delete($self->{_preSLength});
  delete($self->{_isEnd});
  delete($self->{_postLineTerminatorLength});

  #if ($rc != $pos) {
  #  $log->tracef('[_eventCallback] Resuming at position %d (was %d when called)', $rc, $pos);
  #}

  return $rc;
}

sub _postLineTerminatorLength {
    # my ($self, $source, $pos, $impl) = @_;

  my $rc = 0;

  my $prevpos = pos($_[1]);
  pos($_[1]) = $_[2];

  #
  # Take care: the separator is:  _WhiteSpace | _LineTerminator | _SingleLineComment | _MultiLineComment
  # where a _MultiLineComment that contains a _LineTerminator is considered equivalent to a _LineTerminator
  #
  # This is why if we find a separator just before $pos, we check again the presence of _LineTerminator in the match
  #
  if ($_[1] =~ $isPostLineTerminatorLength) {
    my $length = $+[0] - $-[0];
    if (substr($_[1], $-[0], $length) =~ /$LineTerminator/) {
      $rc = $length;
    }
  }

  #if ($rc > 0) {
  #  $log->tracef('[_postLineTerminatorLength] Found postLineTerminator of length %d', $rc);
  #}

  pos($_[1]) = $prevpos;

  return $rc;
}

sub _preSLength {
    # my ($self, $source, $pos, $impl) = @_;

  my $rc = 0;

  my $prevpos = pos($_[1]);
  pos($_[1]) = $_[2];

  if ($_[1] =~ $isPreSLength) {
    my $length = $+[0] - $-[0];
    $rc = $length;
  }

  #if ($rc > 0) {
  #  $log->tracef('[_preSLength] Found S of length %d', $rc);
  #}

  pos($_[1]) = $prevpos;

  return $rc;
}

sub _isRcurly {
    # my ($self, $source, $pos, $impl) = @_;

  my $rc = 0;

  my $prevpos = pos($_[1]);
  pos($_[1]) = $_[2];

  if ($_[1] =~ $isRcurly) {
    $rc = 1;
  }

  #if ($rc) {
  #  $log->tracef('[_isRcurly] Found \'}\'');
  #}

  pos($_[1]) = $prevpos;

  return $rc;
}

sub _isIdentifierStart {
    # my ($self, $source, $pos, $impl) = @_;

  my $rc = 0;

  my $prevpos = pos($_[1]);
  pos($_[1]) = $_[2];

  if ($_[1] =~ $isIdentifierStart) {
    $rc = 1;
  }

  #if ($rc) {
  #  $log->tracef('[_isIdentifierStart] Found \'%s\'', $&);
  #}

  pos($_[1]) = $prevpos;

  return $rc;
}

sub _isDecimalDigit {
    # my ($self, $source, $pos, $impl) = @_;

  my $rc = 0;

  my $prevpos = pos($_[1]);
  pos($_[1]) = $_[2];

  if ($_[1] =~ $isDecimalDigit) {
    $rc = 1;
  }

  #if ($rc) {
  #  $log->tracef('[_isDecimalDigit] Found \'%s\'', $&);
  #}

  pos($_[1]) = $prevpos;

  return $rc;
}

sub _isEnd {
    # my ($self, $source, $pos, $impl) = @_;

    my $grammar     = $_[0]->spacesAny->{grammar};
    my $impl        = $_[0]->spacesAny->{impl};
    $grammar->parse($_[1], $impl, $_[2]);
    return $grammar->endReached;
}

sub _insertSemiColon {
  my ($self, $impl, $pos, $length) = @_;

  if (! $impl->lexeme_read('SEMICOLON', $pos, $length, ';')) {
    SyntaxError(error => "Automatic Semicolon Insertion not allowed at position $pos");
  }
}

sub _insertInvisibleSemiColon {
  my ($self, $impl, $pos, $length) = @_;

  if (! $impl->lexeme_read('INVISIBLE_SEMICOLON', $pos, $length, ';')) {
    SyntaxError(error => "Automatic Invisible Semicolon Insertion not allowed at position $pos");
  }
}

sub _failureCallback {
  my ($self, $source, $pos, $max, $impl) = @_;

  #
  # The position of failure is exactly the end of the very last lexeme
  #
  my %lastLexeme = ();
  $self->getLastLexeme(\%lastLexeme, $impl);
  my $rc = $lastLexeme{start} + $lastLexeme{length};

  #
  # Automatic Semicolon Insertion rules apply here
  #
  # 1. When, as the program is parsed from left to right, a token
  # (called the offending token) is encountered that is not allowed
  # by any production of the grammar, then a semicolon is automatically
  # inserted before the offending token if one or more of the following conditions is true:
  # - The offending token is separated from the previous token by at least one LineTerminator.
  # - The offending token is }.
  #
  my $length = 0;
  if (($length = $self->_postLineTerminatorLength($source, $rc, $impl)) > 0) {
    $self->_insertSemiColon($impl, $rc, $length);
    $rc += $length;
  } elsif ($self->_isRcurly($source, $rc, $impl)) {
    $self->_insertSemiColon($impl, $rc, 1);
  } else {
    SyntaxError();
  }

  return $rc;
}

sub _endCallback {
  my ($self, $source, $pos, $max, $impl) = @_;

  if ($self->{programCompleted}) {
      return;
  }

  #
  # Automatic Semicolon Insertion rules apply here
  #
  # 2. When, as the program is parsed from left to right, the end of the input stream of tokens
  #    is encountered and the parser is unable to parse the input token stream as a single complete ECMAScript Program
  #    then a semicolon is automatically inserted at the end of the input stream.
  #
  if (! $self->{programCompleted}) {
      my %lastLexeme = ();
      $self->getLastLexeme(\%lastLexeme, $impl);
      my $lastValidPos = $lastLexeme{start} + $lastLexeme{length};
      $self->_insertSemiColon($impl, $lastValidPos, 1);
      my $haveProgramCompletion = grep {$_ eq 'Program$'} map {$_->[0]} @{$impl->events};
      if (! $haveProgramCompletion) {
	  SyntaxError(error => "Incomplete program");
      }
  }
}


1;

=pod

=encoding UTF-8

=head1 NAME

MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::Program - ECMAScript-262, Edition 5, lexical program grammar written in Marpa BNF

=head1 VERSION

version 0.019

=head1 SYNOPSIS

    use strict;
    use warnings FATAL => 'all';
    use MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::Program;

    my $grammar = MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::Program->new();

    my $grammar_content = $grammar->content();
    my $grammar_option = $grammar->grammar_option();
    my $recce_option = $grammar->recce_option();

=head1 DESCRIPTION

This modules returns describes the ECMAScript 262, Edition 5 lexical program grammar written in Marpa BNF, as of L. This module inherits the methods from MarpaX::Languages::ECMAScript::AST::Grammar::ECMAScript_262_5::Base package.

=head1 SUBROUTINES/METHODS

=head2 make_grammar_content($class)

Returns the grammar. This will be injected in the Program's grammar.

=head2 semantics_package($class)

Class method that returns Program default recce semantics_package. These semantics are adding ruleId to all values, and execute eventually StringLiteral lexical grammar.

=head2 spacesAny($self, $spacesAny)

Getter/Setter of a SpacesAny grammar implementation, used internally by the Program grammar.

=head2 parse($self, $source, $impl)

Parse the source given as $source using implementation $impl.

=head1 SEE ALSO

L

=head1 AUTHOR

Jean-Damien Durand

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Jean-Damien Durand.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

__DATA__