1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
#!/usr/bin/env perl
# Copyright 2022 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/.
use 5.010001;
use strict;
use warnings;
use Marpa::R2 2.097_002;
use Data::Dumper;
use Test::More tests => 3;
use Getopt::Long ();
my $verbose;
die if not Getopt::Long::GetOptions( verbose => \$verbose );
# This example tests the Ruby Slippers using the SLIF
my $grammar = << '=== GRAMMAR ===';
:default ::= action => [ name, value ]
lexeme default = action => [ name, value ] latm => 1 # to add token names to ast
script ::= E+ separator => semi action => [values]
E ::=
number action => main::number
|| E ('*') E action => main::multiply
|| E ('+') E action => main::add
:discard ~ whitespace
whitespace ~ [\s]+
number ~ [\d]+
semi ~ ';'
=== GRAMMAR ===
my $g = Marpa::R2::Scanless::G->new( { source => \($grammar) } );
my @tests = (
[ '1+2+3*4', '15' ],
[ '1+2 3+4', '3,7' ],
[ '0+42 21*2 3*7+21 3*7*2', '42,42,42,42' ],
);
for my $test (@tests) {
my ( $string, $expected_result ) = @{$test};
my $actual_result = test( $g, $string );
say "Input: $string";
Test::More::is( $actual_result, $expected_result,
qq{Result of "$string"} );
} ## end for my $test (@tests)
sub test {
my ( $g, $string ) = @_;
my @found = ();
diag("Input: $string") if $verbose;
my $original_length = length $string;
my $suffixed_string = $string . ';';
my $target_start = 0;
# state $recce_debug_args = { trace_terminals => 1, trace_values => 1 };
state $recce_debug_args = {};
# Marpa::R2::Display
# name: SLIF rejection recognizer setting synopsis
my $recce = Marpa::R2::Scanless::R->new(
{ grammar => $g,
rejection => 'event',
},
$recce_debug_args
);
my $pos = $recce->read( \$suffixed_string, 0, $original_length );
READ_LOOP: while (1) {
my $rejection = 0;
my $pos = $recce->pos();
EVENT:
for my $event ( @{ $recce->events() } ) {
my ($name) = @{$event};
if ( $name eq q('rejected) ) {
$rejection = 1;
diag("You fool! you forget the semi-colon at location $pos!")
if $verbose;
next EVENT;
} ## end if ( $name eq q('rejected) )
die join q{ }, "Spurious event at position $pos: '$name'";
} ## end EVENT: for my $event ( @{ $recce->events() } )
last READ_LOOP if not $rejection;
$recce->resume( $original_length, 1 );
diag("I fixed it for you. Now you owe me.") if $verbose;
$recce->resume( $pos, $original_length - $pos );
} ## end READ_LOOP: while (1)
# Marpa::R2::Display::End
my $ref_value = $recce->value();
return 'No parse' if not $ref_value;
if ( ref $ref_value ne 'REF' ) {
my $ref_type = ref $ref_value;
my $ref_description = $ref_type ? "ref to $ref_type" : 'not a ref';
return "Got $ref_description -- want REF to REF to ARRAY";
}
return join q{,}, @{ ${$ref_value} };
} ## end sub test
sub number {
my ( undef, $v1 ) = @_;
return $v1->[1];
}
sub add {
my ( $undef, $v1, $v2 ) = @_;
return $v1 + $v2;
}
sub multiply {
my ( $undef, $v1, $v2 ) = @_;
return $v1 * $v2;
}
# vim: expandtab shiftwidth=4:
|
