line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# [[[ HEADER ]]] |
2
|
|
|
|
|
|
|
package RPerl::CompileUnit::Program; |
3
|
4
|
|
|
4
|
|
286
|
use strict; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
125
|
|
4
|
4
|
|
|
4
|
|
25
|
use warnings; |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
120
|
|
5
|
4
|
|
|
4
|
|
25
|
use RPerl::AfterSubclass; |
|
4
|
|
|
|
|
189
|
|
|
4
|
|
|
|
|
550
|
|
6
|
|
|
|
|
|
|
our $VERSION = 0.005_000; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
# [[[ OO INHERITANCE ]]] |
9
|
4
|
|
|
4
|
|
30
|
use parent qw(RPerl::CompileUnit); |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
24
|
|
10
|
4
|
|
|
4
|
|
216
|
use RPerl::CompileUnit; |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
7437
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# [[[ CRITICS ]]] |
13
|
|
|
|
|
|
|
## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls) # USER DEFAULT 1: allow numeric values & print operator |
14
|
|
|
|
|
|
|
## no critic qw(RequireInterpolationOfMetachars) # USER DEFAULT 2: allow single-quoted control characters & sigils |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# [[[ OO PROPERTIES ]]] |
17
|
|
|
|
|
|
|
our hashref $properties = {}; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# [[[ SUBROUTINES & OO METHODS ]]] |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our string_hashref::method $ast_to_rperl__generate = sub { |
22
|
|
|
|
|
|
|
( my object $self, my string_hashref $modes) = @_; |
23
|
|
|
|
|
|
|
my string_hashref $rperl_source_group = { PMC => q{} }; |
24
|
|
|
|
|
|
|
my string_hashref $rperl_source_subgroup; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# RPerl::diag( 'in Program->ast_to_rperl__generate(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" ); |
27
|
|
|
|
|
|
|
# RPerl::diag('in Program->ast_to_rperl__generate(), received $modes = ' . "\n" . Dumper($modes) . "\n"); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my string $self_class = ref $self; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# unwrap Program_18 from CompileUnit_4 |
32
|
|
|
|
|
|
|
if ( ($self_class) eq 'CompileUnit_4' ) { |
33
|
|
|
|
|
|
|
$self = $self->{children}->[0]; |
34
|
|
|
|
|
|
|
$self_class = ref $self; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
if ( ($self_class) ne 'Program_18' ) { |
38
|
|
|
|
|
|
|
die RPerl::Parser::rperl_rule__replace( |
39
|
|
|
|
|
|
|
'ERROR ECOGEASRP00, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Grammar rule ' . ($self_class) . ' found where Program_18 expected, dying' ) |
40
|
|
|
|
|
|
|
. "\n"; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# Program -> SHEBANG Critic? USE_RPERL Header Critic* Include* Constant* Subroutine* Operation+ |
44
|
|
|
|
|
|
|
my string $shebang = $self->{children}->[0]; |
45
|
|
|
|
|
|
|
my object $critic_optional = $self->{children}->[1]; |
46
|
|
|
|
|
|
|
my string $use_rperl = $self->{children}->[2]; # PERLOPS only |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# Header -> 'use strict;' 'use warnings;' USE_RPERL_AFTER? 'our' VERSION_NUMBER_ASSIGN; |
49
|
|
|
|
|
|
|
my object $header = $self->{children}->[3]; |
50
|
|
|
|
|
|
|
my string $use_strict = $header->{children}->[0]; # PERLOPS only |
51
|
|
|
|
|
|
|
my string $use_warnings = $header->{children}->[1]; # PERLOPS only |
52
|
|
|
|
|
|
|
my string $use_rperl_after_optional = $header->{children}->[2]; # PERLOPS only |
53
|
|
|
|
|
|
|
my string $our_keyword = $header->{children}->[3]; # PERLOPS only |
54
|
|
|
|
|
|
|
my string $version_number = $header->{children}->[4]; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
my object $critic_star = $self->{children}->[4]; |
57
|
|
|
|
|
|
|
my object $include_star = $self->{children}->[5]; |
58
|
|
|
|
|
|
|
my object $constant_star = $self->{children}->[6]; |
59
|
|
|
|
|
|
|
my object $subroutine_star = $self->{children}->[7]; |
60
|
|
|
|
|
|
|
my object $operation_plus = $self->{children}->[8]; |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
$rperl_source_group->{PMC} = $shebang; |
63
|
|
|
|
|
|
|
if ( ( exists $critic_optional->{children}->[0] ) and ( defined $critic_optional->{children}->[0] ) ) { |
64
|
|
|
|
|
|
|
$rperl_source_group->{PMC} .= q{ }; |
65
|
|
|
|
|
|
|
$rperl_source_subgroup = $critic_optional->{children}->[0]->ast_to_rperl__generate($modes); |
66
|
|
|
|
|
|
|
RPerl::Generator::source_group_append( $rperl_source_group, $rperl_source_subgroup ); |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
else { |
69
|
|
|
|
|
|
|
$rperl_source_group->{PMC} .= "\n"; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { |
73
|
|
|
|
|
|
|
$rperl_source_group->{PMC} .= '# [[[ HEADER ]]]' . "\n"; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
# DEV NOTE: now that 'use RPerl;' is a source filter, it is technically not part of the Header grammar rule, instead 'use RPerl::AfterSubclass;' is in Header; |
76
|
|
|
|
|
|
|
# nevertheless, we are treating 'use RPerl;' as part of the header in our RPerl application source code, so it appears under the '# [[[ HEADER ]]]' label |
77
|
|
|
|
|
|
|
# both here in RPerl::CompileUnit::Program, as well as in RPerl::CompileUnit::Module::Header |
78
|
|
|
|
|
|
|
$rperl_source_group->{PMC} .= $use_rperl . "\n"; |
79
|
|
|
|
|
|
|
$rperl_source_group->{PMC} .= $use_strict . "\n"; |
80
|
|
|
|
|
|
|
$rperl_source_group->{PMC} .= $use_warnings . "\n"; |
81
|
|
|
|
|
|
|
if ( ( exists $use_rperl_after_optional->{children}->[0] ) and ( defined $use_rperl_after_optional->{children}->[0] ) ) { |
82
|
|
|
|
|
|
|
$rperl_source_group->{PMC} .= $use_rperl_after_optional->{children}->[0]->{attr} . "\n"; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# DEV NOTE, CORRELATION #rp014: the hard-coded ' $VERSION = ' & ';' below are the only discarded tokens in the RPerl grammar, |
86
|
|
|
|
|
|
|
# due to the need to differentiate between v-numbers and otherwise-identical normal numbers |
87
|
|
|
|
|
|
|
$rperl_source_group->{PMC} .= $our_keyword . ' $VERSION = ' . $version_number . q{;} . "\n"; |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
if ( exists $critic_star->{children}->[0] ) { |
90
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { |
91
|
|
|
|
|
|
|
$rperl_source_group->{PMC} .= '# [[[ CRITICS ]]]' . "\n"; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
foreach my object $critic ( @{ $critic_star->{children} } ) { |
95
|
|
|
|
|
|
|
$rperl_source_subgroup = $critic->ast_to_rperl__generate($modes); |
96
|
|
|
|
|
|
|
RPerl::Generator::source_group_append( $rperl_source_group, $rperl_source_subgroup ); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
if ( exists $include_star->{children}->[0] ) { |
100
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { |
101
|
|
|
|
|
|
|
$rperl_source_group->{PMC} .= "\n" . '# [[[ INCLUDES ]]]' . "\n"; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
foreach my object $include ( @{ $include_star->{children} } ) { ## no critic qw(ProhibitPostfixControls) # SYSTEM SPECIAL 6: PERL CRITIC FILED ISSUE #639, not postfix foreach or if |
105
|
|
|
|
|
|
|
$rperl_source_subgroup = $include->ast_to_rperl__generate($modes); |
106
|
|
|
|
|
|
|
RPerl::Generator::source_group_append( $rperl_source_group, $rperl_source_subgroup ); |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
if ( exists $constant_star->{children}->[0] ) { |
110
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { |
111
|
|
|
|
|
|
|
$rperl_source_group->{PMC} .= "\n" . '# [[[ CONSTANTS ]]]' . "\n"; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
foreach my object $constant ( @{ $constant_star->{children} } ) { ## no critic qw(ProhibitPostfixControls) # SYSTEM SPECIAL 6: PERL CRITIC FILED ISSUE #639, not postfix foreach or if |
115
|
|
|
|
|
|
|
$rperl_source_subgroup = $constant->ast_to_rperl__generate($modes); |
116
|
|
|
|
|
|
|
RPerl::Generator::source_group_append( $rperl_source_group, $rperl_source_subgroup ); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
if ( exists $subroutine_star->{children}->[0] ) { |
120
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { |
121
|
|
|
|
|
|
|
$rperl_source_group->{PMC} .= "\n" . '# [[[ SUBROUTINES ]]]' . "\n"; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
foreach my object $subroutine ( ## no critic qw(ProhibitPostfixControls) # SYSTEM SPECIAL 6: PERL CRITIC FILED ISSUE #639, not postfix foreach or if |
125
|
|
|
|
|
|
|
@{ $subroutine_star->{children} } |
126
|
|
|
|
|
|
|
) |
127
|
|
|
|
|
|
|
{ |
128
|
|
|
|
|
|
|
$rperl_source_subgroup = $subroutine->ast_to_rperl__generate($modes); |
129
|
|
|
|
|
|
|
RPerl::Generator::source_group_append( $rperl_source_group, $rperl_source_subgroup ); |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { |
133
|
|
|
|
|
|
|
$rperl_source_group->{PMC} .= "\n" . '# [[[ OPERATIONS ]]]' . "\n"; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
foreach my object $operation ( ## no critic qw(ProhibitPostfixControls) # SYSTEM SPECIAL 6: PERL CRITIC FILED ISSUE #639, not postfix foreach or if |
136
|
|
|
|
|
|
|
@{ $operation_plus->{children} } |
137
|
|
|
|
|
|
|
) |
138
|
|
|
|
|
|
|
{ |
139
|
|
|
|
|
|
|
$rperl_source_subgroup = $operation->ast_to_rperl__generate($modes); |
140
|
|
|
|
|
|
|
RPerl::Generator::source_group_append( $rperl_source_group, $rperl_source_subgroup ); |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# Programs only generate EXE output, not PMC output |
144
|
|
|
|
|
|
|
$rperl_source_group->{EXE} = $rperl_source_group->{PMC}; |
145
|
|
|
|
|
|
|
delete $rperl_source_group->{PMC}; |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
return $rperl_source_group; |
148
|
|
|
|
|
|
|
}; |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
our string_hashref::method $ast_to_cpp__generate__CPPOPS_PERLTYPES = sub { |
152
|
|
|
|
|
|
|
( my object $self, my string_hashref $modes) = @_; |
153
|
|
|
|
|
|
|
my string_hashref $cpp_source_group = { |
154
|
|
|
|
|
|
|
CPP => q{// <<< RP::CU::P __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>} . "\n", |
155
|
|
|
|
|
|
|
H => q{// <<< RP::CU::P __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>} . "\n", |
156
|
|
|
|
|
|
|
PMC => q{# <<< RP::CU::P __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>} . "\n", |
157
|
|
|
|
|
|
|
EXE => q{// <<< RP::CU::P __DUMMY_SOURCE_CODE CPPOPS_PERLTYPES >>>} . "\n" |
158
|
|
|
|
|
|
|
}; |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
#... |
161
|
|
|
|
|
|
|
return $cpp_source_group; |
162
|
|
|
|
|
|
|
}; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
our string_hashref::method $ast_to_cpp__generate__CPPOPS_CPPTYPES = sub { |
166
|
|
|
|
|
|
|
( my object $self, my string_hashref $modes) = @_; |
167
|
|
|
|
|
|
|
my string_hashref $cpp_source_group = { CPP => q{} }; |
168
|
|
|
|
|
|
|
my string_hashref $cpp_source_subgroup; |
169
|
|
|
|
|
|
|
my integer $cpp_source_group_CPP_line_count = 0; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
# RPerl::diag( 'in Program->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $self = ' . "\n" . RPerl::Parser::rperl_ast__dump($self) . "\n" ); |
172
|
|
|
|
|
|
|
# RPerl::diag('in Program->ast_to_cpp__generate__CPPOPS_CPPTYPES(), received $modes = ' . "\n" . Dumper($modes) . "\n"); |
173
|
|
|
|
|
|
|
# die 'TMP DEBUG'; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
my string $self_class = ref $self; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# unwrap Program_18 from CompileUnit_4 |
178
|
|
|
|
|
|
|
if ( ($self_class) eq 'CompileUnit_4' ) { |
179
|
|
|
|
|
|
|
$self = $self->{children}->[0]; |
180
|
|
|
|
|
|
|
$self_class = ref $self; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
if ( ($self_class) ne 'Program_18' ) { |
184
|
|
|
|
|
|
|
die RPerl::Parser::rperl_rule__replace( |
185
|
|
|
|
|
|
|
'ERROR ECOGEASRP00, CODE GENERATOR, ABSTRACT SYNTAX TO RPERL: Grammar rule ' . ($self_class) . ' found where Program_18 expected, dying' ) |
186
|
|
|
|
|
|
|
. "\n"; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# Program -> SHEBANG Critic? USE_RPERL Header Critic* Include* Constant* Subroutine* Operation+ |
190
|
|
|
|
|
|
|
my string $shebang = $self->{children}->[0]; |
191
|
|
|
|
|
|
|
my object $critic_optional = $self->{children}->[1]; |
192
|
|
|
|
|
|
|
my string $use_rperl = $self->{children}->[2]; # PERLOPS only |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
# Header -> 'use strict;' 'use warnings;' USE_RPERL_AFTER? 'our' VERSION_NUMBER_ASSIGN; |
195
|
|
|
|
|
|
|
my object $header = $self->{children}->[3]; |
196
|
|
|
|
|
|
|
my string $use_strict = $header->{children}->[0]; # PERLOPS only |
197
|
|
|
|
|
|
|
my string $use_warnings = $header->{children}->[1]; # PERLOPS only |
198
|
|
|
|
|
|
|
my string $use_rperl_after_optional = $header->{children}->[2]; # PERLOPS only |
199
|
|
|
|
|
|
|
my string $our_keyword = $header->{children}->[3]; # PERLOPS only |
200
|
|
|
|
|
|
|
my string $version_number = $header->{children}->[4]; |
201
|
|
|
|
|
|
|
my integer $header_line_number = $header->{line_number}; |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
my object $critic_star = $self->{children}->[4]; |
204
|
|
|
|
|
|
|
my object $include_star = $self->{children}->[5]; |
205
|
|
|
|
|
|
|
my object $constant_star = $self->{children}->[6]; |
206
|
|
|
|
|
|
|
my object $subroutine_star = $self->{children}->[7]; |
207
|
|
|
|
|
|
|
my object $operation_plus = $self->{children}->[8]; |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# RPerl::diag('in Program->ast_to_cpp__generate__CPPOPS_CPPTYPES(), have $subroutine_star = ' . "\n" . RPerl::Parser::rperl_ast__dump($subroutine_star) . "\n"); |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# NEED ANSWER: should we modify the user-provided shebang as done here, or simply replace it with a hard-coded one pointing to /usr/bin? //!/usr/bin/rperl |
212
|
|
|
|
|
|
|
substr $shebang, 0, 2, '//!'; |
213
|
|
|
|
|
|
|
substr $shebang, -4, 4, 'rperl'; |
214
|
|
|
|
|
|
|
$cpp_source_group->{CPP} = $shebang . "\n"; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { |
217
|
|
|
|
|
|
|
if ($header_line_number > 6) { |
218
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= "\n" x ($header_line_number - 6); |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= '// [[[ HEADER ]]]' . "\n"; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= '#include <rperlstandalone.h>' . "\n"; |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
my string $file_name_underscores = $modes->{_input_file_name}; |
225
|
|
|
|
|
|
|
# $file_name_underscores =~ s/^[\/\\.]*//gxms; # remove leading forward slashes, back slashes, and dots |
226
|
|
|
|
|
|
|
substr $file_name_underscores, -3, 3, q{}; # remove trailing '.pl' |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
$file_name_underscores = RPerl::Compiler::post_processor_cpp__header_or_cpp_path('__NEED_CPP_PATH', $file_name_underscores); |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
$file_name_underscores =~ s/[\/\\]/__/gxms; # replace forward slashes and back slashes with double-underscores |
231
|
|
|
|
|
|
|
$file_name_underscores =~ s/[.-]/_/gxms; # replace dots and hyphens with underscores |
232
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= '#ifndef __CPP__INCLUDED__' . $file_name_underscores . '_cpp' . "\n"; |
233
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= '#define __CPP__INCLUDED__' . $file_name_underscores . '_cpp ' . $version_number . "\n"; |
234
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= '# ifdef __CPP__TYPES' . "\n"; |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
if (( exists $critic_star->{children}->[0] ) and ( $modes->{label} eq 'ON' )) { |
237
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= "\n" x (scalar @{ $critic_star->{children} }); # insert one blank line for each Critic |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
if ( exists $include_star->{children}->[0] ) { |
241
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { |
242
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= "\n" . '// [[[ INCLUDES ]]]' . "\n"; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
foreach my object $include ( @{ $include_star->{children} } ) { ## no critic qw(ProhibitPostfixControls) # SYSTEM SPECIAL 6: PERL CRITIC FILED ISSUE #639, not postfix foreach or if |
246
|
|
|
|
|
|
|
$cpp_source_subgroup = $include->ast_to_cpp__generate__CPPOPS_CPPTYPES($modes); |
247
|
|
|
|
|
|
|
RPerl::Generator::source_group_append( $cpp_source_group, $cpp_source_subgroup ); |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
if ( exists $constant_star->{children}->[0] ) { |
251
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { |
252
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= "\n" . '// [[[ CONSTANTS ]]]' . "\n"; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
foreach my object $constant ( @{ $constant_star->{children} } ) { ## no critic qw(ProhibitPostfixControls) # SYSTEM SPECIAL 6: PERL CRITIC FILED ISSUE #639, not postfix foreach or if |
256
|
|
|
|
|
|
|
$cpp_source_subgroup = $constant->ast_to_cpp__generate__CPPOPS_CPPTYPES($modes); |
257
|
|
|
|
|
|
|
RPerl::Generator::source_group_append( $cpp_source_group, $cpp_source_subgroup ); |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
if ( exists $subroutine_star->{children}->[0] ) { |
261
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { |
262
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= "\n" . '// [[[ SUBROUTINES ]]]' . "\n"; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
foreach my object $subroutine ( ## no critic qw(ProhibitPostfixControls) # SYSTEM SPECIAL 6: PERL CRITIC FILED ISSUE #639, not postfix foreach or if |
266
|
|
|
|
|
|
|
@{ $subroutine_star->{children} } |
267
|
|
|
|
|
|
|
) |
268
|
|
|
|
|
|
|
{ |
269
|
|
|
|
|
|
|
$cpp_source_subgroup = $subroutine->ast_to_cpp__generate__CPPOPS_CPPTYPES($modes); |
270
|
|
|
|
|
|
|
RPerl::Generator::source_group_append( $cpp_source_group, $cpp_source_subgroup ); |
271
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= "\n\n"; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# BEGIN C++ main() function wrapper, to contain all operations which are not inside a subroutine |
275
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= 'int main() {'; |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { |
278
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= "\n" . ' // [[[ OPERATIONS HEADER ]]]' . "\n"; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
my string $CPP_saved = $cpp_source_group->{CPP}; |
282
|
|
|
|
|
|
|
$cpp_source_group->{CPP} = q{}; |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { |
285
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= "\n" . '// [[[ OPERATIONS ]]]' . "\n"; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
foreach my object $operation ( ## no critic qw(ProhibitPostfixControls) # SYSTEM SPECIAL 6: PERL CRITIC FILED ISSUE #639, not postfix foreach or if |
289
|
|
|
|
|
|
|
@{ $operation_plus->{children} } |
290
|
|
|
|
|
|
|
) |
291
|
|
|
|
|
|
|
{ |
292
|
|
|
|
|
|
|
$cpp_source_subgroup = $operation->ast_to_cpp__generate__CPPOPS_CPPTYPES($modes); |
293
|
|
|
|
|
|
|
# RPerl::diag('in Program->ast_to_cpp__generate__CPPOPS_CPPTYPES(), have $cpp_source_subgroup = ' . "\n" . RPerl::Parser::rperl_ast__dump($cpp_source_subgroup) . "\n"); |
294
|
|
|
|
|
|
|
RPerl::Generator::source_group_append( $cpp_source_group, $cpp_source_subgroup ); |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
my integer $num_loop_iterators = 0; |
298
|
|
|
|
|
|
|
if ((exists $modes->{_loop_iterators}) and (defined $modes->{_loop_iterators})) { |
299
|
|
|
|
|
|
|
$num_loop_iterators = scalar keys %{$modes->{_loop_iterators}}; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
# COMPILE-TIME OPTIMIZATION #02: declare all loop iterators at top of subroutine/method to avoid re-declarations in nested loops |
303
|
|
|
|
|
|
|
# if ((exists $modes->{_loop_iterators}) and (defined $modes->{_loop_iterators})) { |
304
|
|
|
|
|
|
|
if ($num_loop_iterators) { # shortcut |
305
|
|
|
|
|
|
|
foreach my string $loop_iterator_symbol (sort keys %{$modes->{_loop_iterators}}) { |
306
|
|
|
|
|
|
|
$CPP_saved .= $modes->{_loop_iterators}->{$loop_iterator_symbol} . q{ } . $loop_iterator_symbol . ';' . "\n"; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
delete $modes->{_loop_iterators}; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
$cpp_source_group_CPP_line_count = ($cpp_source_group->{CPP} =~ tr/\n//) + 1; # add 1 to count last line which does not have newline |
312
|
|
|
|
|
|
|
my integer $operations_line_number = $operation_plus->{children}->[0]->{line_number}; |
313
|
|
|
|
|
|
|
# RPerl::diag('in Program->ast_to_cpp__generate__CPPOPS_CPPTYPES(), have $cpp_source_group_CPP_line_count = ' . $cpp_source_group_CPP_line_count . "\n"); |
314
|
|
|
|
|
|
|
# RPerl::diag('in Program->ast_to_cpp__generate__CPPOPS_CPPTYPES(), have $operations_line_number = ' . $operations_line_number . "\n"); |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { |
317
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= "\n" x (($operations_line_number - $cpp_source_group_CPP_line_count) - (2 + $num_loop_iterators)); |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
$CPP_saved .= $cpp_source_group->{CPP}; |
321
|
|
|
|
|
|
|
$cpp_source_group->{CPP} = $CPP_saved; |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { $cpp_source_group->{CPP} .= "\n" x 3; } |
324
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { $cpp_source_group->{CPP} .= ' // [[[ OPERATIONS FOOTER ]]]' . "\n"; } |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
# END C++ main() function wrapper |
327
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= ' return 0;' . "\n" . '}' . "\n\n"; |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
if ( $modes->{label} eq 'ON' ) { $cpp_source_group->{CPP} .= '// [[[ FOOTER ]]]' . "\n"; } |
330
|
|
|
|
|
|
|
$cpp_source_group->{CPP} .= <<EOF; |
331
|
|
|
|
|
|
|
# elif defined __PERL__TYPES |
332
|
|
|
|
|
|
|
Purposefully_die_from_a_compile-time_error,_due_to____PERL__TYPES_being_defined.__We_need_to_define_only___CPP__TYPES_in_this_file! |
333
|
|
|
|
|
|
|
# endif |
334
|
|
|
|
|
|
|
#endif |
335
|
|
|
|
|
|
|
EOF |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
return $cpp_source_group; |
338
|
|
|
|
|
|
|
}; |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
1; # end of class |