changeset 560:2276952ed717

impl trans_impl.pl
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Tue, 19 Nov 2019 13:24:21 +0900
parents 2dc06f944a85
children aa4bef31cbfd
files src/parallel_execution/trans_impl.pl
diffstat 1 files changed, 65 insertions(+), 7 deletions(-) [+]
line wrap: on
line diff
--- a/src/parallel_execution/trans_impl.pl	Tue Nov 19 00:06:07 2019 +0900
+++ b/src/parallel_execution/trans_impl.pl	Tue Nov 19 13:24:21 2019 +0900
@@ -9,14 +9,14 @@
 use DDP { deparse => 1};
 
 my $impl_file = shift or die 'require impl file';
-my $impl_ir         = Gears::Util->parse_impl($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 $stdout    = *STDOUT;
+emit_include_part($stdout, $inter_ir->{name});
 emit_constracutor($stdout,$impl_ir,$inter_ir);
-#emit_include_part($stdout, "Stack");
+emit_code_gears($stdout,$impl_ir,$inter_ir);
 #emit_impl_header_in_comment($stdout, $impl_file);
 
 sub emit_include_part {
@@ -39,22 +39,27 @@
 sub emit_constracutor {
   my ($out, $impl_ir, $inter_ir) = @_;
 
-  my $instance_inter = shift @{$inter_ir->{data}};
+  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->{name}* create$impl_ir->{name}(struct Context* 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;
 EOF
 
-  for my $datum (@{$impl_ir->{data}}) {
+  for my $datum (@inter_data) {
         if ($datum =~ /\w+ \w+\* (\w+)/) {
-            print $out "    ${instance_impl}->$1 = NULL;\n"
+            print $out "    ${instance_impl}->$1 = NULL;\n";
+            next;
+        }
+        if ($datum =~ /\w+ \w+ (\w+)/) {
+            print $out "    ${instance_impl}->$1 = 0;\n";
         }
   }
 
@@ -67,3 +72,56 @@
 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";
+  }
+}