Mercurial > hg > GearsTemplate

annotate src/parallel_execution/trans_impl.pl @ 585:b2157a88e0ef

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
tweak trans_impl
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Tue, 03 Dec 2019 08:21:48 +0900
parents 823503ada47f
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
555
bcc137ca91da add trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
1 #!/usr/bin/env perl
bcc137ca91da add trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
2 use strict;
bcc137ca91da add trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
3 use warnings;
bcc137ca91da add trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
4
557
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 556
diff changeset
5 use FindBin;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 556
diff changeset
6 use lib "$FindBin::Bin/lib";
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 556
diff changeset
7 use Gears::Util;
555
bcc137ca91da add trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
8
561
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
9 use Getopt::Std;
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
10
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
11 my %opt;
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
12 getopts("w" => \%opt);
555
bcc137ca91da add trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
13
557
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 556
diff changeset
14 my $impl_file = shift or die 'require impl file';
583
ba529ff3f068 fix trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 563
diff changeset
15 my $impl_ir = Gears::Util->parse_with_rewrite($impl_file);
559
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
16 my $interface_file = Gears::Util->find_header($impl_ir->{isa},"$FindBin::Bin");
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
17
583
ba529ff3f068 fix trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 563
diff changeset
18 my $inter_ir = Gears::Util->parse_with_rewrite($interface_file);
561
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
19
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
20
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
21 my $output_file = $impl_file;
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
22 $output_file =~ s/\.h/.cbc/;
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
23 open my $fh, '>', $output_file;
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
24 my $stdout = $fh;
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
25
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
26 unless ($opt{w}) {
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
27 $stdout = *STDOUT;
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
28 }
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
29
560
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
30 emit_include_part($stdout, $inter_ir->{name});
561
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
31 emit_impl_header_in_comment($stdout, $impl_file);
559
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
32 emit_constracutor($stdout,$impl_ir,$inter_ir);
560
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
33 emit_code_gears($stdout,$impl_ir,$inter_ir);
561
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
34 close $fh;
559
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
35
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
36 sub emit_include_part {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
37 my ($out, $interface) = @_;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
38 print $out <<"EOF"
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
39 #include "../context.h";
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
40 #interface "$interface.h";
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
41
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
42 EOF
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
43 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
44
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
45 sub emit_impl_header_in_comment {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
46 my ($out, $impl_file) = @_;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
47 my $line = Gears::Util->slup($impl_file);
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
48 print $out "// ----\n";
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
49 map { print $out "// $_\n" } split /\n/, $line;
561
aa4bef31cbfd add write mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 560
diff changeset
50 print $out "// ----\n\n";
559
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
51 }
558
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 557
diff changeset
52
559
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
53 sub emit_constracutor {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
54 my ($out, $impl_ir, $inter_ir) = @_;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
55
563
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
56 my @inter_data = @{$inter_ir->{data}};
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
57 my @impl_data = @{$impl_ir->{data}};
560
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
58 my $instance_inter = shift @inter_data;
563
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
59
559
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
60 if ($instance_inter =~ /union\s*Data\*\s*(\w+)/) {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
61 $instance_inter = $1;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
62 }
563
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
63
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
64 my $instance_impl = lcfirst $impl_ir->{name};
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
65 $instance_impl =~ s/([A-Z])/_\l$1/g;
559
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
66
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
67 print $out <<"EOF";
560
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
68 $impl_ir->{isa}* create$impl_ir->{name}(struct Context* context) {
559
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
69 struct $impl_ir->{isa}* $instance_inter = new $impl_ir->{isa}();
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
70 struct $impl_ir->{name}* $instance_impl = new $impl_ir->{name}();
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
71 $instance_inter->$instance_inter = (union Data*)$instance_impl;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
72 EOF
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
73
563
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
74 for my $datum (@impl_data) {
559
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
75 if ($datum =~ /\w+ \w+\* (\w+)/) {
583
ba529ff3f068 fix trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 563
diff changeset
76 print $out " ${instance_impl}->$1 = NULL;\n";
560
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
77 next;
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
78 }
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
79 if ($datum =~ /\w+ \w+ (\w+)/) {
583
ba529ff3f068 fix trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 563
diff changeset
80 print $out " ${instance_impl}->$1 = 0;\n";
563
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
81 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
82 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
83
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
84 for my $datum (@inter_data) {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
85 if ($datum =~ /\w+ \w+\* (\w+)/) {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
86 print $out " ${instance_inter}->$1 = NULL;\n";
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
87 next;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
88 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
89 if ($datum =~ /\w+ \w+ (\w+)/) {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
90 print $out " ${instance_inter}->$1 = 0;\n";
559
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
91 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
92 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
93
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
94 for my $code (@{$inter_ir->{codes}}) {
583
ba529ff3f068 fix trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 563
diff changeset
95 my $code_gear = $code->{name};
559
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
96 print $out " ${instance_inter}->$code_gear = C_$code_gear$impl_ir->{name};\n"
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
97 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
98
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
99 print $out " return $instance_inter;\n";
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
100 print $out "}\n";
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
101 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 558
diff changeset
102
560
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
103
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
104 sub emit_code_gears {
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
105 my ($out, $impl_ir, $inter_ir) = @_;
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
106 my $impl = $impl_ir->{name};
584
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
107 my $interface_name = $inter_ir->{name};
560
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
108
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
109 my @inter_data = @{$inter_ir->{data}};
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
110 my $instance_inter = shift @inter_data;
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
111 if ($instance_inter =~ /union\s*Data\*\s*(\w+)/) {
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
112 $instance_inter = $1;
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
113 }
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
114 my $instance_impl = lcfirst $impl_ir->{name};
563
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 562
diff changeset
115 $instance_impl =~ s/([A-Z])/_\l$1/g;
560
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
116 my $data_gear_types = {};
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
117
584
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
118 if (defined $impl_ir->{codes}) {
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
119 for my $cg (@{$impl_ir->{codes}}) {
585
b2157a88e0ef tweak trans_impl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 584
diff changeset
120 my $data_gears = $cg->{args};
584
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
121 while ($data_gears =~ /Type\*\s*(\w+),/g) {
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
122 $data_gears =~ s/Type\*/struct $impl*/;
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
123 }
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
124
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
125 while ($data_gears =~ /Isa\*\s*(\w+),/g) {
585
b2157a88e0ef tweak trans_impl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 584
diff changeset
126 $data_gears =~ s/Isa\*/struct $interface_name*/;
584
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
127 }
585
b2157a88e0ef tweak trans_impl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 584
diff changeset
128 print $out "__code $cg->{name}$impl(";
584
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
129 print $out "$data_gears) {\n\n";
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
130
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
131 #__code next(...), __code whenEmpty(...)
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
132 my @cg = ();
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
133 while ($data_gears =~ /__code ([\w(\.)\*\s,]+?\)),?/g) {
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
134 push(@cg, $1);
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
135 }
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
136
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
137 if (@cg) {
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
138 if (@cg == 2) {
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
139 print $out " if (:TODO:) {\n";
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
140 print $out " goto ",shift(@cg),";\n";
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
141 print $out " }\n";
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
142 print $out " goto ",shift(@cg),";\n";
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
143 } else {
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
144 print $out " goto ",shift(@cg),";\n";
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
145 }
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
146 }
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
147 print $out "}\n\n";
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
148 }
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
149 }
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
150
560
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
151 for my $code_ir (@{$inter_ir->{codes}}) {
583
ba529ff3f068 fix trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 563
diff changeset
152 my $data_gears = $code_ir->{args};
ba529ff3f068 fix trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 563
diff changeset
153 $data_gears =~ s/Impl/struct $impl/g;
584
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
154
562
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 561
diff changeset
155 while ($data_gears =~ /Type\*\s*(\w+),/g) {
584
823503ada47f add SingleLinkedStack.h
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 583
diff changeset
156 $data_gears =~ s/Type\*/struct $interface_name*/;
560
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
157 }
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
158
583
ba529ff3f068 fix trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 563
diff changeset
159 print $out "__code $code_ir->{name}$impl(";
560
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
160 print $out "$data_gears) {\n\n";
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
161
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
162 #__code next(...), __code whenEmpty(...)
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
163 my @cg = ();
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
164 while ($data_gears =~ /__code ([\w(\.)\*\s,]+?\)),?/g) {
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
165 push(@cg, $1);
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
166 }
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
167
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
168 if (@cg) {
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
169 if (@cg == 2) {
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
170 print $out " if (:TODO:) {\n";
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
171 print $out " goto ",shift(@cg),";\n";
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
172 print $out " }\n";
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
173 print $out " goto ",shift(@cg),";\n";
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
174 } else {
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
175 print $out " goto ",shift(@cg),";\n";
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
176 }
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
177 }
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
178 print $out "}\n\n";
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
179 }
2276952ed717 impl trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 559
diff changeset
180 }