--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/gearsTools/lib/Gears/Util.pm	Tue Nov 19 15:08:20 2019 +0900
@@ -0,0 +1,119 @@
+package Gears::Util;
+use strict;
+use warnings;
+use Carp qw/croak/;
+use File::Find;
+
+sub parse {
+  my ($class, $file_name) = @_;
+  my $ir = _parse_base($file_name);
+  return $ir;
+}
+
+sub parse_code_verbose {
+  my ($class, $file_name) = @_;
+  my $ir = _parse_base($file_name,1);
+  return $ir;
+}
+
+sub parse_interface {
+  my ($class, $file_name) = @_;
+  my $ir = _parse_base($file_name);
+  
+  unless ($ir->{name}) {
+    croak 'invalid struct name';
+  }
+  return $ir;
+}
+
+
+sub parse_impl {
+  my ($class, $file_name) = @_;
+  my $ir = _parse_base($file_name);
+
+  unless ($ir->{isa} && $ir->{name}) {
+    croak 'invalid struct name';
+  }
+  return $ir;
+}
+
+sub _parse_base {
+  my ($file,$code_verbose) = @_;
+  my $ir  = {};
+
+  _file_checking($file);
+  open my $fh, '<', $file;
+  my $line = <$fh>;
+
+  if ($line =~ /typedef struct (\w+)\s?<.*>([\s\w{]+)/) {
+    die "invalied struct name $1" unless $1;
+    $ir->{name} = $1;
+
+    if ($2 =~ m|\s*impl\s*([\w+]+)\s*{|) {
+      $ir->{isa} = $1;
+    }
+  }
+
+  while ($line = <$fh>) {
+    if ($line =~ m|\s*/\*|) {
+      while ( $line !~ m|\*/|) {
+        $line = <$fh>;
+        next;
+      }
+      next;
+    }
+    next if ($line =~ /^\s+$/);
+    next if ($line =~ m[//|}]);
+
+    if ($line =~ m|__code (\w+)\(([()\.\*\s\w,_]+)\)|) {
+      unless ($code_verbose) {
+        push(@{$ir->{codes}},$1);
+        next;
+      }
+      push(@{$ir->{codes}}, [$1,$2]);
+      next;
+    }
+
+    $line =~ s/\s*([\w\s\*]+);\s*/$1/;
+    push(@{$ir->{data}},$1);
+  }
+
+  return $ir;
+}
+
+sub _file_checking {
+  my $file_name = shift;
+  unless (-f $file_name) {
+    croak "invalid filepath :$file_name\n";
+  }
+}
+
+sub slup {
+  my ($class,$file) = @_;
+  open my $fh, '<', $file;
+  local $/;
+  my $f = <$fh>;
+  return $f;
+}
+
+sub find_header {
+  my $class = shift;
+  my $header_name = shift;
+
+  my $find_path = shift // ".";
+  my $header_file = '';
+
+  find(
+    {
+      wanted => sub {
+        if ($_ =~ /\/$header_name\.h/) {
+          $header_file = $_;
+        }
+      },
+      no_chdir => 1,
+    },
+    $find_path);
+  return $header_file;
+}
+
+1;

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/gearsTools/trans_impl.pl	Tue Nov 19 15:08:20 2019 +0900
@@ -0,0 +1,141 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Gears::Util;
+
+use Getopt::Std;
+
+my %opt;
+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 $inter_ir        = Gears::Util->parse_code_verbose($interface_file);
+
+
+my $output_file = $impl_file;
+$output_file =~ s/\.h/.cbc/;
+open my $fh, '>', $output_file;
+my $stdout    = $fh;
+
+unless ($opt{w}) {
+    $stdout    = *STDOUT;
+}
+
+emit_include_part($stdout, $inter_ir->{name});
+emit_impl_header_in_comment($stdout, $impl_file);
+emit_constracutor($stdout,$impl_ir,$inter_ir);
+emit_code_gears($stdout,$impl_ir,$inter_ir);
+close $fh;
+
+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_ir, $inter_ir) = @_;
+
+  my @inter_data = @{$inter_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};
+
+  print $out <<"EOF";
+$impl_ir->{isa}* create$impl_ir->{name}(struct Context* cbc_context) {
+    struct $impl_ir->{isa}* $instance_inter  = new $impl_ir->{isa}();
+    struct $impl_ir->{name}* $instance_impl = new $impl_ir->{name}();
+    $instance_inter->$instance_inter = (union Data*)$instance_impl;
+EOF
+
+  for my $datum (@inter_data) {
+        if ($datum =~ /\w+ \w+\* (\w+)/) {
+            print $out "    ${instance_impl}->$1 = NULL;\n";
+            next;
+        }
+        if ($datum =~ /\w+ \w+ (\w+)/) {
+            print $out "    ${instance_impl}->$1 = 0;\n";
+        }
+  }
+
+  for my $code (@{$inter_ir->{codes}}) {
+      my $code_gear = $code->[0];
+      print $out "    ${instance_inter}->$code_gear = C_$code_gear$impl_ir->{name};\n"
+  }
+
+print $out "    return $instance_inter;\n";
+print $out "}\n";
+}
+
+
+sub emit_code_gears {
+  my ($out, $impl_ir, $inter_ir) = @_;
+  my $impl = $impl_ir->{name};
+
+  my @inter_data = @{$inter_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};
+  my $data_gear_types = {};
+
+  for my $code_ir (@{$inter_ir->{codes}}) {
+    my $data_gears = $code_ir->[1];
+    $data_gears =~ s/Impl/$impl/g;
+    while ($data_gears =~ /Type\*\s*(\w+),/) {
+      my $target = $1;
+      if (exists $data_gear_types->{$target}){
+        $data_gears =~ s/Type\*/$data_gear_types->{$target}/;
+      } else {
+        my $td = "";
+        map { $td = $_ if ($_ =~ /$target/) } @inter_data;
+        if ($td =~ /(\w+)\s*([\w\*]+)\s*(\w+)/) {
+          my $tmp = "$1 $2";
+          $data_gears =~ s/Type\*/$tmp/;
+          $data_gear_types->{$target} = $tmp;
+        }
+      }
+    }
+
+    print $out "__code $code_ir->[0]$impl(";
+    print $out "$data_gears) {\n\n";
+
+    #__code next(...), __code whenEmpty(...)
+    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";
+  }
+}

--- a/src/gearsTools/update_context.pl	Fri Nov 15 14:12:05 2019 +0900
+++ b/src/gearsTools/update_context.pl	Tue Nov 19 15:08:20 2019 +0900
@@ -3,11 +3,15 @@
 use warnings;
 use Getopt::Std;
 
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Gears::Util;
+
 my %opt;
 getopts("wc" => \%opt);
 
 my $interface_file = shift or die "require itnerface file";
-my $h2context = parse_interface($interface_file);
+my $h2context = Gears::Util->parse_interface($interface_file);
 my $context = dump_h2context($h2context);
 
 if ($opt{c}) {
@@ -44,54 +48,29 @@
     }
     push(@first_context_headers, $line);
   }
+
   close $fh;
   
+  #print "@first_context_headers\n";
+  #print "@last_context_headers\n";
   return (\@first_context_headers,\@last_context_headers);
 }
 
-sub parse_interface {
-  my $file_name = shift;
-
-  open my $fh, '<', $file_name;
-
-  my $h2context = {};
-
-  while (my $line = <$fh>) {
-    if ($line =~ /typedef struct (\w+)\s?<.*/) {
-      die "invalied struct name $1" unless $1;
-      $h2context->{name} = $1;
-      next;
-    }
-
-    if ($line =~ m[/\*|//|}]) {
-      next;
-    }
-
-    if ($line =~ /__code (\w+)\(.*/) {
-      push(@{$h2context->{codes}},$1);
-      next;
-    }
-
-    $line =~ s/\s*([\w\s\*]+);\s*/$1/;
-    push(@{$h2context->{data}},$1);
-  }
-
-  close $fh;
-  return $h2context;
-}
-
-
 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;
 }