#!/usr/bin/perl

use strict;
use Getopt::Std;

# interface.cbc
# typedef struct Worker {
#         int id;
#         struct Context* contexts;
#         enum Code execute;
#         enum Code taskSend;
#         enum Code taskRecive;
#         enum Code shutdown;
#         struct Queue* tasks;
#     } Worker;

our($opt_o,$opt_d,$opt_h);
getopts('o:d:h');

my $dir = ".";
if ($opt_d) {
    $dir = $opt_d;
    if (! -d $dir) {
        mkdir $dir;
    }
}

for my $fn (@ARGV) { 
    next if ($fn !~ /\.cbc$/);
    &getDataGear($fn);
    &generateDataGear($fn);
}

my %var;
my %code;
my %dataGearVar;
my %outputVar;       # output var initializer
my %outputArgs;      # continuation's output variables
my %dataGear;
my %dataGearName;
my %generic;
my %dataGearVarType;
my $implementation;
my $interface;

# interface definision
#
# typedef struct Stack<Type, Impl>{
#         Type* stack;
#         Type* data;
#         Type* data1;
#         __code whenEmpty(...);
#         __code clear(Impl* stack,__code next(...));
#         __code push(Impl* stack,Type* data, __code next(...));
#         __code pop(Impl* stack, __code next(Type*, ...));
#         __code pop2(Impl* stack, Type** data, Type** data1, __code next(Type**, Type**, ...));
#         __code isEmpty(Impl* stack, __code next(...), __code whenEmpty(...));
#         __code get(Impl* stack, Type** data, __code next(...));
#         __code get2(Impl* stack,..., __code next(...));
#         __code next(...);
# } Stack;
#
# calling example
#
# goto nodeStack->push((union Data*)node, stackTest3);
#
# generated meta level code
#
# Gearef(context, Stack)->stack = nodeStack->stack;
# Gearef(context, Stack)->data = (union Data*)node;
# Gearef(context, Stack)->next = C_stackTest3;
# goto meta(context, nodeStack->push);

sub getDataGear {
    my ($filename) = @_;
    my ($codeGearName, $name, $inTypedef);
    open my $fd,"<",$filename or die("can't open $filename $!");
    while (<$fd>) {
        if (! $inTypedef) {
            if (/^typedef struct (\w+)\s*<(.*)>/) {
                $inTypedef = 1;
                $name = $1;
                $dataGear{$name} = $_;
                $var{$name} = {};
                $code{$name} = {};
                $generic{$name} = \split(/,/,$2);
            } elsif (/^typedef struct (\w+)/) {
                $inTypedef = 1;
                $name = $1;
                $dataGear{$name} = $_;
                $var{$name} = {};
                $code{$name} = {};
                $generic{$name} = [];
            } elsif (/^(\w+)(\*)+ create(\w+)\(/) {
                if (defined $interface) {
                   die "duplicate interface $interface\n"; 
                }
                $interface = $1;
                $implementation = $3;
                if ( -f "$interface.cbc") {
                    &getDataGear("$interface.cbc");
                }
            } elsif (/^(\s)*(\w+)\-\>(\w+)\s\=\s\((.*)\)create(\w+)\((\w+)\);$/) {
                #my $intfn = ucfirst($2);
                my $impln = $5;
                if ( -f "$impln.cbc") {
                    &getCodeGear("$impln.cbc");
                }
            }
            next;
        }
        # gather type name and type
        $dataGear{$name} .= $_;
        if (/^\s*(.*)\s+(\w+);$/ ) {
            my $ttype = $1;
            my $tname = $2;
            if ($ttype =~ /^(union|struct) (\w+)/) {
                $ttype = $2;
            }
            $var{$name}->{$tname} = $ttype;
        }
        if (/^}/) {
            $inTypedef = 0;
        }
    }
}

sub getCodeGear {
    my ($filename) = @_;
    open my $fd,"<",$filename or die("can't open $filename $!");
    my ($name,$impln);
    while (<$fd>) {
        if (/^(\w+)(\*)+ create(\w+)\(/) {
            $name = $1;
            $impln = $3;
        }
        if (defined $name) {
            if (/^\_\_code (\w+)$impln\((.*)\)(.*)/) {
                my $args = $2;
                my $method = $1;
                $code{$name}->{$method} = [];
                while($args) {
                    if ($args =~ s/(^\s*,\s*)//) {
                    }
                    # continuation case
                    if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) {
                        my $next = $2;
                        my @args = split(/,/,$3);
                        push(@{$code{$name}->{$method}},"\_\_code $next"); 
                    } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) {
                        my $structType = $1;
                        my $typeName = $2;
                        my $varName = $4;
                        my $typeField = lcfirst($typeName);
                        push(@{$code{$name}->{$method}},"$typeName $varName"); 
                    } elsif ($args =~ s/(.*,)//) {
                    } else {
                        last;
                    }
                }
            }
        }
    }
}

