public
Last active

A Marpa parser for Flavio Poletti's Dyck-Hollerith language

  • Download Gist
dyck_hollerith.pl
Perl
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
use 5.010;
use strict;
use warnings;
use Data::Dumper;
use Scalar::Util;
use Marpa::XS;
 
# A Marpa::XS parser for the Dyck-Hollerith language
 
my $repeat;
if (@ARGV) {
$repeat = $ARGV[0];
die "Argument not a number" if not Scalar::Util::looks_like_number($repeat);
}
 
sub arg1 { return $_[1]; }
sub arg4 { return $_[4]; }
sub all_args { shift; return \@_; }
 
my $grammar = Marpa::XS::Grammar->new(
{ start => 'sentence',
lhs_terminals => 0,
rules => [
[ 'sentence', [qw(element)], 'main::arg1' ],
[ 'string', [qw(Schar Scount lparen text rparen)], 'main::arg4' ],
[ 'array', [qw(Achar Acount lparen elements rparen)], 'main::arg4' ],
{ lhs => 'elements', rhs => [qw(element)], min => 1, action=>'main::all_args' },
[ 'element', [qw(string)], 'main::arg1' ],
[ 'element', [qw(array)], 'main::arg1' ],
]
}
);
 
$grammar->precompute();
my $recce = Marpa::XS::Recognizer->new({ grammar => $grammar });
 
my $res;
if ($repeat) {
$res = "A$repeat(" . ('A2(A2(S3(Hey)S13(Hello, World!))S5(Ciao!))' x $repeat) . ')';
} else {
$res = 'A2(A2(S3(Hey)S13(Hello, World!))S5(Ciao!))';
}
 
my $string_length = 0;
my $position = 0;
my $input_length = length $res;
 
INPUT: while ($position < $input_length) {
pos $res = $position;
if ($res =~ m/\G S (\d+) [(]/xms) {
my $string_length = $1;
$recce->read( 'Schar');
$recce->read( 'Scount' );
$recce->read( 'lparen' );
$position += 2 + (length $string_length);
$recce->read( 'text', substr( $res, $position, $string_length ));
$position += $string_length;
next INPUT;
}
if ($res =~ m/\G A (\d+) [(]/xms) {
my $count = $1;
$recce->read( 'Achar');
$recce->read( 'Acount' );
$recce->read( 'lparen' );
$position += 2 + length $count;
next INPUT;
}
if ( $res =~ m{\G [)] }xms ) {
$recce->read( 'rparen' );
$position += 1;
next INPUT;
}
die "Error reading input: ", substr( $res, $position, 100 );
} ## end for ( ;; )
 
my $result = $recce->value();
die "No parse" if not defined $result;
my $received = Dumper(${$result});
 
my $expected = <<'EXPECTED_OUTPUT';
$VAR1 = [
[
'Hey',
'Hello, World!'
],
'Ciao!'
];
EXPECTED_OUTPUT
if ($received eq $expected )
{
say "Output matches";
} else {
say "Output differs: $received";
}

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.