annotate src/gearsTools/static_gen_header.pl @ 354:fde5f96c6ff1

use common perl script
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Fri, 12 Jun 2020 20:44:01 +0900
parents c958c355f805
children 650fac123133
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
343
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
1 #!/usr/bin/env perl
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
2 use strict;
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
3 use warnings;
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
4
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
5 =head1 DESCRIPTION
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
6
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
7 emit Gears header files
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
8
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
9 =head1 SYNOPSIS
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
10
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
11 % sample.pl --interface list
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
12 % sample.pl --impl single_linked_list --interface list
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
13 % sample.pl -w --interface list
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
14
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
15 =cut
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
16
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
17 use Getopt::Long qw/:config posix_default no_ignore_case bundling auto_help/;
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
18
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
19 use Pod::Usage qw/pod2usage/;
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
20
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
21 GetOptions(
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
22 \my %opt, qw/
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
23 interface=s
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
24 impl=s
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
25 o=s
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
26 w
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
27 /) or pod2usage(1);
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
28
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
29
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
30 unless ($opt{interface}) {
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
31 pod2usage(1);
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
32 }
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
33
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
34 my ($type, $msg);
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
35
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
36 if ($opt{impl}) {
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
37 $msg = emit_impl_header($opt{interface}, $opt{impl});
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
38 $type = $opt{impl};
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
39 } else {
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
40 $msg = emit_interface_header($opt{interface});
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
41 $type = $opt{interface};
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
42 }
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
43
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
44 $msg .= emit_last($type);
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
45
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
46 unless ($opt{w} || $opt{o}) {
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
47 print $msg;
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
48 exit 0;
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
49 }
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
50
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
51 my $emit_file;
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
52
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
53 if ($opt{o}) {
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
54 $emit_file = $opt{o};
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
55 } else {
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
56 $emit_file = "$type.h"
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
57 }
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
58
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
59
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
60 open my $fh, '>', $emit_file;
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
61 print $fh $msg;
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
62 close $fh;
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
63
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
64 sub emit_interface_header {
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
65 my $interface_name = shift;
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
66 return "typedef struct $interface_name <Type, Impl> {\n";
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
67 }
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
68
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
69 sub emit_impl_header {
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
70 my ($interface_name, $impl_name) = @_;
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
71 return "typedef struct $impl_name <Type, Isa> impl $interface_name {\n";
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
72 }
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
73
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
74 sub emit_last {
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
75 my $type = shift;
353
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 349
diff changeset
76 my $msg = " __code next(....);\n";
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 349
diff changeset
77 $msg .= "} $type;\n";
343
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
78 return $msg;
a9aba14b2b6a add static_gen_header script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
79 }