view src/parallel_execution/lib/Gears/Util.pm @ 709:ed7183a46dca

create a stub when the output is a different interface
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Mon, 24 Aug 2020 21:20:34 +0900
parents cf82fc3512dd
children a7f52fd3d546
line wrap: on
line source

package Gears::Util;
use strict;
use warnings;
use Carp qw/croak/;
use File::Find qw/find/;

my $cbc_files;
my $header_files;
my $cbc_files_analyzed_code_gear;

sub uniq {
  my $class = shift;
  my %seen;
  return grep { !$seen{$_}++ } @_;
}

sub file_checking {
  my ($class, $file_name) = @_;
  unless (-f $file_name) {
    croak "[ERROR] invalid filepath :$file_name\n";
  }
  return $file_name;
}

sub slup {
  my ($class,$file) = @_;
  open my $fh, '<', $file;
  local $/;
  my $f = <$fh>;
  return $f;
}


sub find_cbc_sources_from_path {
  my ($class, $find_path) = @_;
  $find_path //= ".";

  return $cbc_files if $cbc_files;

  my @files;
  find( { wanted => sub { push @files, $_ if /\.cbc/ }, no_chdir => 1 }, $find_path);

  $cbc_files = \@files;
  return $cbc_files;
}

sub find_headers_from_path {
  my ($class, $find_path) = @_;
  $find_path //= ".";
  return $header_files if $header_files;

  my @files;
  find( { wanted => sub { push @files, $_ if /\.(?:h|dg)/ }, no_chdir => 1 }, $find_path);

  $header_files = \@files;
  return $header_files;
}


sub collect_codegears_from_all_cbc_sources {
  my ($class, $find_path) = @_;
  $find_path //= ".";

  if ($cbc_files_analyzed_code_gear) {
    return $cbc_files_analyzed_code_gear;
  }

  Gears::Util->find_cbc_sources_from_path($find_path) unless ($cbc_files);
  my $codes;
  for my $file (@$cbc_files) {
    open my $fh, '<', $file;
    while (my $line = <$fh>) {
      if ($line =~ /^__code\s+(\w+)\((.*)\)\s*\{/) {
        my $codeGear = $1;
        my $arg = $2;
        $codes->{$file}->{$codeGear} = $arg;
      }
    }
    close $fh;
  }

  $cbc_files_analyzed_code_gear = $codes;
  return $cbc_files_analyzed_code_gear;
}


sub searchFileContainsCodeGear {
  my ($class, $codeGearName) = @_;
  unless ($cbc_files_analyzed_code_gear) {
    Gears::Util-> collect_codegears_from_all_cbc_sources();
  }

  my @res = grep { exists $cbc_files_analyzed_code_gear->{$_}->{$codeGearName} } keys %$cbc_files_analyzed_code_gear;

  unless (@res) {
    return undef;
  }
  return \@res;
}

sub parseCodeGearDeclarationArg {
    my ($clas, $args) = @_;
    my %tname2type;
    while ($args =~ /\s*(struct|union|const|enum)?\s*([\w\[\]_]+)\*?\s*(\w+),?/g) {
      #$args eq  (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...));
      my $const_type = $1;
      my $ttype = $2;
      my $tname = $3;

      $ttype =~ s/(Impl|Isa|Type)/Data/;
      if ($const_type && ($const_type =~ /(const|enum)/)) {
        $ttype = "$1 $ttype";
      }
      $tname2type{$tname} = $ttype;
    }
    return \%tname2type;
}




1;