# HG changeset patch
# User anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
# Date 1574927884 -32400
# Node ID b9df8ea87b427d92e2188630c71486762b6bbb11
# Parent  239bd73abac64ef44e2fa956e8b30f674391edb9
fix trans_impl.pl

diff -r 239bd73abac6 -r b9df8ea87b42 src/gearsTools/lib/Gears/Context.pm
--- a/src/gearsTools/lib/Gears/Context.pm	Thu Nov 28 12:17:05 2019 +0900
+++ b/src/gearsTools/lib/Gears/Context.pm	Thu Nov 28 16:58:04 2019 +0900
@@ -197,7 +197,7 @@
     if (exists $res{$header_tile}){
       $res{$header_tile} = $_;
     }
-  } @$header_paths;
+  } sort @$header_paths;
   return \%res;
 }
 
diff -r 239bd73abac6 -r b9df8ea87b42 src/gearsTools/lib/Gears/Util.pm
--- a/src/gearsTools/lib/Gears/Util.pm	Thu Nov 28 12:17:05 2019 +0900
+++ b/src/gearsTools/lib/Gears/Util.pm	Thu Nov 28 16:58:04 2019 +0900
@@ -63,7 +63,7 @@
       next;
     }
     next if ($line =~ /^\s+$/);
-    next if ($line =~ m[^//]);
+    next if ($line =~ m[^\s*//]);
     next if ($line =~ m[^\}\s*$ir->{name};]);
 
     if ($line =~ m|__code (\w+)\(([()\.\*\s\w,_]+)\)|) {
@@ -76,6 +76,32 @@
   return $ir;
 }
 
+sub parse_with_rewrite {
+  my ($class, $file)  = @_;
+  my $ir = _parse_base($file);
+
+  my @data_gears;
+  my @code_gears;
+  map { push (@data_gears, $_) unless ($_ =~ /enum Code/);} @{$ir->{content}};
+  map { push (@code_gears, $1) if ($_ =~ /enum Code (\w+);/);} @{$ir->{content}};
+
+  open my $fh , '<', $file;
+  my $i = 0;
+  while (($i < scalar @code_gears) && (my $line = <$fh>)) {
+      my $cg = $code_gears[$i];
+      if ($line =~ m|__code $cg\(([()\.\*\s\w,_]+)\)|) {
+        $code_gears[$i] = {
+          name => $cg,
+          args => $1,
+        };
+        $i++;
+      }
+  }
+  $ir->{codes} = \@code_gears;
+  $ir->{data}  = \@data_gears;
+  return $ir;
+}
+
 sub file_checking {
   my ($class, $file_name) = @_;
   unless (-f $file_name) {
@@ -116,7 +142,7 @@
   my $find_path = shift // ".";
 
   my @files;
-  find( { wanted => sub { push @files, $_ if /\.h/ }, no_chdir => 1 }, $find_path);
+  find( { wanted => sub { push @files, $_ if /\.(?:h|dg)/ }, no_chdir => 1 }, $find_path);
 
   return \@files;
 }
@@ -148,4 +174,5 @@
   return $context;
 }
 
+
 1;
diff -r 239bd73abac6 -r b9df8ea87b42 src/gearsTools/trans_impl.pl
--- a/src/gearsTools/trans_impl.pl	Thu Nov 28 12:17:05 2019 +0900
+++ b/src/gearsTools/trans_impl.pl	Thu Nov 28 16:58:04 2019 +0900
@@ -12,10 +12,10 @@
 getopts("w" => \%opt);
 
 my $impl_file = shift or die 'require impl file';
-my $impl_ir         = Gears::Util->parse_code_verbose($impl_file);
-my $interface_file  = Gears::Util->find_header($impl_ir->{isa},"$FindBin::Bin/../");
+my $impl_ir         = Gears::Util->parse_with_rewrite($impl_file);
+my $interface_file  = Gears::Util->find_header($impl_ir->{isa},"$FindBin::Bin/..");
 
-my $inter_ir        = Gears::Util->parse_code_verbose($interface_file);
+my $inter_ir        = Gears::Util->parse_with_rewrite($interface_file);
 
 
 my $output_file = $impl_file;
@@ -53,14 +53,16 @@
 sub emit_constracutor {
   my ($out, $impl_ir, $inter_ir) = @_;
 
-  my @inter_data = @{$inter_ir->{data}};
-  my @impl_data = @{$impl_ir->{data}};
+  my @inter_data     = @{$inter_ir->{data}};
+  my @impl_data      = @{$impl_ir->{data}};
   my $instance_inter = shift @inter_data;
+
   if ($instance_inter =~ /union\s*Data\*\s*(\w+)/) {
     $instance_inter = $1;
   }
-  my $instance_impl = lcfirst $impl_ir->{name};
-  $instance_impl =~ s/([A-Z])/_\l$1/g;
+
+  my $instance_impl  = lcfirst $impl_ir->{name};
+  $instance_impl     =~ s/([A-Z])/_\l$1/g;
 
   print $out <<"EOF";
 $impl_ir->{isa}* create$impl_ir->{name}(struct Context* cbc_context) {
@@ -90,7 +92,7 @@
   }
 
   for my $code (@{$inter_ir->{codes}}) {
-      my $code_gear = $code->[0];
+      my $code_gear = $code->{name};
       print $out "    ${instance_inter}->$code_gear = C_$code_gear$impl_ir->{name};\n"
   }
 
@@ -113,8 +115,8 @@
   my $data_gear_types = {};
 
   for my $code_ir (@{$inter_ir->{codes}}) {
-    my $data_gears = $code_ir->[1];
-    $data_gears =~ s/Impl/$impl/g;
+    my $data_gears = $code_ir->{args};
+    $data_gears =~ s/Impl/struct $impl/g;
     while ($data_gears =~ /Type\*\s*(\w+),/g) {
       my $target = $1;
       if (exists $data_gear_types->{$target}){
@@ -130,7 +132,7 @@
       }
     }
 
-    print $out "__code $code_ir->[0]$impl(";
+    print $out "__code $code_ir->{name}$impl(";
     print $out "$data_gears) {\n\n";
 
     #__code next(...), __code whenEmpty(...)