view release on metacpan or  search on metacpan

lib/MarpaX/Languages/ECMAScript/AST/Grammar/Base.pm  view on Meta::CPAN

sub new {
  my ($class, $spec) = @_;

  InternalError(error => 'Missing ECMAScript specification') if (! defined($spec));

  my $self  = {
      _content        => $class->make_content($spec),
      _grammar_option => $class->make_grammar_option($spec),
      _recce_option   => $class->make_recce_option($spec),
  };

  bless($self, $class);

  return $self;
}


sub content {
    my ($self) = @_;
    return $self->{_content};
}


sub make_content {
    my ($class, $spec) = @_;

    my $content = $class->make_grammar_content;

    #
    # Too painful to write MarpaX::Languages::ECMAScript::AST::Grammar::${spec}::CharacterClasses::IsSomething
    # so I change it on-the-fly here
    #
    if ($spec eq 'ECMAScript-262-5') {
	$spec = 'ECMAScript_262_5';
    }
    my $characterClass = "\\p{MarpaX::Languages::ECMAScript::AST::Grammar::${spec}::CharacterClasses::Is";
    $content =~ s/\\p\{Is/$characterClass/g;

    return $content;
}


sub extract {
    my ($self) = @_;
    my $rc = '';

    my $content = $self->content;
    my $index = index($content, SEARCH_KEYWORD_IN_GRAMMAR);
    if ($index >= 0) {
      $rc = substr($content, $index);
      $rc =~ s/\baction[ \t]*=>[ \t]*\w+//g;
      $rc =~ s/(__\w+)[ \t]*::=[ \t]*/$1 ~ /g;
    }

    return $rc;
}


sub make_grammar_option {
    my ($class, $spec) = @_;
    return {bless_package => $class->make_bless_package,
	    source        => \$class->make_content($spec, $class->make_grammar_content)};
}


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


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


sub grammar_option {
    my ($self) = @_;
    return $self->{_grammar_option};
}


sub recce_option {
    my ($self) = @_;
    return $self->{_recce_option};
}


sub make_recce_option {
    my ($class, $spec) = @_;
    return {ranking_method => $class->make_ranking_method,
            semantics_package => $class->make_semantics_package,
            too_many_earley_items => $class->make_too_many_earley_items};
}


sub make_ranking_method {
    my ($class) = @_;
    return 'high_rule_only';
}


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


sub make_too_many_earley_items {
    my ($class) = @_;
    return 0;
}


sub _callback {
  my ($self, $source, $pos, $max, $impl, $callbackp, $originalErrorString, @args) = @_;

  my $rc = $pos;

  eval {$rc = &$callbackp(@args, $source, $pos, $max, $impl)};