#!/usr/bin/perl

use Getopt::Long;
use strict;
use warnings;
use FindBin;
use File::Spec;
use Storable qw/dclone/;
use lib "$FindBin::Bin/lib";

use Gears::Context;
#use DDP {deparse => 1};
#
#
# generrate Gears OS context heaader and initializer from CbC sources
#
# CodeGear
#
# get stub information from # *.c
#     __code taskManager_stub(struct Context* context) {
#
# generate CodeGear indexn in context.h
#     C_taskManager,
#
# generate CodeGear stub reference in context.h
#     extern __code taskManager_stub(struct Context*);
#
# generate CodeGear stub reference in $name-context.h for each module
#     context->code[C_taskManager]   = taskManager_stub;
#
# DataGear
#
# get DataGear information from context.h
#     struct Worker {
#         int id;
#         struct Context* contexts;
#         enum Code execute;
#         enum Code taskSend;
#         enum Code taskRecive;
#         enum Code shutdown;
#         struct Queue* tasks;
#     } Worker;
#
# generate typedefs and DataGear index in context.h
#     typedef struct Worker Worker;
#     D_Worker,
#
# generate DataGear allocator in context.h
#      ALLOC_DATA(context, Worker);
#

my $ddir = "c";

our($opt_o,$opt_d,$opt_h,$opt_w, $opt_project,$opt_D);
GetOptions(
    "o=s"       => \$opt_o,
    "d=s"       => \$opt_d,
    "h"         => \$opt_h,
    "w"         => \$opt_w,
    "D"         => \$opt_D,
    "project=s" => \$opt_project,
);


my $name = $opt_o?$opt_o:"gears";

if ($opt_d) {
    $ddir = $opt_d;
}

if ( ! -d $ddir) {
    mkdir $ddir;
}

if ($opt_h) {
    print "$0  [-d distdir] [-h]\n";
    exit;
}

my %projects = (
    gears => { name => "gears", cotnext => "context" ,     template => "Gears::Template::Context"},
    xv6   => { name => "xv6"  , context => "cbc_context" , template => "Gears::Template::Context::XV6"},
);


my $context_name = "context";

my $project = $projects{gears};

if ($opt_project && exists $projects{$opt_project}) {
  $context_name = $projects{$opt_project}->{context};
  $project  = $projects{$opt_project};
}

if ($opt_D || ! -f "context.h") {
  generateContextHeader($opt_w, $opt_o, $project, @ARGV);
}


my %codeGear;
my %dataGear;
my %constructor;



# gather module Information for code table initialization
for (@ARGV) {
    next if (/context.c/);
    &getStubInfo($_);
}

my (%mCodeGear) = (%codeGear);

