#! /usr/bin/perl
#
# Copyright (C) 2007 Tomash Brechko.  All rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself, either Perl version 5.8.8
# or, at your option, any later version of Perl 5 you may have
# available.
#
use warnings;
use strict;

use FindBin;

@ARGV == 3
    or die "Usage: $FindBin::Script KEYWORD_FILE FILE_C FILE_H\n";

my ( $keyword_file, $file_c, $file_h ) = @ARGV;

my %C;
my @keywords;

open( my $kw, '<', $keyword_file )
    or die "open(< $keyword_file): $!";

my $section = 0;
while ( my $line = <$kw> ) {
    chomp $line;

    if ( $line =~ /^\s*(?:#.*)?$/ ) {
        next;
    }
    elsif ( $line =~ /^\s*%%\s*$/ ) {
        ++$section;
        next;
    }

    if ( $section == 0 and $line =~ /^\s*(\S+)\s*=\s*(\S+)\s*$/ ) {
        $C{$1} = $2;
    }
    elsif ( $section == 1 ) {
        push @keywords, $line;
    }
    else {
        die "Can't parse line: $line";
    }
}

close($kw);

sub dispatch_keywords {
    my ($words) = @_;

    return $words if @$words <= 1;

    my $len    = 0;
    my $common = 1;
    while ($common) {
        ++$len;
        my $prefix = substr( $$words[0], 0, $len );
        $common = !grep( !/^$prefix/, @$words );
    }
    --$len;

    my $prefix = substr( $$words[0], 0, $len );

    my %subtree;
    foreach my $word (@$words) {
        my $key = substr( $word, $len, 1 );
        my $val = substr( $word, $len + 1 );
        push @{ $subtree{$key} }, $val;
    }

    foreach my $val ( values %subtree ) {
        $val = dispatch_keywords($val);
    }

    return [ $prefix, \%subtree ];
}

my $tree = dispatch_keywords( \@keywords );

my @external_enum = qw(NO_MATCH);

sub create_switch {
    my ( $depth, $prefix, $common, $hash ) = @_;

    my $I    = ' ' x ( $depth * 4 );
    my @keys = sort keys %$hash;
    ( my $common_ident = $common ) =~ s/[^A-Z_]//g;
    my $phase = $prefix . $common_ident;
    my $res   = '';

    if ($common) {
        if ( $C{loose_match} ) {
            $res .= <<"EOF";
$I  *pos += @{[ length $common ]};

EOF
        }
        else {
            $res .= <<"EOF";
$I  match_pos = "$common";

$I  do
$I    {
$I      if (**pos != *match_pos)
$I        return NO_MATCH;

$I      ++*pos;
$I      ++match_pos;
$I    }
$I  while (*match_pos != '\\0');

EOF
        }
    }
    if ( $common or $depth ) {
        if ( !@keys ) {
            push @external_enum, $phase;
            $res .= <<"EOF";
$I  return $phase;

EOF
            return $res;
        }
    }

    $res .= <<"EOF";
$I  switch (*(*pos)++)
$I    {
EOF

    foreach my $key (@keys) {
        my $subphase = $phase . $key;
        $res .= <<"EOF";
$I    case '$key':
EOF
        $res .= create_switch( $depth + 1, $subphase, @{ $$hash{$key} } );
    }

    $res .= <<"EOF";
$I    default:
$I      return NO_MATCH;
$I    }
EOF

    return $res;
}

my $switch = create_switch( 0, 'MATCH_', @$tree );

my $gen_comment = <<"EOF";
/*
  This file was generated with $FindBin::Script from
  $keyword_file.

  Instead of editing this file edit the keyword file and regenerate.
*/
EOF

open( my $fc, '>', $file_c )
    or die "open(> $file_c): $!";

my $i = 0;
print $fc <<"EOF";
$gen_comment
#include "$file_h"


enum $C{parser_func}_e
$C{parser_func}(char **pos)
{
EOF

unless ( $C{loose_match} ) {
    print $fc <<"EOF";
  char *match_pos;

EOF
}

print $fc <<"EOF";
$switch
  /* Never reach here.  */
}
EOF

close($fc)
    or die "close($file_c): $!";

my $guard = uc $file_h;
$guard =~ s/[^[:alnum:]_]/_/g;

open( my $fh, '>', $file_h )
    or die "open(> $file_h): $!";

print $fh <<"EOF";
$gen_comment
#ifndef $guard
#define $guard 1


enum $C{parser_func}_e {
  @{[ join ",\n  ", @external_enum ]}
};


extern
enum $C{parser_func}_e
$C{parser_func}(char **pos);


#endif /* ! $guard */
EOF

close($fh)
    or die "close($file_h): $!";