length-prefixed.pl

#!/usr/bin/perl
use 5.010;
use strict;
use warnings;

use Marpa::R2 2.100;
use Data::Dumper;

# array: 'A' count ':' element+
# string: 'S' length ':' byte+
# element: array | string

my $grammar = Marpa::R2::Scanless::G->new({
    source => \q{
      :default ::= action => [values]
      :start ::= document
      document ::= array | string
      array ::= 'A' <array count> ':' elements <end of array> action => array
      elements ::= element+
      element ::= string action => ::first
      element ::= array action => ::first
      event 'predicted element' = predicted element
      event 'completed element' = completed element

      string ::= 'S' <string length> ':' bytes action => string

      <array count> ~ [\d]+
      :lexeme ~ <array count> pause => after event => 'array count'
      <string length> ~ [\d]+
      :lexeme ~ <string length> pause => after event => 'string length'
      bytes ~ [\x00-\xff]
      :lexeme ~ bytes pause => before event => 'bytes'
      <end of array> ~ [^\d\D]
    },
});

my $slr = Marpa::R2::Scanless::R->new({
    grammar => $grammar,
    semantics_package => 'main',
#    trace_terminals => 1,
});

sub string {
  return $_[4];
}

sub array {
  return $_[4];
}

my $input = 'A2:A2:S5:helloS5:worldS1:!';
# This one will cause a parse error, as it should
# (3 elements in a 2-element array)
# my $input = 'A2:S5:helloS5:worldS5:extra';

my ($string_length, @array_count);

INPUT: for(
  my $pos = $slr->read( \$input );
  $pos < length($input);
  $pos = $slr->resume($pos)
) {
  EVENTS: {
    my ($lexeme_start, $lexeme_length) = $slr->pause_span;
    for my $event (@{ $slr->events }) {
        my ($name) = @{$event};
        # string
        if ($name eq 'string length') {
          $string_length = 0 + $slr->literal($lexeme_start, $lexeme_length);
          warn "Set string length to $string_length\n";
        }
        elsif ($name eq 'bytes') {
          warn "Reading $string_length bytes at $lexeme_start\n";
          $slr->lexeme_read('bytes', $lexeme_start, $string_length);
          $pos = $slr->pos();
          redo EVENTS; # Reading bytes triggers "completed element"
        }
        # array
        elsif ($name eq 'array count') {
          my $count = 0 + $slr->literal($lexeme_start, $lexeme_length);
          push @array_count, $count;
          warn "Beginning array of $count elements\n";
        }
        elsif ($name eq 'completed element') {
          $array_count[-1] --;
          warn "got an element, $array_count[-1] left\n";
        }
        elsif ($name eq 'predicted element') {
          if ($array_count[-1] == 0) {
            warn "array complete\n";
            pop @array_count;
            $slr->lexeme_read('end of array', $slr->pos, 0);
            redo EVENTS; # Finishing the array might have caused another "completed element"
          }
        }
    } # for my $event
  }
}

my $val = $slr->value;
if ($$val) {
  print Dumper($$val);
} else {
  print "Error";
}