# HG changeset patch
# User anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
# Date 1574659954 -32400
# Node ID 7d66643d837d62cf353e89a3b7156ef77c5d5366
# Parent  5f4b7ff18a34a41a65417cffa1d1a6d7e9fa8c2f
impl auto_gen_context toolset

diff -r 5f4b7ff18a34 -r 7d66643d837d src/parallel_execution/auto_generate_context.pl
--- a/src/parallel_execution/auto_generate_context.pl	Sun Nov 24 23:50:28 2019 +0900
+++ b/src/parallel_execution/auto_generate_context.pl	Mon Nov 25 14:32:34 2019 +0900
@@ -2,17 +2,21 @@
 use strict;
 use warnings;
 use Gears::Context;
-use DDP {deparse => 1};
+use FindBin;
+#use DDP {deparse => 1};
 
 my @cbc_files = <DATA>;
 chomp @cbc_files;
-my $gears = Gears::Context->new(compile_sources => \@cbc_files);
-$gears->extraction_dg_compile_sources();
-#p $gears;
-$gears->search_data_gears();
-#p $gears;
+
+my $gears = Gears::Context->new(compile_sources => \@cbc_files, find_root => $FindBin::Bin);
+my $data_gears = $gears->extraction_dg_compile_sources();
+my $g = $gears->set_data_gear_header_path();
 
+my $dg2path = $gears->update_dg_each_header_path($data_gears,$g);
 
+$gears->tans2create_context_h($dg2path);
+
+#
 __DATA__
 /Users/anatofuz/src/firefly/hg/Gears/src/parallel_execution/examples/calc/calc.cbc
 /Users/anatofuz/src/firefly/hg/Gears/src/parallel_execution/examples/calc/add.cbc
diff -r 5f4b7ff18a34 -r 7d66643d837d src/parallel_execution/lib/Gears/Context.pm
--- a/src/parallel_execution/lib/Gears/Context.pm	Sun Nov 24 23:50:28 2019 +0900
+++ b/src/parallel_execution/lib/Gears/Context.pm	Mon Nov 25 14:32:34 2019 +0900
@@ -4,15 +4,15 @@
 use warnings;
 
 use Gears::Util;
-use DDP {deparse => 1};
+use Gears::Context::Template;
+use Carp qw/croak/;
 
 sub new {
   my ($class, %args) = @_;
-  p %args;
-
   my $self = {
-    interfaces => [],
     data_gears_with_count => {},
+    find_root => $args{find_root} // ".",
+    output => $args{output} // *STDOUT,
   };
 
   if ($args{compile_sources}) {
@@ -22,31 +22,34 @@
   return bless $self, $class;
 }
 
+
 sub extraction_dg_compile_sources {
   my $self = shift;
-  map { $self->extraction_data_gears($_) } @{$self->{compile_sources}};
+  my %counter;
+  for my $cbc_file (@{$self->{compile_sources}}) {
+    open my $fh , '<', $cbc_file;
+    while (my $line = <$fh>) {
+       if ($line =~ /#interface\s*"(.*)\.h"/) {
+          $self->{data_gears_with_count}->{$1}->{caller}->{$cbc_file}++;
+          $counter{interfaces}->{$1}++;
+          next;
+       }
+
+       if ($line =~ /__code/) {
+         while ($line =~ /struct (\w+)*/g) {
+           next if $1 eq "Context";
+           $self->{data_gears_with_count}->{$1}->{caller}->{$cbc_file}++;
+           next if (exists $counter{interfaces}->{$1});
+           $counter{impl}->{$1}++;
+         }
+       }
+    }
+    close $fh;
+  }
+  return \%counter;
 }
 
-sub extraction_data_gears {
-  my ($self, $cbc_file)  = @_;
-  open my $fh , '<', $cbc_file;
-  while (my $line = <$fh>) {
-     if ($line =~ /#interface\s*"(.*)\.h"/) {
-        $self->{data_gears_with_count}->{$1}->{caller}->{$cbc_file}++;
-        push(@{$self->{interfaces}}, "$1.h");
-        next;
-     }
-
-     if ($line =~ /__code/) {
-       while ($line =~ /struct (\w+)*/g) {
-         $self->{data_gears_with_count}->{$1}->{caller}->{$cbc_file}++;
-       }
-     }
-  }
-  close $fh;
-}
-
-sub search_data_gears {
+sub set_data_gear_header_path {
   my $self = shift;
   my @data_gears_name;
   if (@_) {
@@ -54,11 +57,67 @@
   } else {
     map { push (@data_gears_name,$_) if $_ ne "Context" } keys %{$self->{data_gears_with_count}};
   }
-  $self->find_headers(".",\@data_gears_name);
+  return _find_headers($self->{find_root},\@data_gears_name);
+}
+
+sub update_dg_each_header_path {
+  my ($self, $dgs, $dg2path) = @_;
+  my $new_dgs;
+  for my $kind (keys %$dgs) {
+    for my $dg_name (keys %{$dgs->{$kind}}) {
+      if ($dg2path->{$dg_name}) {
+        $new_dgs->{$kind}->{$dg_name} = $dg2path->{$dg_name};
+      } else {
+        croak "failed trans header $dg_name\n";
+      }
+    }
+  }
+  return $new_dgs;
+}
+
+sub tans2create_context_h {
+  my ($self, $dg2path) = @_;
+  my $data_struct_str = $self->trans2data_struct_str($dg2path);
+  Gears::Context::Template->emit_top_header($self->{output});
+  Gears::Context::Template->emit_data_gears($self->{output},$data_struct_str);
+  Gears::Context::Template->emit_last_header($self->{output});
 }
 
-sub find_headers {
-  my ($self, $search_bash_path, $targets) = @_;
+sub trans2data_struct_str {
+  my ($self, $dg2path) = @_;
+  my $dg_str = $self->_createImplTree_from_header($dg2path);
+  my $data_struct_str  = "";
+  for my $interface (sort keys %$dg_str) {
+    $data_struct_str .= Gears::Util->h2context_str($dg_str->{$interface}->{elem});
+    next unless ($dg_str->{$interface}->{impl});
+    for my $impl (sort keys %{$dg_str->{$interface}->{impl}}) {
+       $data_struct_str .= Gears::Util->h2context_str($dg_str->{$interface}->{impl}->{$impl});
+    }
+  }
+  return $data_struct_str;
+}
+
+sub _createImplTree_from_header {
+  my ($self, $dg2path) = @_;
+  my %dg_str = ();
+
+  my $inters = $dg2path->{interfaces};
+  my $impls = $dg2path->{impl};
+  map { $dg_str{$_}->{elem} = Gears::Util->parse_interface($inters->{$_}) } keys %$inters;
+
+  map {
+    my $res = Gears::Util->parse($impls->{$_});
+    if ($res->{isa}) {
+        $dg_str{$res->{isa}}->{impl}->{$_} = $res;
+    } else {
+        $dg_str{$_}->{elem} = $res;
+    }
+  } keys %$impls;
+  return \%dg_str;
+}
+
+sub _find_headers {
+  my ($search_bash_path, $targets) = @_;
   my %res;
   map { $res{$_}++ } @$targets;
 
@@ -70,7 +129,7 @@
       $res{$header_tile} = $_;
     }
   } @$header_paths;
-  p %res;
+  return \%res;
 }
 
 1;
diff -r 5f4b7ff18a34 -r 7d66643d837d src/parallel_execution/lib/Gears/Util.pm
--- a/src/parallel_execution/lib/Gears/Util.pm	Sun Nov 24 23:50:28 2019 +0900
+++ b/src/parallel_execution/lib/Gears/Util.pm	Mon Nov 25 14:32:34 2019 +0900
@@ -126,4 +126,24 @@
   return \@files;
 }
 
