changeset 339:75df4b25f6a5

update from Gears
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Fri, 21 Feb 2020 21:41:05 +0900
parents 2cbaa4c74d15
children b09689bf7f8d
files src/gearsTools/trans_impl.pl
diffstat 1 files changed, 24 insertions(+), 21 deletions(-) [+]
line wrap: on
line diff
--- a/src/gearsTools/trans_impl.pl	Sun Feb 16 18:30:06 2020 +0900
+++ b/src/gearsTools/trans_impl.pl	Fri Feb 21 21:41:05 2020 +0900
@@ -74,7 +74,7 @@
   $instance_impl     =~ s/([A-Z])/_\l$1/g;
 
   print $out <<"EOF";
-$impl_ir->{isa}* create$impl_ir->{name}(struct Context* cbc_context) {
+$impl_ir->{isa}* create$impl_ir->{name}(struct Context* 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;
@@ -108,11 +108,13 @@
 
   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"
   }
 
   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"
   }
 
@@ -136,36 +138,37 @@
   my $data_gear_types = {};
 
   if (defined $impl_ir->{codes}) {
-    for my $cg (@{$impl_ir->{codes}}) {
-      my $data_gears = $cg->{args};
-      while ($data_gears =~ /Type\*\s*(\w+),/g) {
-          $data_gears =~ s/Type\*/struct $impl*/;
-      }
+    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*/;
       }
-      print $out "__code $cg->{name}$impl(";
-      print $out "$data_gears) {\n\n";
-      _emit_cg($out,$data_gears);
-
+    } else {
+      $data_gears =~ s/Impl/struct $impl/g;
     }
-  }
-
-  for my $code_ir (@{$inter_ir->{codes}}) {
-    my $data_gears = $code_ir->{args};
-    $data_gears =~ s/Impl/struct $impl/g;
-
-    while ($data_gears =~ /Type\*\s*(\w+),/g) {
-        $data_gears =~ s/Type\*/struct $interface_name*/;
-    }
-
-    print $out "__code $code_ir->{name}$impl(";
+    print $out "__code $cg->{name}$impl(";
     print $out "$data_gears) {\n\n";
     _emit_cg($out,$data_gears);
   }
 }
 
+
 sub _emit_cg {
   my ($out, $data_gears) = @_;
   my @cg = ();