# anyway we gather all Gears Information
while (<*.c test/*.c>) {
    next if (/context.c/);
    &getStubInfo($_);
}

&generateContext();

sub getStubInfo {
    my ($filename) = @_;
    open my $fd,"<",$filename or die("can't open $filename $!");
    while (<$fd>) {
      #TODO: check generics type
        if (/^__code (\w+)_stub\(/) {
            $codeGear{$1} = $filename;
        } elsif (/^(\w+)(\*)+  *create(\w+)\(([^]]*)\)/) {
            my $interface = $1;
            my $implementation = $3;
            my $constructorArgs = $4;
            $constructor{$implementation} = [$interface, $constructorArgs];
        }
    }
    close $fd;

    open my $cx,"<","context.h" or die("can't open context.h $!");
    my $inUnionData = 0;
    while (<$cx>) {
        if (! $inUnionData) {
            if ( /^union Data/) {
                $inUnionData = 1;
            }
            next;
        }
        last if (/union Data end/);
        if (/struct (\w+) \{/) {
            $dataGear{$1} = 'struct';
        } elsif (/^\s{4}(\w+) (\w+);/) { # primitive type
            my $vtype = $1;
            my $vname = $2;
            if (exists $dataGear{$vname}) {
              next;
            }
            $dataGear{$vtype} = 'primitive';
        }
        $dataGear{"Context"} = "struct";
    }
}

sub generateContext {
    $codeGear{"start_code"} = "$ddir/$name-context.c";
    $codeGear{"exit_code"} = "$ddir/$name-context.c";
    $mCodeGear{"start_code"} = "$ddir/$name-context.c";
    $mCodeGear{"exit_code"} = "$ddir/$name-context.c";

    generateExtern();
    generateEnumCode();
    generateContextCsource();
    generateEnumData();
    generateTypedefData();
    generateDataGearInit();
}

sub generateExtern {
    open my $fd,">","$ddir/extern.h" or die("can't open $ddir/extern.h $!");
    for my $code ( sort keys %codeGear ) {
        print $fd "extern __code ${code}_stub(struct Context*);\n";
    }
    for my $impl ( sort keys %constructor ) {
        my ($interface, $constructorArgs) = @{$constructor{$impl}};
        print $fd "extern ${interface}* create${impl}($constructorArgs);\n";
    }
    print $fd "\n";
    close $fd;
}

sub generateEnumCode {
    open my $fd,">","$ddir/enumCode.h" or die("can't open $ddir/enumCode.h $!");
    print $fd "enum Code {\n";
    for my $code ( sort keys %codeGear ) {
        print $fd "    C_${code},\n";
    }
    print $fd "};\n";

    close $fd;
}


sub generateContextCsource {
    open my $fd,">","$ddir/$name-context.c" or die("can't open $ddir/$name-context.c $!");
    my $code_init = '';
    for my $code ( sort keys %mCodeGear ) {
        $code_init .=  "    ${context_name}->code[C_${code}]    = ${code}_stub;\n";
    }

    my $data_num = keys(%dataGear);
    $data_num++;
    my $context_c;
    if ($project->{name} eq "xv6") {
      $context_c .= << "EOFEOF";
#ifndef CBCXV6
#include <stdlib.h>
#endif
EOFEOF
    } else {
      $context_c .= << "EOFEOF";
#include <stdlib.h>
EOFEOF
    }

$context_c .= << "EOFEOF";

#include "../context.h"

void initContext(struct Context* $context_name) {
    ${context_name}\->heapLimit = sizeof(union Data)*ALLOCATE_SIZE;
    ${context_name}\->code = (__code(**) (struct Context*)) NEWN(ALLOCATE_SIZE, void*);
    ${context_name}\->data = NEWN(ALLOCATE_SIZE, union Data*);
    ${context_name}\->heapStart = NEWN(${context_name}\->heapLimit, char);
    ${context_name}\->heap = ${context_name}\->heapStart;
    ${context_name}\->metaDataStart = NEWN(ALLOCATE_SIZE, struct Meta*);
    ${context_name}\->metaData = ${context_name}\->metaDataStart;
    // ${context_name}\->codeNum = Exit;

$code_init

#include "dataGearInit.c"
    ${context_name}\->dataNum = $data_num;
}
EOFEOF
    print $fd $context_c;

    my $meta_call = <<"EOFEOF";
__code meta(struct Context* ${context_name}, enum Code next) {
    // printf("meta %d\\n",next);
    goto (${context_name}\->code[next])(${context_name});
}

__code parGotoMeta(struct Context* ${context_name}, enum Code next) {
    ${context_name}->task     = NULL;
    ${context_name}->taskList = NULL;
    goto (${context_name}\->code[Gearef(${context_name}, TaskManager)->taskManager->TaskManager.spawnTasks])(${context_name});
}

__code start_code(struct Context* ${context_name}) {
    goto meta(${context_name}, ${context_name}\->next);
}

__code start_code_stub(struct Context* ${context_name}) {
    goto start_code(${context_name});
}
EOFEOF

    #gears or xv6

    if ($project->{name} eq "gears") {

      $meta_call .= <<"EOFEOF";
__code exit_code(struct Context* ${context_name}) {
    free(${context_name}->code);
    free(${context_name}->data);
    free(${context_name}->heapStart);
    goto exit(0);
}
EOFEOF

      #xv6 case
    } else {

$meta_call .= <<"EOFEOF";
__code exit_code(struct Context* ${context_name}) {
    // free(${context_name}->code);
    // free(${context_name}->data);
    // free(${context_name}->heapStart);
    goto exit_code(cbc_context);
}
EOFEOF
    }

$meta_call .= <<"EOFEOF";
__code exit_code_stub(struct Context* ${context_name}) {
    goto exit_code(${context_name});
}

// end context_c
EOFEOF

    print $fd $meta_call;
    close $fd;
}

sub generateEnumData {
    open my $fd,">","$ddir/enumData.h" or die("can't open $ddir/enumData.h $!");
    print $fd "enum DataType {\n";
    print $fd "    D_Code,\n";
    for my $data ( sort keys %dataGear ) {
        print $fd "    D_${data},\n";
    }
    print $fd "};\n\n";
    close $fd;
}

sub generateTypedefData {
    open my $fd,">","$ddir/typedefData.h" or die("can't open $ddir/typedefData.h $!");
    for my $data ( sort keys %dataGear ) {
        if ($dataGear{$data} eq 'struct') {
            print $fd "typedef struct ${data} ${data};\n";
        }
    }
    close $fd;
}

sub generateDataGearInit {
    open my $fd,">","$ddir/dataGearInit.c" or die("can't open $ddir/dataGearInit.c $!");
    for my $data ( sort keys %dataGear ) {
        print $fd "    ALLOC_DATA(${context_name}, ${data});\n";
    }
    close $fd;
}

sub generateContextHeader {
  my ($opt_w, $opt_o, $project, @argv) = @_;

  my $output     = $opt_w ? "context.h" : "stdout";


  my @cbc_files = map { File::Spec->rel2abs($_) }  @argv;
  my $gears      = Gears::Context->new(
                                       compile_sources      => \@cbc_files,
                                       find_root            => "$FindBin::Bin/../",
                                       generate_script_path => $FindBin::Bin,
                                       output               => $output,
                                       project              => $opt_o,
                                       template             => $project->{template});

  my $data_gears               = $gears->extraction_dg_compile_sources($gears->{compile_sources});
  my $data_gear_to_header_path = $gears->set_data_gear_header_path(keys %{$data_gears->{impl}},keys %{$data_gears->{interfaces}});


  my $parsed_dg2path    = $gears->update_dg_each_header_path($data_gears,$data_gear_to_header_path);
  my $tree = $gears->createImplTree_from_header($parsed_dg2path);

  my ($typed_variable, $generics) = parsed_generics_from_tree($tree);
  my ($type_var, $type_ins) = check_use_generics($typed_variable, $generics, $gears->{generics_list});

  my $modify_list = convertGenerics($type_var, $type_ins);

  my %tmp = map {
    my %tmp;
    my $interface = $tree->{$_};
    if ($interface->{elem}) {
      my $elem = $interface->{elem};
      if ($elem->{typed_variable}) {
        push(@{$tmp{$_}->{var}}, $elem->{typed_variable});
      }
    }

    if ($interface->{impl}) {
      for my $implName (keys %{$interface->{impl}}) {
        my $elem = $interface->{impl}->{$implName};
        if ($elem->{typed_variable}) {
          push(@{$tmp{$implName}->{var}}, $elem->{typed_variable});
        }
      }
    }
    %tmp;
  } keys %$tree;


  if ($modify_list) {
    my @repInterfaces = grep { exists $tree->{$_} } keys %{$modify_list->{replace}};
    replaceFromInterface($tree, $modify_list, @repInterfaces);
    @repInterfaces = grep { exists $tree->{$_} } keys %{$modify_list->{replace}};
    replaceFromInterface($tree, $modify_list, @repInterfaces);
  }

  #p $tree;
  #
  $gears->tree2create_context_h($tree);
}

sub replaceFromInterface {
   my ($tree, $modify_list, @repInterfaces) = @_;
    for my $repInterface (@repInterfaces) {
      my $replaceTree = dclone($tree);
      my $elements = delete $replaceTree->{$repInterface};
      for my  $mpair (@{$modify_list->{replace}->{$repInterface}}) {
        for my $replaceInterfaceName (@{$mpair->{after}}) {
           my $typeV  = $mpair->{typev};
           my $defType = $mpair->{defType};
           for my $elem (@{$elements->{elem}->{content}}) {
             $elem =~ s/$typeV(\*?)/$defType$1/;
           }
           $replaceTree->{$replaceInterfaceName} = $elements;
        }

        delete $modify_list->{replace}->{$repInterface};
      }
      $tree = $replaceTree;
    }
}

sub find_generics_each_item {
    my ($name, $entry, $generics, $typed_variables, $interface_name, $file_path) = @_;
    if (defined $entry->{generics}) { #define type
      my $elem = {
          name         => $name,
          interface    => $interface_name,
          impl         => $name,
          defined_type => $entry->{generics},
          caller       => $entry->{file_name},
        };
      if ($interface_name) {
        $elem->{interface} = $interface_name;
      }
      $generics->{$name} = $elem;
    }
    if (defined $entry->{typed_variable}) {
      for my $item (@{$entry->{typed_variable}}) {
        my $elem = {
            interface            => $interface_name,
            impl                 => $entry->{name},
            vname                => $item->{vname},
            type                 => $entry->{name},
            typed_variable       => $item->{type},
            caller               => $entry->{file_name},
            line_numer           => undef,
         };
        push(@{$typed_variables},  $elem);
      }
    }
}

sub parsed_generics_from_tree {
    my ($tree) = shift;
    my %generics;
    my @typed_variables;

    for my $interface (keys %$tree) {
      my $entry = $tree->{$interface};
      my $interface_entry = $entry->{elem};
      find_generics_each_item($interface, $interface_entry, \%generics, \@typed_variables, undef);

      for my $impl (keys %{$entry->{impl}}) {
        my $impl_entry = $entry->{impl}->{$impl};
        find_generics_each_item($impl, $impl_entry, \%generics, \@typed_variables, $interface);
      }
    }


    return (\@typed_variables, \%generics);
}




sub check_use_generics {
  my ($input_typed_variables, $generics, $cfile_generics_list) = @_;
  my $typed_variables = {};
  my $typed_instances = {};


  #collect from typed_variables
  for my $item (@{$input_typed_variables}) {
    my $type   = $item->{type};
    my $typedv = $item->{typed_variable};
    my $vname  = $item->{vname};
    my $entry  = $typed_variables->{$type}->{$typedv};

    unless ($entry && (grep { $_ eq $vname } $typed_variables->{$type}->{$typedv})) {
      push(@{$typed_variables->{$type}->{$typedv}}, $vname);
    }

    if (defined $item->{interface}) {
      $typed_variables->{$type}->{_interface} = $item->{interface};
    }
    $typed_variables->{$type}->{_caller}->{$item->{caller}} = 1;
  }

  while (my ($type, $elem) = each %$generics) {
    for my $item (@{$elem->{defined_type}}) {
      my $geneType   = $item->{type};
      my $defineType = $item->{generics};
      my $field      = $item->{vname};

      my $insert_item =
        {
          in_type_name => $geneType,
          vname        => $field,
          caller       => $elem->{caller},
          inCbC        => 0,
        };
      if ($elem->{impl} ne $elem->{interface}) {
        $insert_item->{impl}      = $elem->{impl};
        $insert_item->{interface} = $elem->{interface};
      }
      push(@{$typed_instances->{$geneType}->{$defineType}}, $insert_item);
    }
  }

  #from cbc (.c)
  if (defined $cfile_generics_list->{typed_variable}) {
    for my $item (@{$cfile_generics_list->{typed_variable}}) {
        my $type   = $item->{type};
        my $typedv = $item->{typed_variable};
        my $vname  = $item->{vname};
        my $entry  = $typed_variables->{$type}->{$typedv};

        unless ($entry && (grep { $_ eq $vname } $typed_variables->{$type}->{$typedv})) {
          push(@{$typed_variables->{$type}->{$typedv}}, $vname);
        }
        $typed_variables->{$type}->{_caller}->{$item->{caller}} = 1;
    }
  }


  if (defined $cfile_generics_list->{defined_type}) {
    for my $item (@{$cfile_generics_list->{defined_type}}) {
      my $geneType   = $item->{type};
      my $defineType = $item->{defined_type};

      my $insert_item =
        {
          in_type_name => $geneType,
          vname        => $item->{vname},
          caller       => $item->{caller},
          inCbC        => 1,
        };
      if (($item->{impl}) && ($item->{impl} ne $item->{interface})) {
        $insert_item->{impl}      = $item->{impl};
        $insert_item->{interface} = $item->{interface};
      }
      push(@{$typed_instances->{$geneType}->{$defineType}}, $insert_item);
    }
  }


  return ($typed_variables, $typed_instances);
}

sub convertGenerics {
  my ($typed_variables, $typed_instances) = @_;
  my $modifyList = {header => {}, cbc => {}};
  my $file2cont = {};
  for my $type (keys %$typed_instances) {
    for my $defType (keys %{$typed_instances->{$type}}) {
      my $file_each_instances = {};
      for my $item (@{$typed_instances->{$type}->{$defType}}) {
        push(@{$file_each_instances->{$item->{caller}}}, $item);
      }

      for my $file (keys %{$file_each_instances}) {


        my @types = keys %{{ map { $_->{in_type_name} => 1 } @{$file_each_instances->{$file}} }};
        my @impls = keys %{{ map { $_->{impl} => 1 } grep { exists $_->{impl} } @{$file_each_instances->{$file}} }};

        if ( (scalar(@types) != 1) && (scalar(@types) != scalar(@impls))) {
          print STDERR "[INFO] TODO!  this cae not implemention \n";
          exit 0;
        }

        my $type = shift @types;
        my $impl = shift @impls;
        my @rep_types;

        for my $t ($type, $impl) {
          next unless ($t);
          if (exists $typed_variables->{$t}) {
            push(@rep_types, grep { ($_ ne '_caller' ) && ( $_ ne '_interface' )  } keys %{$typed_variables->{$t}});
          }
        }

        my @indiv_rep_type = keys %{{ map { $_ => 1 }  @rep_types }};
        if (scalar(@indiv_rep_type) != 1) {
          print STDERR "[TODO] not implement....\n";
        }

        my $type_v = shift @indiv_rep_type;

        my $replaceType  = $type;
        my $replaceImpls = $impl;
        my $targetImpl   = $impl;

        $replaceType =~ s/$type/${type}_$defType/;
        my $repimpl = 0;
        if ($impl) {
          if (defined $typed_variables->{$impl}) {
            $replaceImpls =~ s/$type/${type}_$defType/;
            $targetImpl   =~ s/$type/${type}_$defType/;
            $replaceImpls =~ s/$/_$defType/;
            $repimpl = 1;
          }
        }

        if ($file =~ /\.h$/) {
          print STDERR "[info] $file is header\n";
          unless (grep { $_ eq $replaceType } map { $_->{before} } @{$modifyList->{header}->{$file}}) {
            push(@{$modifyList->{header}->{$file}}, { before => [$type], after => [$replaceType], typev => $type_v, defType => $defType});
            my $implName = $file_each_instances->{$file}->[0]->{impl};
            unless ($implName) {
              print STDERR "[error] not implemented thsi case\n";
            }
            push(@{$modifyList->{replace}->{$type}}, { before => [$type], after => [$replaceType], typev => $type_v, defType => $defType});
          }
          next;
        }

        if ($impl) {
          if ($impl eq $replaceImpls) { #not impl
            push(@{$modifyList->{cbc}->{$file}},{before => [$type], after => [$replaceType], typev => $type_v, defType => $defType});
          } else { #impl
            #push(@{$modifyList->{cbc}->{$file}},{before => [$type, $impl], after => [$replaceType, $replaceImpls]});
            push(@{$modifyList->{cbc}->{$file}},
                  {
                    before      => [$type], after      => [$replaceType],
                    before_impl => [$impl], after_impl => [$replaceImpls]
                  }
                );
            push(@{$modifyList->{replace}->{$type}}, {
                before => [$type], after => [$replaceType],
                typev => $type_v, defType => $defType,
                impl => [{ before => [$impl], after => [$replaceImpls], typev => $type_v, defType => $defType}]
              });
          }
        }

        my @cbc_cont;
        my $instance = lcfirst($type);

        open my $fh, '<', $file;
        while (my $line = <$fh> ){
          $line =~ s/$type(<.*?>)?/$replaceType/g;
          if ($repimpl) {
            $line =~ s/${targetImpl}(<.*?>)?/$replaceImpls/g;
          }
          if ($line =~ /^\s*${type_v}([\s\*])/) {
            $line =~ s/${type_v}([\s\*])/$defType$1/;
          }
          if ($line =~ /$instance/) {
            $line =~ s/$instance/lcfirst($replaceType)/e;
          }
          push(@cbc_cont, $line);
        }
        close $fh;

        push(@{$file2cont->{$file}}, \@cbc_cont);
      }
    }
  }

  for my $type (keys %$typed_variables) {
     my @cfiles = grep { /\.c$/ } keys  %{$typed_variables->{$type}->{_caller}};
     for my $file (@cfiles) {
       push(@{$modifyList->{replaceFiles}->{$file}}, $type);
     }
   }

   #for my $file (keys %$file2cont) {
   #  open my $fh, '>', $file;
   #  for my $cont (@{$file2cont->{$file}}) {
   #     print $fh $_ for @$cont;
   #  }
   #  close $fh;
   #}
  return $modifyList;
}


# end