Fantasy Name Generator - a parser

This post is a part of the “Fantasy Name Generator” series:

1. Fantasy Name Generator - a grammar

2. Fantasy Name Generator - a parser

3. Global matching in scalar context

4. nayme - a Fantasy Name Generator

5. Fantasy Name Generator

TL;DR

A parser for the grammar in Fantasy Name Generator - a grammar.

We will of course leverage on the Parsing toolkit in cglib 🤓

sub nayme_parse ($expression) {
  my $realgroup;
  my $group = sub { goto $realgroup };
  my $literal = pf_match_and_filter(
     pf_regexp(qr{([^|()<>]+)}),
     sub ($match) { return $match->[0] },
  );
  my $literal_set = pf_alternatives($literal, $group);
  my $literal_exp =
    pf_match_and_filter(pf_repeated($literal_set, 0, -1), \&flatten_exp,);
  my $literal_list = pf_match_and_filter(pf_list($literal_exp, '|'),
     \&flatten_literal_list);
  my $literal_group = pf_match_and_filter(
     pf_sequence('(', $literal_list, ')'),
     sub ($match) { $match->[1] },
  );

  my $template = pf_match_and_filter(
     pf_regexp(qr{([-BcCdDimMsvV']+)}),
     sub ($match) {
        [map { {template => $_} } split m{}mxs, $match->[0]]
     },
  );
  my $template_set = pf_alternatives($template, $group);
  my $template_exp =
    pf_match_and_filter(pf_repeated($template_set, 0, -1), \&flatten_exp,
    );
  my $template_list = pf_list($template_exp, '|');
  my $template_group = pf_match_and_filter(
     pf_sequence('<', $template_list, '>'),
     sub ($match) { return $match->[1] },
  );

  $realgroup = pf_match_and_filter(
     pf_alternatives($template_group, $literal_group),
     sub ($match) {
        return $match->@* > 1
          ? {alternatives => $match}
          : $match->[0];
     },
  );
  my $name = pf_alternatives($template_list, $realgroup);

  my $ast = $name->(\$expression);
  my $pos = pos($expression) || 0;
  die 'fail to match: [' . substr($expression, $pos) . "]\n"
    if $pos < length($expression);
  return $ast->[0];
} ## end sub nayme_parse ($expression)

Lines 2-3 are a trick to allow for mutual recursiveness in how the parsing elements can call each other. We pre-declare the parsing variable that will hold the parser for grammar element group as $realgroup. This will eventually be a reference to a sub, but we’re not ready yet (we will not be until line 34, actually). So we will wrap it in an actual reference to a sub $group (line 3), whose only goal will be to call $realgroup.

I don’t know if this can be done in a simpler way, but at least this is a way!

The first batch of parsing references (lines 4 through 16) implement the literal part. There is some wrapping and simplification of the returned values, mainly aimed at producing a simpler output without too many levels.

The second batch (lines 18 through 32) implement the template part. The original grammar was taking care to get one single template character at a time, but the pattern matcher is currently using the /g modifier and is anyway getting all of them. So we are collecting them at once, and then split them into individual parts (line 21).

At line 34 everything is available to finally define the group part into $realgroup, which will eventually enable $group to work correctly.

Lines 44 through 48 implement the actual parsing of the inputs. After the parsing (line 44), we make sure that nothing was left (lines 45 through 47) and eventually return the parsing result.

The simplification is performed using a couple of helper functions:

sub flatten_literal_list ($match) {
   my @retval = map {
      if (ref $_ eq 'ARRAY') {
         my @portion;
         for my $item ($_->@*) {
            if (ref($item) || (@portion == 0) || ref($portion[-1])) {
               push @portion, $item;
            }
            elsif (@portion > 0) {
               $portion[-1] .= $item;
            }
         } ## end for my $item ($_->@*)
         @portion > 1 ? \@portion : $portion[0];
      } ## end if (ref $_ eq 'ARRAY')
      else {
         $_;
      }
   } $match->@*;
   return @retval ? \@retval : '';
} ## end sub flatten_literal_list ($match)

sub flatten_exp ($match) {
   my @retval = map { ref $_ eq 'ARRAY' ? $_->@* : $_ } $match->@*;
   return @retval ? \@retval : '';
}

These functions make sure to flatten some arrays and avoid too much unneeded nesting.

Let’s see it at work on a a few expressions with this simple wrapper:

use Data::Dumper; $Data::Dumper::Indent = 1;
say Dumper nayme_parse(shift);
exit 0;

Here we go:

$ ./nayme 'B<what|ever>c'
$VAR1 = [
  {
    'template' => 'B'
  },
  {
    'alternatives' => [
      'what',
      'ever'
    ]
  },
  {
    'template' => 'c'
  }
];

$ ./nayme '<<<<<<<s>>>>>>>';
$VAR1 = [
  {
    'template' => 's'
  }
];

The second example takes a few milliseconds to run (it was taking minutes to the parser based on Parse::RecDescent). Also… I like the simplified form a lot 😄.

ETOOBUSY 🚀 minimal blogging for the impatient