#!/usr/bin/perl

# make_parser.pl

use strict;
use warnings;

use Parse::RecDescent qw( );

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

        sub optimise_option {
            my ($option) = @_;
            for (;;) {
                return $option if @{ $option->{children} } != 1;
                my ($child) = @{ $option->{children} };
                return $option if $child->{type} ne 'option';
                $option = $child;
            }
        }

        sub optimise_alternation {
            my ($alternation) = @_;

            my $choices = $alternation->{choices};

            my $optional = 0;
            for my $choice (@$choices) {
                next if grep { $_->{type} ne 'option' } @$choice;

                $optional = 1;
                last;
            }

            return $alternation if !$optional;

            for my $choice (@$choices) {
                next if @$choice != 1;
                my ($child) = @$choice;
                next if $child->{type} ne 'option';
                @$choice = @{ $child->{children} };
            }

            return {
                type     => 'option',
                children => [ $alternation ],
            };
        }
    }


    parse       : command param(s?) /\Z/ { [ $item[1], @{$item[2]} ] }

    command     : IDENT

    param       : option
                | switch
                | variable
                | alternation
                | literal

    option      : '[' param(s?) ']'
                  { optimise_option({
                      type     => $item[0],
                      children => $item[2],
                  }) }

    switch      : DASHED variable(?)
                  { +{
                      type  => $item[0],
                      name  => $item[1],
                      value => @{$item[2]} ? $item[2][0]{name} : undef,
                  } }

    variable    : '<' <skip:''> IDENT '>'
                  { +{
                      type => $item[0],
                      name => $item[3],
                  } }

    alternation : '{' altern_body '}'
                  { optimise_alternation({
                      type    => $item[0],
                      choices => $item[2],
                  }) }

    altern_body : <leftop: param(s) '|' param(s) >

    literal     : IDENT
                  { +{
                      type  => $item[0],
                      value => $item[1],
                  } }

    IDENT       : /[a-zA-Z][a-zA-Z0-9-]*/
    DASHED      : /-[a-zA-Z][a-zA-Z0-9]*/

__END_OF_GRAMMAR__

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