#!/usr/bin/perl

# make_parser.pl

use strict;
use warnings;

use Parse::RecDescent qw( );

my $grammar = <<'__END_OF_GRAMMAR__';
   {
      use strict;
      use warnings;
   }

   parse         : <skip:''> item_list /\Z/ { $item[2] }

   item_list     : <leftop: item ',' item> { $item[1] }

   item          : prefix bodies { [ $item[1], $item[2] ] }
                 |        bodies { [ undef,    $item[1] ] }

   bodies        : group { $item[1] }
                 | body  { [ $item[1] ] }

   prefix        : '<*' INTEGER '>' { $item[2] }

   group         : '(' <leftop: body ',' body> ')' { $item[2] }

   body          : NAME suffix(?) { [ $item[1], @{ $item[2] } ] }

   suffix        : '<' suffix_list '>' { $item[2] }

   suffix_list   : INTEGER suffix_list_[ $item[1] ]

   suffix_list_  : ',' <leftop: INTEGER ',' INTEGER>
                   { [ ',' => $arg[0], @{ $item[2] } ] }

                 | ':' <leftop: INTEGER ':' INTEGER>
                   { [ ':' => $arg[0], @{ $item[2] } ] }

                 | { [ '' => $arg[0] ] }

   INTEGER     : /0|[1-9][0-9]*/
   NAME        : /[A-Za-z][A-Za-z0-9_]*/

__END_OF_GRAMMAR__

Parse::RecDescent->Precompile($grammar, 'Grammar')
   or die("Bad grammar\n");

##</code><code>##

#!/usr/bin/perl

# test.pl

use strict;
use warnings;

use Data::Dumper qw( Dumper );
use Grammar      qw( );

#$::RD_TRACE = '';

# ----------vvv  Example of what you can do  vvv----------

sub deparse_suffix {
   my ($suffix) = @_;
   return '' if !defined($suffix);
   my ($sep, @rest) = @$suffix;
   return '<' . join($sep, @rest) . '>';
}

sub deparse_body {
   my ($body) = @_;
   my ($name, $suffix) = @$body;
   return $name . deparse_suffix($suffix);
}

sub deparse_bodies {
   my ($bodies) = @_;
   my $deparsed = join ',', map deparse_body($_), @$bodies;
   return "($deparsed)" if @$bodies > 1;
   return $deparsed;
}

sub deparse_item {
   my ($item) = @_;
   my ($prefix, $bodies) = @$_;
   my $deparsed = '';
   $deparsed .= "<*$prefix>" if defined($prefix);
   $deparsed .= deparse_bodies($bodies);
   return $deparsed;
}

sub deparse_items {
   my ($items) = @_;
   return join ',', map deparse_item($_), @$items;
}

# ----------^^^  Example of what you can do  ^^^----------


my $parser = Grammar->new();

while (<DATA>) {
   chomp;
   my $items = $parser->parse($_)
      or do { warn("Bad data at line $.\n");
              next;
            };

   print("in:  $_\n");
   #print Dumper $items;
   print("out: ", deparse_items($items), "\n");
   print("\n");
}

__DATA__
<*2>FOO<2,1>,<*3>(SigB<8:0:2>,BAR),<*2>Siga<2:0>,Sigb<8,7,6,5,0>

##</code><code>##

$ perl make_parser.pl && perl test.pl
in:  <*2>FOO<2,1>,<*3>(SigB<8:0:2>,BAR),<*2>Siga<2:0>,Sigb<8,7,6,5,0>
out: <*2>FOO<2,1>,<*3>(SigB<8:0:2>,BAR),<*2>Siga<2:0>,Sigb<8,7,6,5,0>