+sub h2context_str {
+  my ($class, $h2context) = @_;
+  my $context = '';
+  my $space = '    ';
+
+  $context =  "${space}struct $h2context->{name} {\n";
+  if (exists $h2context->{data}) {
+    for my $datum (@{$h2context->{data}}) {
+      $context .= "${space}${space}$datum;\n";
+    }
+  }
+  if (exists $h2context->{codes}) {
+    for my $code (@{$h2context->{codes}}) {
+      $context .= "${space}${space}enum Code $code;\n";
+    }
+  }
+  $context .= "${space}} $h2context->{name};\n";
+  return $context;
+}
+
 1;
diff -r 5f4b7ff18a34 -r 7d66643d837d src/parallel_execution/plautogen/impl/AtomicReference.h
--- a/src/parallel_execution/plautogen/impl/AtomicReference.h	Sun Nov 24 23:50:28 2019 +0900
+++ b/src/parallel_execution/plautogen/impl/AtomicReference.h	Mon Nov 25 14:32:34 2019 +0900
@@ -1,3 +1,2 @@
 typedef struct AtomicReference <Type, Isa> impl Atomic {
-  ;
 } AtomicReference;
diff -r 5f4b7ff18a34 -r 7d66643d837d src/parallel_execution/update_context.pl
--- a/src/parallel_execution/update_context.pl	Sun Nov 24 23:50:28 2019 +0900
+++ b/src/parallel_execution/update_context.pl	Mon Nov 25 14:32:34 2019 +0900
@@ -12,7 +12,7 @@
 
 my $interface_file = shift or die "require itnerface file";
 my $h2context = Gears::Util->parse_interface($interface_file);
-my $context = dump_h2context($h2context);
+my $context = Gears::Util->h2context_str($h2context);
 
 if ($opt{c}) {
   print "$context";
@@ -56,25 +56,6 @@
   return (\@first_context_headers,\@last_context_headers);
 }
 
-sub dump_h2context {
-  my $h2context = shift;
-  my $context = '';
-  my $space = '    ';
-  #print "${space}struct $h2context->{name} {\n";
-  $context =  "${space}struct $h2context->{name} {\n";
-  for my $datum (@{$h2context->{data}}) {
-    #print "${space}${space}$datum; \n";
-    $context .= "${space}${space}$datum;\n";
-  }
-  for my $code (@{$h2context->{codes}}) {
-    #print "${space}${space}enum Code $code;\n";
-    $context .= "${space}${space}enum Code $code;\n";
-  }
-  #print "${space}} $h2context->{name};\n";
-  $context .= "${space}} $h2context->{name};\n";
-  return $context;
-}
-
 sub context_dump {
   for my $line (@_) {
     print "$line";