changeset 678:8c147f6e1346

add Stub library
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Wed, 19 Aug 2020 19:31:23 +0900
parents 47910f7c731e
children c65f8f00ba6f
files src/parallel_execution/lib/Gears/Stub.pm src/parallel_execution/lib/Gears/Stub/GenerateConstructor.pm src/parallel_execution/lib/Gears/Stub/GenerateDataGear.pm
diffstat 3 files changed, 121 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/parallel_execution/lib/Gears/Stub.pm	Wed Aug 19 19:31:23 2020 +0900
@@ -0,0 +1,39 @@
+package Gears::Stub;
+use strict;
+use warnings;
+use Carp qw/croak/;
+use File::Find;
+use Gears::Util;
+
+use DDP {deparse => 1};
+
+sub new {
+  my ($class, %args) = @_;
+
+  my $self = {};
+  $self->{file_name} = $args{file_name} || croak 'invalid file_name!'; 
+
+  return bless $self, $class;
+}
+
+
+
+sub findInterfacewImpl {
+  my $self     = shift;
+  my $cbc_file = shift // $self->{file_name};
+  my $findInterfaces = Gears::Util->extraction_dg_compile_sources([$cbc_file]);
+  my $edgcs = Gears::Util->extraction_dg_compile_sources([$cbc_file]);
+  my $findInterfaces = {};
+
+  my %ifs = ();
+  map { $ifs{$_}++ } keys %{$edgcs->{interfaces}};
+  delete $ifs{Meta};
+  delete $ifs{TaskManager};
+
+  push(@{$findInterfaces->{interfaces}}, keys %ifs);
+  push(@{$findInterfaces->{impls}}, keys %{$edgcs->{impl}});
+
+  return $findInterfaces;
+}
+
+1;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/parallel_execution/lib/Gears/Stub/GenerateConstructor.pm	Wed Aug 19 19:31:23 2020 +0900
@@ -0,0 +1,68 @@
+package Gears::Stub::GenerateConstructor;
+
+use strict;
+use warnings;
+
+use Gears::Util;
+
+sub generate {
+  my ($out, $impl, $interface) = @_;
+
+  my $impl_ir = $impl->{ir};
+  my $inter_ir = $interface->{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}};
+
+  print $out <<"EOF";
+$impl_ir->{isa}* create$impl_ir->{name}(struct Context* context) {
+    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) {
+        $datum =~ s|//[\s\w]+||;
+        if ($datum =~ /^\s+#/) {
+          next;
+        }
+
+        if ($datum =~ /\w+\s\w+\*\s(\w+)/) {
+            print $out "    ${impl_var_name}->$1 = NULL;\n";
+            next;
+        }
+        if ($datum =~ /\w+\s\w+\s(\w+)/) {
+            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 "    ${impl_var_name}->$var_name = NULL;\n";
+            } else {
+                print $out "    ${impl_var_name}->$var_name  = 0;\n";
+            }
+        }
+  }
+
+
+  for my $code (@{$impl_ir->{codes}}) {
+      my $code_gear = $code->{name};
+      next if $code_gear eq 'next';
+      print $out "    ${impl_var_name}->$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 "    ${interface_var_name}->$code_gear = C_${code_gear}_$impl_ir->{name};\n"
+  }
+
+print $out "    return $interface_var_name;\n";
+print $out "}\n";
+}
+
+1;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/parallel_execution/lib/Gears/Stub/GenerateDataGear.pm	Wed Aug 19 19:31:23 2020 +0900
@@ -0,0 +1,14 @@
+package Gears::Stub::GenerateDataGear;
+use strict;
+use warnings;
+
+
+sub new {
+  my ($class, %args) = @_;
+  my $self = {};
+
+  return bless $self, $class;
+}
+
+
+1;