sub generateStub {
    my($fd,$prevCodeGearName,$dataGearName) = @_;
    print $fd "__code ", $prevCodeGearName ,"_stub(struct Context* context) {\n";
    print $fd $dataGearName;
    print $fd "\n} \n\n";
    return 1;
}

sub generateStubArgs {
    my($codeGearName, $varName, $typeName, $typeField, $interface,$output) = @_;
    my $varname1 = $output?"O_$varName":$varName; 
    for my $n ( @{$dataGearVar{$codeGearName}} ) {
        # we already have it
        return 0 if ( $n eq $varname1);
    }
    push @{$dataGearVar{$codeGearName}}, $varname1;
    push @{$dataGearVarType{$codeGearName}}, $typeName;
    if ($typeName eq $implementation) {
        # get implementation
        $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n";
    } else {
        for my $ivar (keys %{$var{$interface}}) {
            #  input data gear field 
            if ($varName eq $ivar) {
                if ($typeName eq $var{$interface}->{$ivar}) {
                    if ($output) {
                        $dataGearName{$codeGearName} .= "\t$typeName** O_$varName = &Gearef(context, $interface)->$varName;\n";
                        $outputVar{$codeGearName} .= "\t$typeName* $varName;\n";
                        return 1;
                    }
                
                    $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $interface)->$varName;\n";
                    return 1;
                }
            }
        }
        for my $cName (keys %{$code{$interface}}) {
            if ($varName eq $cName) {
                # continuation field
                $dataGearName{$codeGearName} .= "\tenum Code $varName = Gearef(context, $interface)->$varName;\n";
                return 1;
            }
        }
        # global variable case
        $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $typeName);\n";
        return 1;
    }
}

