#!/usr/bin/env perl
use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin/lib";
use Gears::Util;

use Getopt::Std;
use File::Spec;

my %opt;
getopts("wo:" => \%opt);

my $impl_file = shift or die 'require impl file';
my $impl_ir         = Gears::Util->parse_with_separate_code_data_gears(File::Spec->rel2abs($impl_file));
my $interface_file  = Gears::Util->find_using_interface_header($impl_ir->{isa},"$FindBin::Bin/..");

my $inter_ir        = Gears::Util->parse_with_separate_code_data_gears($interface_file);

my $interface_var_name = shift @{$inter_ir->{data}};

if ($interface_var_name =~ /union\s*Data\*\s*(\w+)/) {
  $interface_var_name = $1;
}

my $impl_var_name  = lcfirst $impl_ir->{name};
$impl_var_name     =~ s/([A-Z])/_\l$1/g;

my $interface = {ir => $inter_ir, var_name => $interface_var_name};
my $impl = {ir => $impl_ir, var_name => $impl_var_name};

my $output_file = $impl_file;
$output_file =~ s/\.h/.cbc/;
my $stdout    = *STDOUT;

if ($opt{w}) {
    if(-f $output_file) {
      update_file($output_file, $interface, $impl, $impl_file);
      exit 0;
    }
    open $stdout, '>', $output_file;
} elsif ($opt{o}) {
    if(-f $opt{o}) {
      update_file($opt{o}, $interface, $impl, $impl_file);
      exit 0;
    }
    open $stdout, '>', $opt{o};
}

emit_include_part($stdout, $inter_ir->{name});
emit_impl_header_in_comment($stdout, $impl_file);
emit_constracutor($stdout,$impl,$interface);
emit_code_gears($stdout,$impl_ir,$inter_ir);
close $stdout;

sub emit_include_part {
  my ($out, $interface) = @_;
  print $out <<"EOF"
#include "../context.h"
#interface "$interface.h"

EOF
}

sub emit_impl_header_in_comment {
  my ($out, $impl_file) = @_;
  my $line =  Gears::Util->slup($impl_file);
  print $out "// ----\n";
  map { print $out "// $_\n" } split /\n/, $line;
  print $out "// ----\n\n";
}


sub emit_constracutor {
  my ($out, $impl, $interface) = @_;

  my $impl_ir = $impl->{ir};
  my $inter_ir = $interface->{ir};
  my $impl_var_name = $impl->{var_name};
  my $interface_var_name = $interface->{var_name};

  my @inter_data     = @{$inter_ir->{data}};
  my @impl_data      = @{$impl_ir->{data}};

  print $out <<"EOF";
$impl_ir->{isa}* create$impl_ir->{name}(struct Context* cbc_context) {
    struct $impl_ir->{isa}* $interface_var_name  = new $impl_ir->{isa}();
    struct $impl_ir->{name}* $impl_var_name = new $impl_ir->{name}();
    $interface_var_name->$interface_var_name = (union Data*)$impl_var_name;
EOF

  for my $datum (@impl_data) {
        $datum =~ s|//[\s\w]+||;
        if ($datum =~ /^\s+#/) {
          next;
        }

        if ($datum =~ /\w+\s\w+\*\s(\w+)/) {
            print $out "    ${impl_var_name}->$1 = NULL;\n";
            next;
        }
        if ($datum =~ /\w+\s\w+\s(\w+)/) {
            print $out "    ${impl_var_name}->$1 = 0;\n";
        }

        if ($datum =~ /\w+(\*)?\s(\w+)/) {
            my $is_pointer = $1;
            my $var_name = $2;
            if ($1) {
                print $out "    ${impl_var_name}->$var_name = NULL;\n";
            } else {
                print $out "    ${impl_var_name}->$var_name  = 0;\n";
            }
        }
  }


  for my $code (@{$impl_ir->{codes}}) {
      my $code_gear = $code->{name};
      next if $code_gear eq 'next';
      print $out "    ${impl_var_name}->$code_gear = C_$code_gear;\n"
  }

  for my $code (@{$inter_ir->{codes}}) {
      my $code_gear = $code->{name};
      next if $code_gear eq 'next';
      print $out "    ${interface_var_name}->$code_gear = C_$code_gear$impl_ir->{name};\n"
  }

print $out "    return $interface_var_name;\n";
print $out "}\n";
}


sub emit_code_gears {
  my ($out, $impl_ir, $inter_ir) = @_;
  my $impl = $impl_ir->{name};
  my $interface_name = $inter_ir->{name};

  my @inter_data = @{$inter_ir->{data}};
  my $interface_var_name = shift @inter_data;
  if ($interface_var_name =~ /union\s*Data\*\s*(\w+)/) {
    $interface_var_name = $1;
  }
  my $impl_var_name = lcfirst $impl_ir->{name};
  $impl_var_name =~ s/([A-Z])/_\l$1/g;
  my $data_gear_types = {};

  if (defined $impl_ir->{codes}) {
    replace_code_gears($impl_ir,$impl,$interface_name,1,$out);
  }
  replace_code_gears($inter_ir,$impl,$interface_name,0,$out);
}

sub replace_code_gears {
  my ($ir, $impl, $interface_name, $is_impl, $out) = @_;

  my $replace_impl = $is_impl ? $impl : $interface_name;

  for my $cg (@{$ir->{codes}}) {
    next if ($cg->{name} eq 'next');
    my $data_gears = $cg->{args};
    while ($data_gears =~ /Type\*\s*(\w+),/g) {
        $data_gears =~ s/Type\*/struct $replace_impl*/;
    }

    if ($is_impl) {
      while ($data_gears =~ /Isa\*\s*(\w+),/g) {
          $data_gears =~ s/Isa\*/struct $interface_name*/;
      }
    } else {
      $data_gears =~ s/Impl/struct $impl/g;
    }
    print $out "__code $cg->{name}";
    unless ($is_impl) {
        print $out $impl;
    }
    print $out "(";
    print $out "$data_gears) {\n\n";
    _emit_cg($out,$data_gears);
  }
}


sub _emit_cg {
  my ($out, $data_gears) = @_;
  my @cg = ();
  while ($data_gears =~ /__code ([\w(\.)\*\s,]+?\)),?/g) {
    push(@cg, $1);
  }
  if (@cg) {
    if (@cg == 2) {
      print $out "    if (:TODO:) {\n";
      print $out "         goto ",shift(@cg),";\n";
      print $out "    }\n";
      print $out "    goto ",shift(@cg),";\n";
    } else {
      print $out "    goto ",shift(@cg),";\n";
    }
  }
  print $out "}\n\n";
}

sub update_file {
    my ($output_file, $interface, $impl, $impl_file) = @_;
    my $under_code = collection_save_code_gears($output_file,$interface->{var_name});
    open my $fh, '>', $output_file;
    emit_include_part($fh, $interface->{var_name});
    emit_impl_header_in_comment($fh, $impl_file);
    emit_constracutor($fh,$impl,$interface);
    map { print $fh $_ } @{$under_code};
    close $fh;
}

sub collection_save_code_gears {
  my ($output_file,$interface_name) = @_;
  open my $fh, '<', $output_file;
  while (my $line = <$fh>) {
    if ($line =~ /\s*return $interface_name;\s*/) {
      $line = <$fh>; # } skip...
      last;
    }
  }

  my @res;
  push(@res, <$fh>);
  return \@res;
}