#! /usr/bin/env perl
#
# This file contains common routines for reading a file of function prototypes
# (such as mpi.h) and extracting the function prototypes.

#
# ReadInterface( filename, routineprefix, routinepattern, routinehash )
# Read file filename, look for routines that have a given prefix and name
# pattern, and insert that routine into routinehash with value the
# arguments of the routine.

#$Finalized_args = "bool";

sub ReadInterface {
    my $prototype_file = $_[0];
    my $routine_prefix = $_[1];
    my $routine_pattern = $_[2];
    my $routine_hash    = $_[3];
    # $debug is a global variable

    open( FD, "<$prototype_file" ) || die "Cannot open $prototype_file\n";

    # Skip to prototypes
    while (<FD>) {
        if ( /\/\*\s*Begin Prototypes/ ) { last; }
    }

    # Read each one
    while (<FD>) {
        # Handle the special case of prototypes to ignore
        if (/\/\*\s*Begin Skip Prototypes/) {
            while (<FD>) {
                if (/\/\*\s*End Skip Prototypes/) { last; }
            }
        }
        if (/\/\*\s*End Prototypes/) { last; }
        # Remove any comments
        $origline = $_;
        while (/(.*)\/\*(.*?)\*\/(.*)/) {
            my $removed = $2;
            $_ = $1.$3;
            if ($2 =~ /\/\*/) {
                print STDERR "Error in processing comment within interface file $prototype_file in line $origline";
            }
        }

        # Parse all routines returning an error code
        print "\nParsing : $_" if $gDebug;
        if (/^int\s+$routine_prefix($routine_pattern)\s*\((.*)/) {
            $routine_name = $1;
            $args = $2;
            while (! ($args =~ /;/)) {
                $args .= <FD>;
            }
            $args =~ s/MPICH_ATTR[A-Z_]*\([^)]*\)//g;
            $args =~ s/\)\s*;//g;
            $args =~ s/[\r\n]*//g;
            # remove qualifiers from args
            $args =~ s/\s*const\s+//g;

            print "Found   : $routine_name($args)\n" if $gDebug;
            # Eventually, we'll create a new file here.
            # For C++, we may create similar files by looking up
            # the corresponding routines.
            # Check for duplicates in the list of routines
            if (defined($$routine_hash{$routine_name})) {
                print STDERR "Duplicate prototypes for $routine_name\n";
                next;
            }
            # Seperate argument types and names
            my ($argtypes, $argnames) = &separate_args_and_append_ierror($args);
            # # Handle special cases
            # my $testname = $routine_name . "_args";
            # if (defined($$testname)) {
            # print "replacing args for $routine_name\n" if $gDebug;
            # $args = $$testname;
            # }
            $$routine_hash{$routine_name} = [$argtypes, $argnames];
        }
    }
}

#
# Look through $args, separate type and name of each argument. Then group argument
# types and names separately. In addition, append "int", "ierror" to existing
# argument types and names respectively.
# Input: an argument string
# Output: ($argtypes, $argnames), in which types (names) are delimited by comma.
sub separate_args_and_append_ierror {
    my $argtypes = "";
    my $argnames = "";
    my $comma = ""; # no comma before the first arg
    for my $parm (split(',', $_[0])) {
        my $argtype = "";
        my $argname = "";
        # Remove any leading or trailing spaces
        $parm =~ s/^\s*//;
        $parm =~ s/\s*$//;
        # Remove and remember qualifiers
        $qualifier = "";
        if ($parm =~ /^const\s+(.*)/) {
            $qualifier = "const ";
            $parm = $1;
        }

        if ($parm eq "void") { # e.g., MPI_Finalize(void)
            last;
        }

        # Question: What to do with the qualifier?
        # Handle parameters with parameter names
        # 1. "int foo"
        # 2. "int *foo"
        # 3. "int foo[]"
        # 4. "int *foo[]" or "int **foo[]"
        if ( ($parm =~ /^([A-Za-z0-9_]+)\s+([A-Za-z0-9_]+)$/) ) {
            $argtype = $1;
            $argname = $2;
        }
        elsif ( ($parm =~ /^([A-Za-z0-9_]+\s*\*)\s*([A-Za-z0-9_]+)$/) ) {
            $argtype = $1;
            $argname = $2;
        }
        elsif ( ($parm =~ /^([A-Za-z0-9_]+)\s*([A-Za-z0-9_]+)(\[.*\])\s*$/) ) {
            my $basetype = $1;
            my $arraytype = $3;
            #if ($arraytype =~ /\[\s*\]/) { $arraytype = "*"; }
            $argtype = $basetype . $arraytype;
            $argname = $2;
        }
        elsif ( ($parm =~ /^([A-Za-z0-9_]+)\s(\*?\*?)\s*([A-Za-z0-9_]+)(\[.*\])\s*$/) ) {
            my $basetype = $1;
            my $arraytype = $2 . $4;
            #if ($arraytype =~ /\[\s*\]/) { $arraytype = "*"; }
            $argtype = $basetype . $arraytype;
            $argname = $3;
        }

        $argtypes .= "$comma$argtype";
        $argnames .= "$comma$argname";
        $comma = ",";
    }

    # Append "int ierror"
    $argtypes .= "${comma}int";
    $argnames .= "${comma}ierror";
    print "argtypes= $argtypes\n" if $gDebug;
    print "argnames= $argnames\n" if $gDebug;
    return ($argtypes, $argnames);
}

# Since this is a required package, indicate that we are successful.
return 1;