view src/gearsTools/lib/Gears/Util.pm @ 112:b9df8ea87b42

fix trans_impl.pl
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Thu, 28 Nov 2019 16:58:04 +0900
parents 8c7c1ea49f21
children efff86f375ed
line wrap: on
line source

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

sub parse {
  my ($class, $file_name) = @_;
  my $ir = _parse_base($file_name);
  return $ir;
}

sub parse_code_verbose {
  my ($class, $file_name) = @_;
  my $ir = _parse_base($file_name,1);
  return $ir;
}

sub parse_interface {
  my ($class, $file_name) = @_;
  my $ir = _parse_base($file_name);
  
  unless ($ir->{name}) {
    croak 'invalid struct name';
  }
  return $ir;
}


sub parse_impl {
  my ($class, $file_name) = @_;
  my $ir = _parse_base($file_name);

  unless ($ir->{isa} && $ir->{name}) {
    croak 'invalid struct name';
  }
  return $ir;
}

sub _parse_base {
  my ($file,$code_verbose) = @_;
  my $ir  = {};

  Gears::Util->file_checking($file);
  open my $fh, '<', $file;
  my $line = <$fh>;

  if ($line =~ /typedef struct (\w+)\s?<.*>([\s\w{]+)/) {
    die "invalied struct name $1" unless $1;
    $ir->{name} = $1;

    if ($2 =~ m|\s*impl\s*([\w+]+)\s*{|) {
      $ir->{isa} = $1;
    }
  }

  while ($line = <$fh>) {
    if ($line =~ m|\s*/\*|) {
      while ( $line !~ m|\*/|) {
        $line = <$fh>;
        next;
      }
      next;
    }
    next if ($line =~ /^\s+$/);
    next if ($line =~ m[^\s*//]);
    next if ($line =~ m[^\}\s*$ir->{name};]);

    if ($line =~ m|__code (\w+)\(([()\.\*\s\w,_]+)\)|) {
      $line = "enum Code $1;\n";
    }

    push(@{$ir->{content}},$line);
  }

  return $ir;
}

sub parse_with_rewrite {
  my ($class, $file)  = @_;
  my $ir = _parse_base($file);

  my @data_gears;
  my @code_gears;
  map { push (@data_gears, $_) unless ($_ =~ /enum Code/);} @{$ir->{content}};
  map { push (@code_gears, $1) if ($_ =~ /enum Code (\w+);/);} @{$ir->{content}};

  open my $fh , '<', $file;
  my $i = 0;
  while (($i < scalar @code_gears) && (my $line = <$fh>)) {
      my $cg = $code_gears[$i];
      if ($line =~ m|__code $cg\(([()\.\*\s\w,_]+)\)|) {
        $code_gears[$i] = {
          name => $cg,
          args => $1,
        };
        $i++;
      }
  }
  $ir->{codes} = \@code_gears;
  $ir->{data}  = \@data_gears;
  return $ir;
}

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

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

sub find_header {
  my $class = shift;
  my $header_name = shift;

  my $find_path = shift // ".";
  my $header_file = '';

  find(
    {
      wanted => sub {
        if ($_ =~ /\/$header_name\.h/) {
          $header_file = $_;
        }
      },
      no_chdir => 1,
    },
    $find_path);
  return $header_file;
}

sub find_headers_path {
  my $class = shift;
  my $find_path = shift // ".";

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

  return \@files;
}

sub h2context_str {
  my ($class, $h2context) = @_;
  my $context = '';
  my $space = '    ';

  $context =  "${space}struct $h2context->{name} {\n";
  my $content_space;
  if (exists $h2context->{content}){
    my @chars = split //, $h2context->{content}->[0];
    for my $w (@chars) {
      last if ($w !~ /\s/);
      $content_space .= $w;
    }
  }

  unless (defined $content_space) {
    $content_space = "";
  }

  for my $c (@{$h2context->{content}}) {
    $c =~ s/$content_space//;
    $context .= "${space}${space}$c";
  }
  $context .= "${space}} $h2context->{name};\n";
  return $context;
}


1;