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";
}