#!/usr/bin/perl
# Convert header and standards @comments to @standards.

# Copyright (C) 2017 Free Software Foundation, Inc.
# This file is part of the GNU C Library.
# Contributed by Rical Jasan <ricaljasan@pacific.net>, 2017.

# The GNU C Library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public License
# as published by the Free Software Foundation; either version 2.1 of
# the License, or (at your option) any later version.

# The GNU C Library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.

# You should have received a copy of the GNU Lesser General Public
# License along with the GNU C Library; if not, see
# <http://www.gnu.org/licenses/>.

# This is a one-off script, used to convert existing header and
# standards annotations embedded in @comments to @standards macros.
# Buffers each input file, making adjustments as necessary, then
# replaces the file with the reannotated contents.

use strict;
use warnings;

# Files to convert.
my @texis = @ARGV;

# Track context.
my @lines;
my ($c, $s, $h); # Cur, Std, Hdr indices.

# Regexes.
my $cmt = qr/\@comment /;
my $hdr = qr/^${cmt}(([\w\/]+\.h,? ?)+(\(optional\))?|\(none\))$/i;
my $std = qr/^${cmt}[^\@]+/;
my $def = qr/^\@def/;
my $itm = qr/^\@itemx? /;
my $dix = qr/^\@(def\S+|item)x /;
my $stm = qr/\@standards/;
my $stx = qr/^${stm}x\{/;

# Convert.
for (@texis) {
    open my $input, '<', $_ or die "open $_: $!";
    while ($lines[@lines] = <$input>) {
	($c, $s, $h) = (@lines-1, @lines-2, @lines-3);
	if ($lines[$c] =~ $def || $lines[$c] =~ $itm)
	{
	    # Convert @comments to @standards.
	    my @standards = &convert($lines[$h], $lines[$s],
				     $lines[$c] =~ $dix
				     ? &get_elem($lines[$c]) : undef);

	    # Unannotated, but beware partial @*x chains.
	    next if ! @standards && $lines[$s] !~ /^${stm}/;

	    # Splice out the @comment(s).
	    if ($lines[$h] =~ $hdr) {
		splice @lines, $h, 1; --$s;
	    }
	    if ($lines[$s] =~ $std || $lines[$s] =~ $hdr) {
		splice @lines, $s, 1;
	    }

	    # Relocate preceding @standards.
	    my $i = my $j = $#lines-1;
	    while ($lines[$i] =~ /^${stm}/) {
		splice @standards, 0, 0, $lines[$i--];
	    }
	    splice @lines, $i+1, $j-$i;

	    # Convert @standards in @*x chains.
	    if ($standards[$#standards] =~ $stx && $standards[0] !~ $stx) {
		my $e = &get_elem($lines[$#lines-1]);
		$i = 0;
		while ($standards[$i] !~ $stx) {
		    $standards[$i++] =~ s/^(${stm})\{(.*)/$1x{$e, $2/;
		}
	    }
	    # Partial @*x chain w/ only the first annotation.
	    elsif (@standards == 1 && $lines[$#lines] =~ $dix
		     && $standards[0] !~ $stx)
	    {
		$i = $#lines;
		--$i while $lines[$i] =~ $dix;
		my $e = &get_elem($lines[$i]);
		$standards[0] =~ s/^(${stm})\{(.*)/$1x{$e, $2/;
	    }

	    # Append the @standards.
	    push @lines, @standards;
	}
    }

    close $input or die "close $_: $!";
    splice @lines, -1;

    # Collapse @*x chains with the same standard and header.
    for (my $i=0; $i<@lines; ++$i) {
	# First in chain.
	if ($lines[$i] =~ $stx) {
	    # Gather elements, standards, and headers.
	    my @a = (), my $j = $i;
	    while ($lines[$j++] =~ /^${stm}x\{([^,]+), ([^,]+), ([^,\}]+)\}$/) {
		push @a, [$1, $2, $3];
	    }
	    # Skip obvious partial annotations.
	    next if @a == 1;
	    # Skip if no default (first element multiply annotated).
	    if ($a[0]->[0] eq $a[1]->[0]) { $i += @a; next; }
	    # Establish a convention for "default" @standards.  This
	    # works here because @standardsx are already ordered.
	    $lines[$i] =~ s/^(${stm})x\{[^,]+, (.*)/$1\{$2/;
	    # Splice @standardsx with same headers and standards.
	    my $k = 0;
	    for ($j=1; $j<@a; ++$j) {
		if ($a[0]->[1] eq $a[$j]->[1] && $a[0]->[2] eq $a[$j]->[2]) {
		    splice @lines, $i+1, 1;
		    ++$k;
		}
	    }
	    $i += $k + 1; # Skip unconverted @standardsx.
	}
    }

    open my $output, '>', "$_" or die "open $_: $!";
    print $output @lines;
    close $output or die "close $_: $!";
    @lines=();
}

# Returns the annotated element from an @def or @item line.
sub get_elem
{
    my @toks = split /\s+/, shift;
    my $i = 0;
    for (; $i<@toks; $i++) {
	last if $toks[$i] =~ /^\(/;
    }
    return $toks[$i-1];
}

# Converts header and standards @comments to an array of @standards.
# The optional annotated element argument is used to determine whether
# @standards or @standardsx macros are generated.
sub convert
{
    my ($hl, $sl, $el) = @_;
    my (@hdrs, @stds);
    my ($i, $j, @arr);

    # Useful routine to split a header or standard line.  Uses a
    # little magic to distinguish the two where it counts.
    my $split = sub {
	my ($line, $ish) = @_;
	$line =~ s/^${cmt}//;
	chomp $line;
	if ($ish) {split /\s+/, $line}
	else {split /,\s+/, $line}
    };

    # Split the header and standards lines, handling cases of partial
    # or absent annotations.
    if ($hl =~ $hdr && $sl =~ $std) {
	@hdrs = $split->($hl, 1);
	@stds = $split->($sl, 0);
    } elsif ($sl =~ $hdr) {
	@hdrs = $split->($sl, 0);
	@stds = ('???');
    } elsif ($sl =~ $std) {
	@hdrs = ('???');
	@stds = $split->($sl, 0);
    } else {
	return (); # Unannotated.
    }

    # Append "(optional)" to the preceding header, which would have
    # incorrectly split on the intervening whitespace.
    for ($i=0; $i<@hdrs; ++$i) {
	if ($hdrs[$i] eq '(optional)') {
	    $hdrs[$i-1] .= " $hdrs[$i]";
	    splice @hdrs, $i--, 1;
	}
    }

    # Ensure we have equal length, paired, and populated header and
    # standards arrays.  Propagates the last header or standard; not
    # necessarily a convention, just a coping strategy.
    if (@hdrs != @stds) {
	if (@hdrs < @stds) {
	    $i = $#hdrs;
	    for ($j=@hdrs; $j<@stds; ++$j) {
		$hdrs[$j] = $hdrs[$i];
	    }
	} else {
	    $i = $#stds;
	    for ($j=@stds; $j<@hdrs; ++$j) {
		$stds[$j] = $stds[$i];
	    }
	}
    }

    # Generate the list of @standards.
    for ($i=0; $i<@hdrs; ++$i) {
	if ($el) {
	    push @arr, "\@standardsx{$el, $stds[$i], $hdrs[$i]}\n";
	} else {
	    push @arr, "\@standards{$stds[$i], $hdrs[$i]}\n";
	}
    }

    return @arr;
}