Skip to content

Instantly share code, notes, and snippets.

@jeffreykegler
Forked from jalvo2014/marpa-test7
Last active August 29, 2015 13:57

Revisions

  1. Jeffrey Kegler revised this gist Mar 16, 2014. 1 changed file with 3 additions and 0 deletions.
    3 changes: 3 additions & 0 deletions marpa-test7
    Original file line number Diff line number Diff line change
    @@ -28,6 +28,8 @@ my $recce;

    my $dsl = <<'END_OF_DSL';
    :default ::= action => ::array
    :start ::= formula
    :discard ~ ws
    @@ -158,6 +160,7 @@ sub My_Actions::do_basic {
    my ( undef, $t1, $t2, $t3, $t4 ) = @_;
    if (defined $t1) {
    $DB::single=2;
    say STDERR Data::Dumper::Dumper(\@_);
    print "My_Actions::do_basic: $t1 $t2 $t3 $t4\n";
    return undef;
    }
  2. @jalvo2014 jalvo2014 created this gist Mar 15, 2014.
    165 changes: 165 additions & 0 deletions marpa-test7
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,165 @@
    #!/usr/bin/perl
    # Copyright 2012 Jeffrey Kegler
    # This file is part of Marpa::R2. Marpa::R2 is free software: you can
    # redistribute it and/or modify it under the terms of the GNU Lesser
    # General Public License as published by the Free Software Foundation,
    # either version 3 of the License, or (at your option) any later version.
    #
    # Marpa::R2 is distributed in the hope that it will be useful,
    # but WITHOUT ANY WARRANTY; without even the implied warranty of
    # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
    # Lesser General Public License for more details.
    #
    # You should have received a copy of the GNU Lesser
    # General Public License along with Marpa::R2. If not, see
    # http://www.gnu.org/licenses/.
    # $DB::single=2; # remember debug breakpoint

    use 5.010;
    use strict;
    use warnings;
    use English qw( -no_match_vars );
    use Marpa::R2;
    use Data::Dumper; # debug only

    my $string;
    my $grammar;
    my $recce;

    my $dsl = <<'END_OF_DSL';
    :start ::= formula
    :discard ~ ws
    formula ::= '*IF' <condition_list>
    | '*IF' <condition_list> <until_clause>
    <condition_list> ::= <condition>
    | '(' <condition_list> ')'
    | <condition_list> <logical_operator> <condition_list>
    <logical_operator> ::= '*AND' | '*OR'
    <condition> ::= <basic_condition>
    | <scalar_condition>
    | <missing_condition>
    | <str_func_condition>
    | <situation_condition>
    <basic_condition> ::= <basic_function> <attribute> <comparison> <literal> action => do_basic
    <basic_function> ::= '*VALUE' | '*COUNT'
    <comparison> ::= '*EQ' | '*GE' | '*GT' | '*LE' | '*LT' | '*NE'
    <literal> ::= <quoted_string> | <word> | <number>
    <attribute> ::= id '.' id
    <scalar_condition> ::= <scalar_function> <attribute> <comparison> <number>
    | <minmax_function> <attribute> '*EQ' '*TRUE'
    <scalar_function> ::= '*AVG' | '*SUM' | '*CHANGE' | '*PCTCHANGE'
    <minmax_function> ::= '*MIN' | '*MAX'
    <missing_condition> ::= '*MISSING' <attribute> '*EQ' '(' <comma_separated_list> ')'
    <comma_separated_list> ::= <quoted_string>
    | <quoted_string> ',' <comma_separated_list>
    <str_func_condition> ::= '*SCAN' <attribute> <comparison> <quoted_string>
    | '*SCAN' <attribute> <comparison> <word>
    | '*STR' <attribute> <comparison> <str_arg>
    <str_arg> ::= <number> ',' <word>
    <situation_condition> ::= '*SIT' <situation> '*EQ' '*TRUE'
    <situation> ::= <id>
    <until_clause> ::= '*UNTIL' '(' <until_condition> ')'
    <until_condition> ::= '*SIT' <situation>
    | '*TTL' <interval>
    | '*SIT' <situation> '*OR' '*TTL' <interval>
    <quoted_string> ~ <single_quoted_string> | <double_quoted_string>
    <single_quoted_string> ~ <singlequote> <string_without_single_quote_or_vertical_space> <singlequote>
    <double_quoted_string> ~ <doublequote> <string_without_double_quote_or_vertical_space> <doublequote>
    <singlequote> ~ [']
    <doublequote> ~ ["]
    <string_without_single_quote_or_vertical_space> ~ [^']+
    <string_without_double_quote_or_vertical_space> ~ [^"]+
    <word> ~ [\w]+
    <digit> ~ [\d]
    <digits> ~ [\d]+
    <number> ~ <digits> | <digits>'.'<digits>
    <alpha> ~ [A-Za-z]
    <alphanump> ~ [A-Za-z0-9_]*
    <id> ~ <alpha><alphanump>
    <digit2> ~ [0-2]
    <digit6> ~ [0-6]
    <interval> ~ <digits>':'<digit2><digit>':'<digit6><digit>':'<digit6><digit>
    ws ~ [\s]+
    END_OF_DSL
    #
    #
    #<id> ::= [A-Za-z][A-Za-z0-9_]*
    #
    #<interval> ::= [0-9]+":"[0-2][0-9]":"[0-6][0-9]":"[0-6][0-9]

    #$DB::single=2;
    $grammar = Marpa::R2::Scanless::G->new({ source => \$dsl,});
    #$DB::single=2;
    $recce = Marpa::R2::Scanless::R->new(
    { grammar => $grammar,
    semantics_package => 'My_Actions',
    trace_terminals => 1,
    trace_values => 1,
    });

    #$DB::single=2;
    #my $input="*IF *VALUE Log_Entries.Log_Name *EQ errlog *AND ( ( ( *SCAN Log_Entries.Description *EQ '857033C6' ) *OR ( *SCAN Log_Entries.Description *EQ '8647C4E2' ) *OR ( *SCAN Log_Entries.Description *EQ '8650BE3F' ) *OR ( *SCAN Log_Entries.Description *EQ '8988389F' ) *OR ( *SCAN Log_Entries.Description *EQ '8C9704CA' ) *OR ( *SCAN Log_Entries.Description *EQ '9A8401BB' ) *OR ( *SCAN Log_Entries.Description *EQ '9E5DCE06' ) *OR ( *SCAN Log_Entries.Description *EQ '9F7B0FA6' ) *OR ( *SCAN Log_Entries.Description *EQ 'AA8D7232' ) *OR ( *SCAN Log_Entries.Description *EQ 'ABED1BA8' ) *OR ( *SCAN Log_Entries.Description *EQ 'AE3E3FAD' ) *OR ( *SCAN Log_Entries.Description *EQ 'B8113DD1' ) *OR ( *SCAN Log_Entries.Description *EQ 'B8FBD189' ) *OR ( *SCAN Log_Entries.Description *EQ 'BA8C5EBE' ) *OR ( *SCAN Log_Entries.Description *EQ 'BCF6612E' ) *OR ( *SCAN Log_Entries.Description *EQ B6DB68E0 ) ) ) *UNTIL ( *TTL 0:06:00:00 )" ;
    my $input="*IF *VALUE Log_Entries.Log_Name *EQ errlog ";

    #$DB::single=2;
    $recce->read( \$input );

    #$DB::single=2;
    my $value_ref = $recce->value;
    #$DB::single=2;
    my $value = $value_ref ? ${$value_ref} : 'No Parse';
    #$DB::single=2;
    my $progress_report = $recce->show_progress( 0, -1 );
    $DB::single=2;
    exit 0;

    sub My_Actions::do_basic {
    my ( undef, $t1, $t2, $t3, $t4 ) = @_;
    if (defined $t1) {
    $DB::single=2;
    print "My_Actions::do_basic: $t1 $t2 $t3 $t4\n";
    return undef;
    }
    }