Mercurial > hg > Members > menikon > CbC_xv6
view src/gearsTools/lib/Gears/Util.pm @ 110:8c7c1ea49f21
impl auto gen context tools
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Wed, 27 Nov 2019 21:21:42 +0900 |
parents | b84aac4ab529 |
children | b9df8ea87b42 |
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[^//]); 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 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/ }, 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;