sub generateDataGear {
    my ($filename) = @_;
    open my $in,"<",$filename or die("can't open $filename $!");

    my $fn;
    if ($opt_o) {
       $fn = $opt_o;
    } else {
        my $fn1 = $filename;
        $fn1 =~ s/\.cbc/.c/;
        my $i = 1;
        $fn = "$dir/$fn1";
        while ( -f $fn) {
            $fn = "$dir/$fn1.$i";
            $i++;
        }
    }
    if ( $fn =~ m=(.*)/[^/]+$= ) {
        if (! -d $1) {
            mkdir $1;
        }
    }
    open my $fd,">",$fn or die("can't write $fn $!");

    my $prevCodeGearName;
    my $inTypedef = 0;
    my $inStub = 0;
    my %stub;
    my $codeGearName;

    while (<$in>) {
        if (! $inTypedef && ! $inStub) {
            if (/^typedef struct (\w+) {/) {
                $inTypedef = 1;
            } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) {
                $codeGearName = $1;
                my $args = $2;
                my $tail = $3;
                if ($codeGearName =~ /_stub$/) {
                    # don't touch already existing stub
                    $inStub = 1;
                    $stub{$codeGearName} = 1;
                    print $fd $_;
                    next;
                }
                if (defined $prevCodeGearName) {
                    # stub is generated just before next CodeGear
                    if (defined $stub{$prevCodeGearName."_stub"}) {
                        undef $prevCodeGearName;
                    } else {
                        &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName});
                        $stub{$prevCodeGearName."_stub"} = 1;
                    }
                }
                # analyzing CodeGear argument
                #      these arguments are extract from current context's arugment DataGear Interface
                #      and passed to the CodeGear
                #      struct Implementaion needs special handling
                #      __code next(...)   --->   enum Code next
                $prevCodeGearName = $codeGearName;
                $dataGearVar{$codeGearName} = [];
                $outputVar{$codeGearName} = "";
                $outputArgs{$codeGearName} = {};
                my $newArgs = "struct Context *context,";
                if ($args=~/^struct Context\s*\*\s*context/) {
                    $newArgs = "";
                }
                while($args) {
                    if ($args =~ s/(^\s*,\s*)//) {
                        $newArgs .= $1;
                    }
                    # continuation case
                    if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) {
                        my $next = $2;
                        my @args = split(/,/,$3);
                        if ( &generateStubArgs($codeGearName, $next, "Code", $next, $interface,0) ) {
                            $newArgs .= "enum Code $next";
                        }
                        # analyze continuation arguments
                        #    output arguments are defined in the Interface take the pointer of these
                        #    output arguments are put into the Interface DataGear just before the goto
                        for my $arg (@args) {
                            $arg =~ s/^\s*//;
                            last if ($arg =~ /\.\.\./);
                            $arg =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//;
                            my $structType = $1;
                            my $typeName = $2;
                            my $varName = $4;
                            my $typeField = lcfirst($typeName);
                            push(@{$outputArgs{$codeGearName}->{$next}}, $varName);
                            if (&generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface,1)) {
                                $newArgs .= ",$structType $typeName **O_$varName";
                            }
                        }
                    } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) {
                        my $structType = $1;
                        my $typeName = $2;
                        my $varName = $4;
                        my $typeField = lcfirst($typeName);
                        $newArgs .= $&;    # assuming no duplicate
                        &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface,0);
                    } elsif ($args =~ s/(.*,)//) {
                        $newArgs .= $1; 
                    } else {
                        $newArgs .= $args;
                        last;
                    }
                }
                # generate goto statement from stub to the CodeGear in the buffer
                $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context";
                for my $arg ( @{$dataGearVar{$codeGearName}}) {
                    $dataGearName{$codeGearName} .= ", $arg";
                }
                $dataGearName{$codeGearName} .= ");";
                # generate CodeGear header with new arguments
                print $fd "__code $codeGearName($newArgs)$tail\n";
                if ($outputVar{$codeGearName} ne "") {
                    # output data var can be use before write
                    # it should be initialze by gearef
                    print $fd $outputVar{$codeGearName};
                }
                next;
            } elsif (/^(.*)goto (\w+)\-\>(\w+)\((.*)\);/) {
                # handling goto statement  
                # convert it to the meta call form with two arugments, that is context and enum Code
                my $prev = $1;
                my $next = $2;
                my $method = $3;
                my @args = split(/,/,$4);
                my @types = @{$dataGearVarType{$codeGearName}};
                my $ntype;
                for my $v (@{$dataGearVar{$codeGearName}}) {
                    my $t = shift @types;
                    if ($v eq $next) {
                        $ntype = $t;
                    }
                }
                print $fd "\tGearef(context, $ntype)->$next = $next->$next;\n";
                # Put interface argument 
                my $prot = $code{$ntype}->{$method};
                my $i = 1;
                for my $arg (@args) {
                    my $p = @$prot[$i];
                    next if ( $p eq $arg);
                    $p =~ s/^(.*)\s(\w+)//;
                    my $pType = $1;
                    my $pName = $2;
                    $arg =~ s/^(\s)*(\w+)/$2/;
                    if ($pType =~ s/\_\_code$//) {
                        print $fd "\tGearef(context, $ntype)->$pName = C_$arg;\n";
                    } else {
                        print $fd "\tGearef(context, $ntype)->$pName = $arg;\n";
                    }
                    $i++;
                }
                print $fd "${prev}goto meta(context, $next->$next->$ntype.$method);\n";
                next;
            } elsif (/^(.*)goto (\w+)\((.*)\);/) {
                # handling goto statement  
                # convert it to the meta call form with two arugments, that is context and enum Code
                my $prev = $1;
                my $next = $2;
                my @args = split(/,/,$3);
                my $v = 0;
                for my $n ( @{$dataGearVar{$codeGearName}} ) {
                     # continuation arguments 
                    $v = 1  if ( $n eq $next);
                }
                if ($v || defined $code{$interface}->{$next}) { 
                    # write continuation's arguments into the interface arguments
                    # we may need a commit for a shared DataGear
                    for my $arg ( @{$outputArgs{$codeGearName}->{$next}} ) {
                        my $v = shift(@args);
                        print $fd "\t*O_$arg = $v;\n";
                    }
                    print $fd "${prev}goto meta(context, $next);\n";
                    next;
                }
            } else {
                s/new\s+(\w+)\(\)/\&ALLOCATE(context, \1)->\1/g;   # replacing new
            }
        # gather type name and type
        } elsif (/^}/) {
            $inStub = 0;
            $inTypedef = 0;
        }
        print $fd $_;
    }
    if (defined $prevCodeGearName) {
        if (!defined $stub{$prevCodeGearName."_stub"}) {
            $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName});
        }
    }
}

# end