view paper/src/InterfaceParse.pm @ 88:04a6b05666c1

update
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Fri, 05 Feb 2021 14:00:28 +0900
parents 88ae1e4d83c6
children
line wrap: on
line source

package Gears::Interface;
use strict;
use warnings;
use Carp qw/croak cluck confess/;
use File::Basename qw/dirname/;
use File::Spec;

use Gears::Util;

sub parse {
    # create this data structure
  my ($class, $file) = @_;
  my $ir  = {};
  $ir->{file_name} = $file // confess "require file";

  return undef unless (Gears::Util->file_checking($file));

  open my $fh, '<', $file;
  my $line = <$fh>;
  my $static_data_gear_write_mode = 0;

  my $dir_name = dirname(File::Spec->rel2abs($file));

  while ($line =~ /#include\s+"([\w\/\.]+)"/) {
    my $header_file = $1;
    if ($header_file =~ m|\./context\.h|) {
      $line = <$fh>;
      next;
    }
    push(@{$ir->{cbc_context_include_headers}}, "$dir_name/$header_file");
    $line = <$fh>;
  }

  # skip space

  while ($line =~ /^\s*$/) {
    $line = <$fh>;
  }

  my $typed_variable = {};

  if ($line =~ /typedef struct (\w+)\s?<(.*)>([\s\w{]+)/) {
    my $vname            = $1;
    my $v_typed_variable = $2;
    my $annotation       = $3;

    unless ($vname) {
      cluck "[WARN] invalied struct name from $file";
      return undef;
    }
    $ir->{name}    = $vname;

    if ($v_typed_variable) {
      $typed_variable = parse_header_typed_variable($v_typed_variable);
      $ir->{typed_variable_order} = $typed_variable->{__order};
    }

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

  return undef unless ($ir->{name});

  my @data_gears;
  my %inner_code_gears;

  while ($line = <$fh>) {
    chomp $line;
    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+)|) {

      push(@data_gears,"enum Code $1;"); #this case insert __code name (__code hoge -> enum Code hoge;)

      #In the case of writing field variables one line at a time, cancel the following
      next if $static_data_gear_write_mode;


      my $args = $';
      #$args eq  (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...));
      while ($args =~ /\s*(struct|union|const|enum)?\s*([<>\w\[\]_]+)(\*)?\s*(\w+)?,?/g) {
        my $const_type = $1;
        my $type       = $2;
        my $pointer    = $3 // "";
        my $vname      = $4;

        if ($type eq '__code') {
          $inner_code_gears{$vname} = 1; #collect inner code gears (ex. next, whenEmpty)
          next;
        }
        next unless $vname; # __code hoge(int ret, __code next(ret, ...); this is second "ret" case
        $type =~ s/^(?:Impl|Type|Isa)\s*(\*)?/union Data/;

        my $val = "$type$pointer $vname;";

        parse_generics($val);

        my $generics_info;
        if ($typed_variable) {
          ($val, $generics_info)  = check_use_typed_variable($ir->{name},$typed_variable, $val); #define typed variable
          if (defined $generics_info->{type}){
             unless (grep {$_->{vname} eq $generics_info->{vname} } @{$ir->{typed_variable}}) {
              push(@{$ir->{typed_variable}},$generics_info);
              push(@{$ir->{typed_variable_types}->{$generics_info->{type}}}, $generics_info->{vname});
            }
          }
        }

        $generics_info = {};
        ($val, $generics_info)  = check_use_instance_generics_type($val); #define instance generics variable
        if (defined $generics_info->{type}){
           unless (grep {$_->{vname} eq $generics_info->{vname} } @{$ir->{generics}}) {
              push(@{$ir->{generics}},$generics_info);
            }
        }

        push(@data_gears, $const_type ?  "$const_type $val" : $val);
      }
      next;
    }

    #this is a case of writing field variables one line at a time
    $line =~ s/^\s+//;
    parse_generics($line);

    my $generics_info;
    if ($typed_variable && keys(%$typed_variable)) {
      ($line, $generics_info)  = check_use_typed_variable($ir->{name},$typed_variable, $line); #define typed variable
      if (defined $generics_info->{type}){
        unless (grep {$_->{vname} eq $generics_info->{vname} } @{$ir->{typed_variable}}) {
          push(@{$ir->{typed_variable}},$generics_info);
          push(@{$ir->{typed_variable_types}->{$generics_info->{type}}}, $generics_info->{vname});
        }
      }
    }
    $generics_info = {};
    ($line, $generics_info)  = check_use_instance_generics_type($line); #define typed variable
    if (defined $generics_info->{type}){
      unless (grep {$_->{vname} eq $generics_info->{vname} } @{$ir->{generics}}) {
        push(@{$ir->{generics}},$generics_info);
      }
    }
    push(@data_gears,$line);
    $static_data_gear_write_mode = 1;
  }

  $ir->{inner_code_gears} = \%inner_code_gears;
  push(@{$ir->{content}}, Gears::Util->uniq(@data_gears));
  return $ir;
}