Mercurial > hg > GearsTemplate
changeset 560:2276952ed717
impl trans_impl.pl
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 19 Nov 2019 13:24:21 +0900 |
parents | 2dc06f944a85 |
children | aa4bef31cbfd |
files | src/parallel_execution/trans_impl.pl |
diffstat | 1 files changed, 65 insertions(+), 7 deletions(-) [+] |
line wrap: on
line diff
--- a/src/parallel_execution/trans_impl.pl Tue Nov 19 00:06:07 2019 +0900 +++ b/src/parallel_execution/trans_impl.pl Tue Nov 19 13:24:21 2019 +0900 @@ -9,14 +9,14 @@ use DDP { deparse => 1}; my $impl_file = shift or die 'require impl file'; -my $impl_ir = Gears::Util->parse_impl($impl_file); +my $impl_ir = Gears::Util->parse_code_verbose($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_include_part($stdout, $inter_ir->{name}); emit_constracutor($stdout,$impl_ir,$inter_ir); -#emit_include_part($stdout, "Stack"); +emit_code_gears($stdout,$impl_ir,$inter_ir); #emit_impl_header_in_comment($stdout, $impl_file); sub emit_include_part { @@ -39,22 +39,27 @@ sub emit_constracutor { my ($out, $impl_ir, $inter_ir) = @_; - my $instance_inter = shift @{$inter_ir->{data}}; + my @inter_data = @{$inter_ir->{data}}; + my $instance_inter = shift @inter_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) { +$impl_ir->{isa}* 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}}) { + for my $datum (@inter_data) { if ($datum =~ /\w+ \w+\* (\w+)/) { - print $out " ${instance_impl}->$1 = NULL;\n" + print $out " ${instance_impl}->$1 = NULL;\n"; + next; + } + if ($datum =~ /\w+ \w+ (\w+)/) { + print $out " ${instance_impl}->$1 = 0;\n"; } } @@ -67,3 +72,56 @@ print $out "}\n"; } + +sub emit_code_gears { + my ($out, $impl_ir, $inter_ir) = @_; + my $impl = $impl_ir->{name}; + + my @inter_data = @{$inter_ir->{data}}; + my $instance_inter = shift @inter_data; + if ($instance_inter =~ /union\s*Data\*\s*(\w+)/) { + $instance_inter = $1; + } + my $instance_impl = lcfirst $impl_ir->{name}; + my $data_gear_types = {}; + + for my $code_ir (@{$inter_ir->{codes}}) { + my $data_gears = $code_ir->[1]; + $data_gears =~ s/Impl/$impl/g; + while ($data_gears =~ /Type\*\s*(\w+),/) { + my $target = $1; + if (exists $data_gear_types->{$target}){ + $data_gears =~ s/Type\*/$data_gear_types->{$target}/; + } else { + my $td = ""; + map { $td = $_ if ($_ =~ /$target/) } @inter_data; + if ($td =~ /(\w+)\s*([\w\*]+)\s*(\w+)/) { + my $tmp = "$1 $2"; + $data_gears =~ s/Type\*/$tmp/; + $data_gear_types->{$target} = $tmp; + } + } + } + + print $out "__code $code_ir->[0]$impl("; + print $out "$data_gears) {\n\n"; + + #__code next(...), __code whenEmpty(...) + my @cg = (); + while ($data_gears =~ /__code ([\w(\.)\*\s,]+?\)),?/g) { + push(@cg, $1); + } + + if (@cg) { + if (@cg == 2) { + print $out " if (:TODO:) {\n"; + print $out " goto ",shift(@cg),";\n"; + print $out " }\n"; + print $out " goto ",shift(@cg),";\n"; + } else { + print $out " goto ",shift(@cg),";\n"; + } + } + print $out "}\n\n"; + } +}