changeset 341:97e3acfa9fba

update trans_impl from gears
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Mon, 24 Feb 2020 16:15:52 +0900
parents b09689bf7f8d
children 1a63c120f2ba
files src/gearsTools/trans_impl.pl
diffstat 1 files changed, 42 insertions(+), 31 deletions(-) [+]
line wrap: on
line diff
--- a/src/gearsTools/trans_impl.pl	Fri Feb 21 21:41:46 2020 +0900
+++ b/src/gearsTools/trans_impl.pl	Mon Feb 24 16:15:52 2020 +0900
@@ -18,19 +18,32 @@
 
 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, $inter_ir, $impl_ir, $impl_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}, $inter_ir, $impl_ir, $impl_file);
+      update_file($opt{o}, $interface, $impl, $impl_file);
       exit 0;
     }
     open $stdout, '>', $opt{o};
@@ -38,7 +51,7 @@
 
 emit_include_part($stdout, $inter_ir->{name});
 emit_impl_header_in_comment($stdout, $impl_file);
-emit_constracutor($stdout,$impl_ir,$inter_ir);
+emit_constracutor($stdout,$impl,$interface);
 emit_code_gears($stdout,$impl_ir,$inter_ir);
 close $stdout;
 
@@ -59,25 +72,23 @@
   print $out "// ----\n\n";
 }
 
+
 sub emit_constracutor {
-  my ($out, $impl_ir, $inter_ir) = @_;
+  my ($out, $impl, $interface) = @_;
+
+  my $impl_ir = $impl->{ir};
+  my $inter_ir = $impl->{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}};
-  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;
 
   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;
+    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) {
@@ -87,20 +98,20 @@
         }
 
         if ($datum =~ /\w+\s\w+\*\s(\w+)/) {
-            print $out "    ${instance_impl}->$1 = NULL;\n";
+            print $out "    ${impl_var_name}->$1 = NULL;\n";
             next;
         }
         if ($datum =~ /\w+\s\w+\s(\w+)/) {
-            print $out "    ${instance_impl}->$1 = 0;\n";
+            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 "    ${instance_impl}->$var_name = NULL;\n";
+                print $out "    ${impl_var_name}->$var_name = NULL;\n";
             } else {
-                print $out "    ${instance_impl}->$var_name  = 0;\n";
+                print $out "    ${impl_var_name}->$var_name  = 0;\n";
             }
         }
   }
@@ -109,16 +120,16 @@
   for my $code (@{$impl_ir->{codes}}) {
       my $code_gear = $code->{name};
       next if $code_gear eq 'next';
-      print $out "    ${instance_impl}->$code_gear = C_$code_gear;\n"
+      print $out "    ${impl_var_name}->$code_gear = C_$code_gear$impl_ir->{name};\n"
   }
 
   for my $code (@{$inter_ir->{codes}}) {
       my $code_gear = $code->{name};
       next if $code_gear eq 'next';
-      print $out "    ${instance_inter}->$code_gear = C_$code_gear$impl_ir->{name};\n"
+      print $out "    ${interface_var_name}->$code_gear = C_$code_gear$impl_ir->{name};\n"
   }
 
-print $out "    return $instance_inter;\n";
+print $out "    return $interface_var_name;\n";
 print $out "}\n";
 }
 
@@ -129,12 +140,12 @@
   my $interface_name = $inter_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 $interface_var_name = shift @inter_data;
+  if ($interface_var_name =~ /union\s*Data\*\s*(\w+)/) {
+    $interface_var_name = $1;
   }
-  my $instance_impl = lcfirst $impl_ir->{name};
-  $instance_impl =~ s/([A-Z])/_\l$1/g;
+  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}) {
@@ -189,12 +200,12 @@
 }
 
 sub update_file {
-    my ($output_file, $inter_ir, $impl_ir, $impl_file) = @_;
-    my $under_code = collection_save_code_gears($output_file,$inter_ir->{name});
+    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, $inter_ir->{name});
+    emit_include_part($fh, $interface->{var_name});
     emit_impl_header_in_comment($fh, $impl_file);
-    emit_constracutor($fh,$impl_ir,$inter_ir);
+    emit_constracutor($fh,$impl,$interface);
     map { print $fh $_ } @{$under_code};
     close $fh;
 }