#!@PERL@ -w
# vim: set ft=perl ts=4 sw=4 et :
use warnings;
use strict;
my @types = qw(CONSTANT DEFINE ENUM FUNCTION MACRO STRUCT TYPEDEF UNION
               USER_FUNCTION VARIABLE);
my $filterout = '^_';
my %overrides;
if (scalar @ARGV != 1 and scalar @ARGV != 2) {
    print <<EOF
Usage: $0 [config.pl] FOO-decl.txt >OUTPUT

Config-file options:
  filterout      Exclude symbols matching this regexp (default: '^_')
  overrides      Declaration override map (like ('NULL' => 'Constant', ... ))
                 - nonexistent symbols are inserted
                 - symbols mapped to undef or empty type are removed

Gtk-doc declaration types (case doesn't matter):
  Constant, Macro, Function, Struct, Enum, Union, Typedef, User_Function,
  Variable
Extra symbol types:
  Define (parameterless macro)
EOF
    ;
    exit;
}
if (scalar @ARGV == 2) { require $ARGV[1] }
my $types = join '|', @types;

sub Normalize {
    return join '',(map ucfirst lc, (split /_/, $_[0]));
}

sub Values {
    my $dict = $_[0];
    my %values;
    local $_;
    for (keys %$dict) { $values{$dict->{$_}} = 1 }
    return sort keys %values;
}

# Override symbols, they are created if they don't exist, if they map to undef,
# they are removed.
sub Override {
    my ($decls, $overrides) = @_;
    foreach my $ident (%$overrides) {
        my $type = $overrides->{$ident};
        if (defined $type and $type) { $decls->{$ident} = [ uc $type ] }
        elsif (defined $decls->{$ident}) { delete $decls->{$ident} }
    }
}

sub Add {
    my ($decls, $ident, $type) = @_;
    my $d = $decls->{$ident};
    if (defined $d) { if (not grep {$_ eq $type} @$d) { push @$d, $type } }
    else { $decls->{$ident} = [ $type ] }
}

sub AddEnumValue {
    my ($decls, $value) = @_;
    &Add($decls, $value, 'CONSTANT');
    return '';
}

sub AddDecl {
    my ($ident, $type, $body, $decls, $indirect, $deprecated) = @_;

    if ($ident =~ m/$filterout/o) { return '' }
    if ($body =~ m/<DEPRECATED\/>/) { $deprecated->{$ident} = 1 }

    # Change parameterless macros to constants.  If they resolve to an
    # identifier, remember them for symbol type remapping.
    if ($type eq 'MACRO' and $body !~ m/^\s*#\s*define\s+\w+\(/m) {
        $type = 'DEFINE';
        if ($body =~ m/^\s*#\s*define\s+\w+\s+([A-Za-z_]\w+)\s*/mp) {
            $indirect->{$ident} = $1
        }
    }

    # Add the identifier to the declaration list.  They are stored as list
    # references as they can appear as multiple different types (to be resolved
    # later).
    &Add($decls, $ident, $type);

    # Find enum values and make them constants
    if ($type eq 'ENUM') {
        $body =~ s/^\s+([A-Z][A-Z0-9_]+)\b/AddEnumValue($decls,$1)/egm
    }
    return '';
}

# Read FOO-decl.txt, updating the declaration dictionary and identifier types
sub ReadDeclTxt {
    my ($filename, $decls, $indirect, $deprecated) = @_;
    local $/;
    if (not open FH, $filename) {
        die "Cannot open declaration list $filename: $!\n"
    }
    my $text = <FH>;
    close FH;
    # We don't really want to replace anything.  This seems to be the closest
    # to python's re.finditer() as it can get.
    $text =~ s/<($types)>\n
               <NAME>(\w+)<\/NAME>\n
               (.*?)
               <\/\1>\n/AddDecl($2,$1,$3,$decls,$indirect,$deprecated)/egosx;
}

# Kill macros if the same symbol also exists as a regular symbol of another
# type (this fixes things like g_file_test()).
sub ResolveMacros {
    my ($decls, $indirect) = @_;
    foreach my $macro (keys %$indirect) {
        # No other meaning
        my $d = $decls->{$macro};
        next if scalar @$d == 1;
        # Multiple types, remove the macro meaning.
        my @d = grep { $_ ne 'DEFINE' } @$d;
        $decls->{$macro} = \@d;
    }
}

sub FindConflicts {
    my $decls = $_[0];
    foreach my $ident (keys %$decls) {
        my $d = $decls->{$ident};
        if (scalar @$d == 1) {
            $decls->{$ident} = $d->[0];
            next;
        }
        # If there's MACRO in the mix, try to remove it if it improves things.
        my @d = grep { $_ ne 'MACRO' } @$d;
        if (scalar @d == 1) {
            $decls->{$ident} = $d[0];
            next;
        }
        # A hard conflict
        warn "$ident has multiple types: ", join(', ', @d), " keeping $d[0].\n";
        # First came, first served
        $decls->{$ident} = $d[0];
    }
}

my (%decls, %indirect, %deprecated);
&ReadDeclTxt($ARGV[0], \%decls, \%indirect, \%deprecated);
&ResolveMacros(\%decls, \%indirect);
&Override(\%decls, \%overrides);
&FindConflicts(\%decls);

my @symbols = sort keys %decls;
for my $type (&Values(\%decls)) {
    my $normalsym = join(' ', sort(grep {$decls{$_} eq $type
                                         and not defined $deprecated{$_}}
                                   @symbols));
    my $deprecatedsym = join(' ', sort(grep {$decls{$_} eq $type
                                             and defined $deprecated{$_}}
                                       @symbols));
    $type = &Normalize($type);
    if ($normalsym) { print "$type $normalsym\n" }
    if ($deprecatedsym) { print "${type}Deprecated $deprecatedsym\n" }
}
