source: src/genparser.pl @ cd76f9

#! /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): $!";