changeset 559:2dc06f944a85

tweak
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Tue, 19 Nov 2019 00:06:07 +0900
parents 8a825fc15817
children 2276952ed717
files src/parallel_execution/lib/Gears/Util.pm src/parallel_execution/trans_impl.pl
diffstat 2 files changed, 71 insertions(+), 9 deletions(-) [+]
line wrap: on
line diff
--- a/src/parallel_execution/lib/Gears/Util.pm	Mon Nov 18 21:32:08 2019 +0900
+++ b/src/parallel_execution/lib/Gears/Util.pm	Tue Nov 19 00:06:07 2019 +0900
@@ -10,6 +10,12 @@
   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);
@@ -32,7 +38,7 @@
 }
 
 sub _parse_base {
-  my ($file) = @_;
+  my ($file,$code_verbose) = @_;
   my $ir  = {};
 
   _file_checking($file);
@@ -59,13 +65,17 @@
     next if ($line =~ /^\s+$/);
     next if ($line =~ m[//|}]);
 
-    if ($line =~ /__code (\w+)\(.*/) {
-      push(@{$ir->{codes}},$1);
+    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->{deta}},$1);
+    push(@{$ir->{data}},$1);
   }
 
   return $ir;
--- a/src/parallel_execution/trans_impl.pl	Mon Nov 18 21:32:08 2019 +0900
+++ b/src/parallel_execution/trans_impl.pl	Tue Nov 19 00:06:07 2019 +0900
@@ -7,11 +7,63 @@
 use Gears::Util;
 
 use DDP { deparse => 1};
-my $cur_path = "$FindBin::Bin";
 
 my $impl_file = shift or die 'require impl file';
-my $ir =  Gears::Util->parse_impl($impl_file);
-my $hoge  =  Gears::Util->find_header($ir->{isa},$cur_path);
-#my $foo =  Gears::Util->slup($hoge);
-p $hoge;
+my $impl_ir         = Gears::Util->parse_impl($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_constracutor($stdout,$impl_ir,$inter_ir);
+#emit_include_part($stdout, "Stack");
+#emit_impl_header_in_comment($stdout, $impl_file);
+
+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";
+}
 
+sub emit_constracutor {
+  my ($out, $impl_ir, $inter_ir) = @_;
+
+  my $instance_inter = shift @{$inter_ir->{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) {
+    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}}) {
+        if ($datum =~ /\w+ \w+\* (\w+)/) {
+            print $out "    ${instance_impl}->$1 = NULL;\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";
+}
+