view src/gearsTools/static_gen_header.pl @ 367:650fac123133

...
author anatofuz
date Fri, 03 Jul 2020 21:21:38 +0900
parents c958c355f805
children 19d966c1d2c6
line wrap: on
line source

#!/usr/bin/env perl
use strict;
use warnings;

=head1 DESCRIPTION

emit Gears header files

=head1 SYNOPSIS

    % sample.pl --interface list
    % sample.pl --impl single_linked_list --interface list
    % sample.pl -w --interface list

=cut

use Getopt::Long qw/:config posix_default no_ignore_case bundling auto_help/;

use Pod::Usage qw/pod2usage/;

GetOptions(
    \my %opt, qw/
    interface=s
    impl=s
    o=s
    w
/) or pod2usage(1);


unless ($opt{interface}) {
    pod2usage(1);
}

my ($type, $msg);

if ($opt{impl}) {
  $msg = emit_impl_header($opt{interface}, $opt{impl});
  $type = $opt{impl};
} else {
  $msg = emit_interface_header($opt{interface});
  $type = $opt{interface};
}

$msg .= emit_last($type);

unless ($opt{w} || $opt{o}) {
  print $msg;
  exit 0;
}

my $emit_file;

if ($opt{o}) {
    $emit_file = $opt{o};
} else {
    $emit_file = "$type.h"
}


open my $fh, '>', $emit_file;
print $fh $msg;
close $fh;

sub emit_interface_header {
  my $interface_name = shift;
  return "typedef struct $interface_name <Type, Impl> {\n";
}

sub emit_impl_header {
  my ($interface_name, $impl_name)  = @_;
  return "typedef struct $impl_name <Type, Isa> impl $interface_name {\n";
}

sub emit_last {
  my $type = shift;
  my $msg = "  __code next(....);\n";
  $msg .= "} $type;\n";
  return $msg;
}