changeset 568:840597c5d242

add_parse_create_each_context.pl
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Sat, 23 Nov 2019 19:36:57 +0900
parents 9adcf0da19b3
children 077158ea026c
files src/parallel_execution/auto_generate_context.pl src/parallel_execution/lib/Gears.pm src/parallel_execution/tmp_tool/parse_cerate_each_context.pl
diffstat 3 files changed, 66 insertions(+), 3 deletions(-) [+]
line wrap: on
line diff
--- a/src/parallel_execution/auto_generate_context.pl	Sat Nov 23 16:43:24 2019 +0900
+++ b/src/parallel_execution/auto_generate_context.pl	Sat Nov 23 19:36:57 2019 +0900
@@ -3,15 +3,13 @@
 use warnings;
 use Gears;
 use DDP {deparse => 1};
-use Data::Dumper;
 
 my @cbc_files = <DATA>;
 chomp @cbc_files;
 my $gears = Gears->new(compile_sources => \@cbc_files);
 $gears->extraction_dg_compile_sources();
+$gears->search_data_gears();
 
-p $gears;
-print Dumper $gears;
 
 __DATA__
 /Users/anatofuz/src/firefly/hg/Gears/src/parallel_execution/examples/calc/calc.cbc
--- a/src/parallel_execution/lib/Gears.pm	Sat Nov 23 16:43:24 2019 +0900
+++ b/src/parallel_execution/lib/Gears.pm	Sat Nov 23 19:36:57 2019 +0900
@@ -46,5 +46,17 @@
   close $fh;
 }
 
+sub search_data_gears {
+  my $self = shift;
+  my @data_gears_name;
+  if (@_) {
+    @data_gears_name = @_;
+  } else {
+    @data_gears_name = keys %{$self->{data_gears_with_count}};
+  }
+  #my @data_gears_name =  keys %{$self->{data_gears_with_count}};
+  p @data_gears_name;
+}
+
 
 1;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/parallel_execution/tmp_tool/parse_cerate_each_context.pl	Sat Nov 23 19:36:57 2019 +0900
@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use DDP {deparse => 1};
+
+my $context = shift // "context.h";
+
+open my $fh, '<', $context; 
+while (my $line = <$fh>) {
+  if ($line =~ /^union Data \{/) {
+    last;
+  }
+}
+
+my @context_cg_str = <$fh>;
+close($fh);
+chomp @context_cg_str;
+my $res = {};
+
+while (my $line = shift @context_cg_str) {
+  if ($line =~ /\s*struct\s*(\w+)\s*\{/) {
+    my $struct = $1;
+    $line = shift @context_cg_str;
+    while ($line !~  /\}\s*$struct/) {
+      if ($line =~ /\s*([\w ]+)\s*\{/) {
+        my $tmps = $1;
+        my @tmpl = ();
+        $line = shift @context_cg_str;
+        while ($line !~ /}/) {
+          $line =~ s/\s+([\*\w ]+);/$1/g;
+          push (@tmpl,$line);
+          $line = shift @context_cg_str;
+        }
+        push (@{$res->{$struct}},{ $tmps => \@tmpl});
+        $line = shift @context_cg_str;
+        while ($line =~ /}/) {
+          $line = shift @context_cg_str;
+        }
+        unshift(@context_cg_str,$line);
+        last;
+      }
+      if ($line =~ /\s+([\*\w ]+);/) {
+        push (@{$res->{$struct}},$1);
+      }
+      if (@context_cg_str) {
+        $line = shift @context_cg_str ;
+      }
+    }
+  }
+}
+use Data::Dumper;
+
+print Dumper  $res;