Mercurial > hg > GearsTemplate
view src/parallel_execution/trans_impl.pl @ 559:2dc06f944a85
tweak
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 19 Nov 2019 00:06:07 +0900 |
parents | 8a825fc15817 |
children | 2276952ed717 |
line wrap: on
line source
#!/usr/bin/env perl use strict; use warnings; use FindBin; use lib "$FindBin::Bin/lib"; use Gears::Util; use DDP { deparse => 1}; my $impl_file = shift or die 'require impl file'; my $impl_ir = Gears::Util->parse_impl($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_constracutor($stdout,$impl_ir,$inter_ir); #emit_include_part($stdout, "Stack"); #emit_impl_header_in_comment($stdout, $impl_file); sub emit_include_part { my ($out, $interface) = @_; print $out <<"EOF" #include "../context.h"; #interface "$interface.h"; EOF } sub emit_impl_header_in_comment { my ($out, $impl_file) = @_; my $line = Gears::Util->slup($impl_file); print $out "// ----\n"; map { print $out "// $_\n" } split /\n/, $line; print $out "// ----\n"; } sub emit_constracutor { my ($out, $impl_ir, $inter_ir) = @_; my $instance_inter = shift @{$inter_ir->{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) { 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}}) { if ($datum =~ /\w+ \w+\* (\w+)/) { print $out " ${instance_impl}->$1 = NULL;\n" } } for my $code (@{$inter_ir->{codes}}) { my $code_gear = $code->[0]; print $out " ${instance_inter}->$code_gear = C_$code_gear$impl_ir->{name};\n" } print $out " return $instance_inter;\n"; print $out "}\n"; }