Mercurial > hg > Gears > Gears
view src/parallel_execution/lib/Gears/Context.pm @ 823:64a70e5778a7
parsed argument generics
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 18 Jan 2021 13:34:32 +0900 |
parents | 20fdc6938627 |
children | 2deb394a53a9 |
line wrap: on
line source
package Gears::Context; use strict; use warnings; use Gears::Util; use Gears::Interface; use Module::Load qw/load/; use Carp qw/croak cluck/; sub new { my ($class, %args) = @_; my $self = { data_gears_with_count => {}, find_root => $args{find_root} // ".", output => $args{output}, template => $args{template} // "Gears::Template::Context", generics_list => {}, #generics_list has two keys, defined_type or type_variable #type_variable is not defined specific type value }; if ($args{compile_sources}) { $self->{compile_sources} = $args{compile_sources}; for my $file (@{$self->{compile_sources}}) { Gears::Util->file_checking($file); } } return bless $self, $class; } sub extraction_dg_compile_sources { my ($self, $compile_sources) = @_; my %counter; my %include_pool = (); for my $cbc_file (@{$compile_sources}) { open my $fh , '<', $cbc_file; while (my $line = <$fh>) { if ($line =~ m|//\s*:skip|) { next; } if ($line =~ /#interface\s*"(.*)\.h"/) { push(@{$counter{interfaces}->{$1}->{$cbc_file}},$.); next; } if ($line =~ /^\/\/\s*include\s*"(.*)\.(?:h|dg)?"/) { push(@{$include_pool{$1}->{$cbc_file}},$.); next; } if ($line =~ m|//\s*Skip:\s*generate_context|) { $line = <$fh>; next; } if ($line =~ /^\s*(\w+)(<(.*)>)?\*\s*create(\w+)\(([<>,*\w\s]+)\)/) { #AtomicT<T>* createAtomicT(struct Context* context,T init) { # this case defined interface or implement # T means typed variables, not implement generics my $interface = $1; my $generics = $3; my $implementation = $4; my $arg = $5; if ($arg eq "") { next; } if ($arg =~ /</) { #generics in arg my @tmpArgs = split /,/, $arg; my @genericsArgs = grep { /\w+\s*<\w+>/} @tmpArgs; for my $tmpArg (@genericsArgs) { #[0] " AtomicT<int> right", #[1] " AtomicT<int> left" if ($tmpArg =~ /(\w+)<(\w+)>\s*(\w+)/){ my $tmpType = $1; my $tmpGenerics = $2; my $tmpVarName = $3; if ($tmpGenerics eq $generics) { #Test<T>* createTest(Impl test, Hoge<T>) case push( @{$self->{generics_list}->{typed_varible}}, { name => $tmpType, typed_variable => $tmpGenerics, caller => $cbc_file, line_number => $.} ); } else { push( @{$self->{generics_list}->{defined_type}}, { name => $tmpType, defined_type => $tmpGenerics, caller => $cbc_file, line_number => $.} ); } } } } push(@{$counter{interfaces}->{$interface}->{$cbc_file}},$.); push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); if ($generics) { push(@{$self->{generics_list}->{typed_varible}}, { name => $interface, typed_variable => $generics, caller => $cbc_file, line_number => $.}); } next; } # 'AtomicT<int> fork0 = setAtomicT(int)'; # this case define generics variable ex Integer, Single... if ($line =~ /^\s*(\w+)<(.+)>\*?\s*(\w+)\s*=\s*(.+)\(?/) { my $interface = $1; my $generics = $2; my $method = $3; push(@{$counter{interfaces}->{$interface}->{$cbc_file}},$.); push(@{$self->{generics_list}->{defined_type}}, { name => $interface, defined_type => $generics, caller => $cbc_file, line_number => $.}); } if ($line =~ /Gearef\(context,\s*(\w+)\)/) { my $implementation = $1; push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); next; } # ALLOCATE is generated by generate_stub.pl # because extraction_dg_compile_sources caller after translated .cbc to .c #Element* element = &ALLOCATE(cbc_context, Element)->Element; if ($line =~ /ALLOCATE\w*\((?:cbc_)?context,\s*(\w+)\)/) { my $implementation = $1; push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); next; } if ($line =~ /ALLOCATE_(?:PTR_)?ARRAY\((?:cbc_)?context,\s*(\w+),[\s\w]+\)/) { my $implementation = $1; push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); next; } if ($line =~ /new\s+(\w+?)\([\w\s]*\);/) { my $implementation = $1; push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); next; } if ($line =~ /ALLOCATE_DATA_GEAR\((\w+),\s*(\w+)\)/) { my $implementation = $2; push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); next; } #TaskManagerImpl* taskManager = (TaskManagerImpl*)GearImpl(context, TaskManager, taskManager); if ($line =~ /\((\w+)\*\)GearImpl\(context,\s*(\w+),\s*(\w+)\)/) { my $implementation = $1; my $interface = $2; push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); push(@{$counter{interfaces}->{$interface}->{$cbc_file}},$.); next; } if ($line =~ /^__code/) { while ($line =~ /struct (\w+)\s*\*/g) { next if $1 eq "Context"; next if (exists $counter{interfaces}->{$1}); push(@{$counter{impl}->{$1}->{$cbc_file}},$.); } } } close $fh; } use Data::Dumper; for my $cg_name (keys %include_pool) { my @tmp_cbc_file_names = keys %{$include_pool{$cg_name}}; my $tmp_cbc_file_name = shift @tmp_cbc_file_names; if (exists $counter{interfaces}->{$cg_name}){ push(@{$counter{interfaces}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); delete $include_pool{$cg_name}; next; } if (exists $counter{impl}->{$cg_name}){ push(@{$counter{impl}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); delete $include_pool{$cg_name}; next; } push(@{$counter{interfaces}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); delete $include_pool{$cg_name}; } $counter{interfaces}->{Meta}++; $counter{interfaces}->{TaskManager}++; #print "-----------\n"; #print Dumper \%counter; #this line is debug message #print "-----------\n"; return \%counter; } sub _docking_header_name_to_path { my ($root_path, $data_gears_name) = @_; my %res; for my $dg (@{$data_gears_name}) { $res{$dg}++; } my $header_paths = Gears::Util->find_headers_from_path($root_path); for my $headerPATH (sort @$header_paths) { next if ($headerPATH !~ /(\w+)\.(?:h|dg)$/); my $header = $1; next unless (exists $res{$header}); if ($res{$header} =~ /^\d+$/) { $res{$header} = $headerPATH; next; } if (($headerPATH =~ /\.dg/) && ($res{$header} =~ /\.h$/)) { $res{$header} = $headerPATH; } } return \%res; } sub set_data_gear_header_path { my $self = shift; my @data_gears_name = grep { $_ ne "Context" } @_; return _docking_header_name_to_path($self->{find_root},\@data_gears_name); } sub update_dg_each_header_path { my ($self, $dgs, $dg2path) = @_; my $new_dgs; for my $kind (keys %$dgs) { for my $dg_name (keys %{$dgs->{$kind}}) { # If a header is not found, dg2path contains the number of times the header was used if ($dg2path->{$dg_name} && $dg2path->{$dg_name} !~ /^\d+$/) { $new_dgs->{$kind}->{$dg_name} = $dg2path->{$dg_name}; } else { cluck "[ERROR] failed trans header $dg_name\n"; } } } return $new_dgs; } sub tree2create_context_h { my ($self, $dg2path) = @_; croak "require ast at tree2create_context_h" unless ($dg2path); my $template = $self->{template}; load $template; my ($data_struct_str, $from_header_to_caller) = $self->tree2data_struct_str($dg2path); my $output = $self->_select_output(); $template->emit_top_header($output); if (%{$from_header_to_caller}) { $template->emit_include_header($output,$from_header_to_caller); } $template->emit_start_context($output); $template->emit_data_gears($output,$data_struct_str); $template->emit_last_header($output); close $output; } sub _select_output { my $self = shift; #print "$self->{output}\n"; if ($self->{output} eq 'stdout') { return *STDOUT; } open my $fh, '>', $self->{output}; return $fh; } # Generate a header with include file list from a structure's tree structure sub tree2data_struct_str { my ($self, $dg_str) = @_; my %from_header_to_caller; my $data_struct_str = ""; for my $interface (sort keys %$dg_str) { my $elem = $dg_str->{$interface}->{elem}; $data_struct_str .= $self->h2context_str_w_macro($elem); for my $header (_find_include_header_each_cbc($elem)) { push(@{$from_header_to_caller{$header}},$elem->{file_name}); } my $root_impl = $dg_str->{$interface}->{impl}; next unless ($root_impl); for my $impl_name (sort keys %{$root_impl}) { my $impl = $root_impl->{$impl_name}; $data_struct_str .= $self->h2context_str_w_macro($impl); for my $header (_find_include_header_each_cbc($impl)) { push(@{$from_header_to_caller{$header}},$impl->{file_name}); } } } return $data_struct_str, \%from_header_to_caller; } sub _find_include_header_each_cbc { my $ir = shift; unless (exists $ir->{cbc_context_include_headers}) { return (); } return @{$ir->{cbc_context_include_headers}}; } sub createImplTree_from_header { my ($self, $dg2path) = @_; my %dg_str = (); my $inters = $dg2path->{interfaces}; my $impls = $dg2path->{impl}; use Data::Dumper; #print Dumper $dg2path; #print Dumper $self; for my $interface (keys %$inters) { my $ir = Gears::Interface->parse($inters->{$interface}); if ($ir) { $dg_str{$interface}->{elem} = $ir; } } for my $impl (keys %$impls) { my $ir = Gears::Interface->parse($impls->{$impl}); next unless ($ir); if ($ir->{isa}) { $dg_str{$ir->{isa}}->{impl}->{$impl} = $ir; } else { $dg_str{$impl}->{elem} = $ir; } } return \%dg_str; } sub h2context_str_w_macro { my ($self, $h2context) = @_; my $space = ' '; my $context = "${space}//$h2context->{file_name}\n"; $context .= "#ifndef ". uc($h2context->{name}) ."_STRUCT \n"; $context .= $self->h2context_str($h2context); $context .= "#define ". uc($h2context->{name}) ."_STRUCT \n"; $context .= "#else\n"; $context .= "${space}struct $h2context->{name};\n"; $context .= "#endif\n"; return $context; } sub h2context_str { my ($self, $h2context) = @_; my $space = ' '; my $context = "${space}struct $h2context->{name} {\n"; my $content_space; my @enumCodes; my @var; for my $c (@{$h2context->{content}}) { if ($c =~ /\A\s*enum Code/) { push(@enumCodes,$c); } else { push(@var,$c); } } if (@var){ my @chars = split //, $var[0]; for my $w (@chars) { last if ($w !~ /\s/); $content_space .= $w; } } unless (defined $content_space) { $content_space = ""; } for my $c (@var) { $c =~ s/$content_space//; $context .= "${space}${space}$c"; $context .= "\n"; } for my $c (@enumCodes) { $c =~ s/$content_space//; $context .= "${space}${space}$c"; $context .= "\n"; } $context .= "${space}} $h2context->{name};\n"; return $context; } 1;