Mercurial > hg > GearsTemplate
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;