Marpa::R2 version of Perl6 Advent Calendar - Day 18 – A Grammar with Duplicate checking Reference: https://perl6advent.wordpress.com/2013/12/18/day-18-a-grammar-with-duplicate-checking/

perl6advent.day18.with.marpa.pl

#!env perl
use strict;
use diagnostics;
use Marpa::R2;
use Encode;
use Carp qw/croak/;
use Data::Section -setup;

# Guess why
# ---------
binmode STDOUT, ':utf8';                                

# Grammar and test suite are in __DATA__
# --------------------------------------
my $data = __PACKAGE__->local_section_data;
my $grammar_source = $data->{grammar_source};
my @tests = grep {"$_"} split(/\n/, ${$data->{tests}});

map {printf "%-40s : %s\n", $_, play($_) || "OK"} @tests;

###########################################################

#
# Use an event during the parsing
# -------------------------------
sub play {
    my $input = shift;

    # Note: in production, no need to recompute G each time
    my $grammar = Marpa::R2::Scanless::G->new({ source => $grammar_source});
    my $re      = Marpa::R2::Scanless::R->new( { grammar => $grammar } );
    my $length  = length $input;

    my %played = ();
    my $pos = eval {$re->read(\$input)};
    return $@ if $@;
    do {
	# In our example there is a single event: no need to ask Marpa what it is
	my ($start, $length) = $re->g1_location_to_span($re->current_g1_location());
	my $card = $re->literal($start, $length);
	return "Duplicate card " . decode_utf8($card) if (++$played{$card} > 1);
	eval {$pos = $re->resume()};
	return $@ if $@;
    } while ($pos < $length);
    return $re->value() ? '' : show_last_hand($re);
}

#
# In case parse succeed but is incomplete: get last card parsed
# -------------------------------------------------------------
sub show_last_hand {
  my ($re) = @_;

  my ($start, $end) = $re->last_completed_range('hand');
  return 'No source element was successfully parsed' if (! defined($start));
  my $lastHand = $re->range_to_string($start, $end);
  return "Last hand successfully parsed was: $lastHand";
}
__DATA__

__[ grammar_source ]__
:start ::= deal
deal ::= hands
hands ::= hand | hands ';' hand
hand ::= card card card card card
card ~ face suit
face ~ [2-9jqka] | '10'
suit ~ [\x{2665}\x{2666}\x{2663}\x{2660}]
WS ~ [\s]
:discard ~ WS

:lexeme ~ <card>  pause => after event => 'card'

__[ tests ]__
2♥ 5♥ 7♦ 8♣ 9♠
2♥ a♥ 7♦ 8♣ j♥
a♥ a♥ 7♦ 8♣ j♥
a♥ 7♥ 7♦ 8♣ j♥; 10♥ j♥ q♥ k♥ a♥
2♥ 7♥ 2♦ 3♣ 3♦
2♥ 7♥ 2♦ 3♣
2♥ 7♥ 2♦ 3♣ 3♦ 1♦
2♥ 7♥ 2♦ 3♣
a♥ 7♥ 7♦ 8♣ j♥; 10♥ j♣ q♥ k♥

Output is:

2♥ 5♥ 7♦ 8♣ 9♠                           : OK
2♥ a♥ 7♦ 8♣ j♥                           : OK
a♥ a♥ 7♦ 8♣ j♥                           : Duplicate card a♥
a♥ 7♥ 7♦ 8♣ j♥; 10♥ j♥ q♥ k♥ a♥          : Duplicate card j♥
2♥ 7♥ 2♦ 3♣ 3♦                           : OK
2♥ 7♥ 2♦ 3♣                              : No source element was successfully parsed
2♥ 7♥ 2♦ 3♣ 3♦ 1♦                        : Error in SLIF parse: No lexeme found at line 1, column 16
* String before error: 2\x{2665} 7\x{2665} 2\x{2666} 3\x{2663} 3\x{2666}\s
* The error was at line 1, column 16, and at character 0x0031 '1', ...
* here: 1\x{2666}
Marpa::R2 exception at /tmp/perl6advent.day18.with.marpa.pl line 42.

2♥ 7♥ 2♦ 3♣                              : No source element was successfully parsed
a♥ 7♥ 7♦ 8♣ j♥; 10♥ j♣ q♥ k♥             : Last hand successfully parsed was: a♥ 7♥ 7♦ 8♣ j♥