1//===-- lib/Semantics/canonicalize-omp.cpp --------------------------------===//
2//
3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4// See https://llvm.org/LICENSE.txt for license information.
5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6//
7//===----------------------------------------------------------------------===//
8
9#include "canonicalize-omp.h"
10#include "flang/Parser/parse-tree-visitor.h"
11#include "flang/Parser/parse-tree.h"
12
13// After Loop Canonicalization, rewrite OpenMP parse tree to make OpenMP
14// Constructs more structured which provide explicit scopes for later
15// structural checks and semantic analysis.
16// 1. move structured DoConstruct and OmpEndLoopDirective into
17// OpenMPLoopConstruct. Compilation will not proceed in case of errors
18// after this pass.
19// 2. Associate declarative OMP allocation directives with their
20// respective executable allocation directive
21// 3. TBD
22namespace Fortran::semantics {
23
24using namespace parser::literals;
25
26class CanonicalizationOfOmp {
27public:
28 template <typename T> bool Pre(T &) { return true; }
29 template <typename T> void Post(T &) {}
30 CanonicalizationOfOmp(parser::Messages &messages) : messages_{messages} {}
31
32 void Post(parser::Block &block) {
33 for (auto it{block.begin()}; it != block.end(); ++it) {
34 if (auto *ompCons{GetConstructIf<parser::OpenMPConstruct>(*it)}) {
35 // OpenMPLoopConstruct
36 if (auto *ompLoop{
37 std::get_if<parser::OpenMPLoopConstruct>(&ompCons->u)}) {
38 RewriteOpenMPLoopConstruct(*ompLoop, block, it);
39 }
40 } else if (auto *endDir{
41 GetConstructIf<parser::OmpEndLoopDirective>(*it)}) {
42 // Unmatched OmpEndLoopDirective
43 auto &dir{std::get<parser::OmpLoopDirective>(endDir->t)};
44 messages_.Say(dir.source,
45 "The %s directive must follow the DO loop associated with the "
46 "loop construct"_err_en_US,
47 parser::ToUpperCaseLetters(dir.source.ToString()));
48 }
49 } // Block list
50 }
51
52 void Post(parser::ExecutionPart &body) { RewriteOmpAllocations(body); }
53
54 // Pre-visit all constructs that have both a specification part and
55 // an execution part, and store the connection between the two.
56 bool Pre(parser::BlockConstruct &x) {
57 auto *spec = &std::get<parser::BlockSpecificationPart>(x.t).v;
58 auto *block = &std::get<parser::Block>(x.t);
59 blockForSpec_.insert(std::make_pair(spec, block));
60 return true;
61 }
62 bool Pre(parser::MainProgram &x) {
63 auto *spec = &std::get<parser::SpecificationPart>(x.t);
64 auto *block = &std::get<parser::ExecutionPart>(x.t).v;
65 blockForSpec_.insert(std::make_pair(spec, block));
66 return true;
67 }
68 bool Pre(parser::FunctionSubprogram &x) {
69 auto *spec = &std::get<parser::SpecificationPart>(x.t);
70 auto *block = &std::get<parser::ExecutionPart>(x.t).v;
71 blockForSpec_.insert(std::make_pair(spec, block));
72 return true;
73 }
74 bool Pre(parser::SubroutineSubprogram &x) {
75 auto *spec = &std::get<parser::SpecificationPart>(x.t);
76 auto *block = &std::get<parser::ExecutionPart>(x.t).v;
77 blockForSpec_.insert(std::make_pair(spec, block));
78 return true;
79 }
80 bool Pre(parser::SeparateModuleSubprogram &x) {
81 auto *spec = &std::get<parser::SpecificationPart>(x.t);
82 auto *block = &std::get<parser::ExecutionPart>(x.t).v;
83 blockForSpec_.insert(std::make_pair(spec, block));
84 return true;
85 }
86
87 void Post(parser::SpecificationPart &spec) {
88 CanonicalizeUtilityConstructs(spec);
89 }
90
91private:
92 template <typename T> T *GetConstructIf(parser::ExecutionPartConstruct &x) {
93 if (auto *y{std::get_if<parser::ExecutableConstruct>(&x.u)}) {
94 if (auto *z{std::get_if<common::Indirection<T>>(&y->u)}) {
95 return &z->value();
96 }
97 }
98 return nullptr;
99 }
100
101 template <typename T> T *GetOmpIf(parser::ExecutionPartConstruct &x) {
102 if (auto *construct{GetConstructIf<parser::OpenMPConstruct>(x)}) {
103 if (auto *omp{std::get_if<T>(&construct->u)}) {
104 return omp;
105 }
106 }
107 return nullptr;
108 }
109
110 void RewriteOpenMPLoopConstruct(parser::OpenMPLoopConstruct &x,
111 parser::Block &block, parser::Block::iterator it) {
112 // Check the sequence of DoConstruct and OmpEndLoopDirective
113 // in the same iteration
114 //
115 // Original:
116 // ExecutableConstruct -> OpenMPConstruct -> OpenMPLoopConstruct
117 // OmpBeginLoopDirective
118 // ExecutableConstruct -> DoConstruct
119 // ExecutableConstruct -> OmpEndLoopDirective (if available)
120 //
121 // After rewriting:
122 // ExecutableConstruct -> OpenMPConstruct -> OpenMPLoopConstruct
123 // OmpBeginLoopDirective
124 // DoConstruct
125 // OmpEndLoopDirective (if available)
126 parser::Block::iterator nextIt;
127 auto &beginDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
128 auto &dir{std::get<parser::OmpLoopDirective>(beginDir.t)};
129 auto missingDoConstruct = [](auto &dir, auto &messages) {
130 messages.Say(dir.source,
131 "A DO loop must follow the %s directive"_err_en_US,
132 parser::ToUpperCaseLetters(dir.source.ToString()));
133 };
134 auto tileUnrollError = [](auto &dir, auto &messages) {
135 messages.Say(dir.source,
136 "If a loop construct has been fully unrolled, it cannot then be tiled"_err_en_US,
137 parser::ToUpperCaseLetters(dir.source.ToString()));
138 };
139
140 nextIt = it;
141 while (++nextIt != block.end()) {
142 // Ignore compiler directives.
143 if (GetConstructIf<parser::CompilerDirective>(*nextIt))
144 continue;
145
146 if (auto *doCons{GetConstructIf<parser::DoConstruct>(*nextIt)}) {
147 if (doCons->GetLoopControl()) {
148 // move DoConstruct
149 std::get<std::optional<std::variant<parser::DoConstruct,
150 common::Indirection<parser::OpenMPLoopConstruct>>>>(x.t) =
151 std::move(*doCons);
152 nextIt = block.erase(nextIt);
153 // try to match OmpEndLoopDirective
154 if (nextIt != block.end()) {
155 if (auto *endDir{
156 GetConstructIf<parser::OmpEndLoopDirective>(*nextIt)}) {
157 std::get<std::optional<parser::OmpEndLoopDirective>>(x.t) =
158 std::move(*endDir);
159 nextIt = block.erase(nextIt);
160 }
161 }
162 } else {
163 messages_.Say(dir.source,
164 "DO loop after the %s directive must have loop control"_err_en_US,
165 parser::ToUpperCaseLetters(dir.source.ToString()));
166 }
167 } else if (auto *ompLoopCons{
168 GetOmpIf<parser::OpenMPLoopConstruct>(*nextIt)}) {
169 // We should allow UNROLL and TILE constructs to be inserted between an
170 // OpenMP Loop Construct and the DO loop itself
171 auto &nestedBeginDirective =
172 std::get<parser::OmpBeginLoopDirective>(ompLoopCons->t);
173 auto &nestedBeginLoopDirective =
174 std::get<parser::OmpLoopDirective>(nestedBeginDirective.t);
175 if ((nestedBeginLoopDirective.v == llvm::omp::Directive::OMPD_unroll ||
176 nestedBeginLoopDirective.v ==
177 llvm::omp::Directive::OMPD_tile) &&
178 !(nestedBeginLoopDirective.v == llvm::omp::Directive::OMPD_unroll &&
179 dir.v == llvm::omp::Directive::OMPD_tile)) {
180 // iterate through the remaining block items to find the end directive
181 // for the unroll/tile directive.
182 parser::Block::iterator endIt;
183 endIt = nextIt;
184 while (endIt != block.end()) {
185 if (auto *endDir{
186 GetConstructIf<parser::OmpEndLoopDirective>(*endIt)}) {
187 auto &endLoopDirective =
188 std::get<parser::OmpLoopDirective>(endDir->t);
189 if (endLoopDirective.v == dir.v) {
190 std::get<std::optional<parser::OmpEndLoopDirective>>(x.t) =
191 std::move(*endDir);
192 endIt = block.erase(endIt);
193 continue;
194 }
195 }
196 ++endIt;
197 }
198 RewriteOpenMPLoopConstruct(*ompLoopCons, block, nextIt);
199 auto &ompLoop = std::get<std::optional<parser::NestedConstruct>>(x.t);
200 ompLoop =
201 std::optional<parser::NestedConstruct>{parser::NestedConstruct{
202 common::Indirection{std::move(*ompLoopCons)}}};
203 nextIt = block.erase(nextIt);
204 } else if (nestedBeginLoopDirective.v ==
205 llvm::omp::Directive::OMPD_unroll &&
206 dir.v == llvm::omp::Directive::OMPD_tile) {
207 // if a loop has been unrolled, the user can not then tile that loop
208 // as it has been unrolled
209 parser::OmpClauseList &unrollClauseList{
210 std::get<parser::OmpClauseList>(nestedBeginDirective.t)};
211 if (unrollClauseList.v.empty()) {
212 // if the clause list is empty for an unroll construct, we assume
213 // the loop is being fully unrolled
214 tileUnrollError(dir, messages_);
215 } else {
216 // parse the clauses for the unroll directive to find the full
217 // clause
218 for (auto clause{unrollClauseList.v.begin()};
219 clause != unrollClauseList.v.end(); ++clause) {
220 if (clause->Id() == llvm::omp::OMPC_full) {
221 tileUnrollError(dir, messages_);
222 }
223 }
224 }
225 } else {
226 messages_.Say(nestedBeginLoopDirective.source,
227 "Only Loop Transformation Constructs or Loop Nests can be nested within Loop Constructs"_err_en_US,
228 parser::ToUpperCaseLetters(
229 nestedBeginLoopDirective.source.ToString()));
230 }
231 } else {
232 missingDoConstruct(dir, messages_);
233 }
234 // If we get here, we either found a loop, or issued an error message.
235 return;
236 }
237 if (nextIt == block.end()) {
238 missingDoConstruct(dir, messages_);
239 }
240 }
241
242 void RewriteOmpAllocations(parser::ExecutionPart &body) {
243 // Rewrite leading declarative allocations so they are nested
244 // within their respective executable allocate directive
245 //
246 // Original:
247 // ExecutionPartConstruct -> OpenMPDeclarativeAllocate
248 // ExecutionPartConstruct -> OpenMPDeclarativeAllocate
249 // ExecutionPartConstruct -> OpenMPExecutableAllocate
250 //
251 // After rewriting:
252 // ExecutionPartConstruct -> OpenMPExecutableAllocate
253 // ExecutionPartConstruct -> OpenMPDeclarativeAllocate
254 // ExecutionPartConstruct -> OpenMPDeclarativeAllocate
255 for (auto it = body.v.rbegin(); it != body.v.rend();) {
256 if (auto *exec = GetOmpIf<parser::OpenMPExecutableAllocate>(*(it++))) {
257 parser::OpenMPDeclarativeAllocate *decl;
258 std::list<parser::OpenMPDeclarativeAllocate> subAllocates;
259 while (it != body.v.rend() &&
260 (decl = GetOmpIf<parser::OpenMPDeclarativeAllocate>(*it))) {
261 subAllocates.push_front(std::move(*decl));
262 it = decltype(it)(body.v.erase(std::next(it).base()));
263 }
264 if (!subAllocates.empty()) {
265 std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>(
266 exec->t) = {std::move(subAllocates)};
267 }
268 }
269 }
270 }
271
272 // Canonicalization of utility constructs.
273 //
274 // This addresses the issue of utility constructs that appear at the
275 // boundary between the specification and the execution parts, e.g.
276 // subroutine foo
277 // integer :: x ! Specification
278 // !$omp nothing
279 // x = 1 ! Execution
280 // ...
281 // end
282 //
283 // Utility constructs (error and nothing) can appear in both the
284 // specification part and the execution part, except "error at(execution)",
285 // which cannot be present in the specification part (whereas any utility
286 // construct can be in the execution part).
287 // When a utility construct is at the boundary, it should preferably be
288 // parsed as an element of the execution part, but since the specification
289 // part is parsed first, the utility construct ends up belonging to the
290 // specification part.
291 //
292 // To allow the likes of the following code to compile, move all utility
293 // construct that are at the end of the specification part to the beginning
294 // of the execution part.
295 //
296 // subroutine foo
297 // !$omp error at(execution) ! Initially parsed as declarative construct.
298 // ! Move it to the execution part.
299 // end
300
301 void CanonicalizeUtilityConstructs(parser::SpecificationPart &spec) {
302 auto found = blockForSpec_.find(&spec);
303 if (found == blockForSpec_.end()) {
304 // There is no corresponding execution part, so there is nothing to do.
305 return;
306 }
307 parser::Block &block = *found->second;
308
309 // There are two places where an OpenMP declarative construct can
310 // show up in the tuple in specification part:
311 // (1) in std::list<OpenMPDeclarativeConstruct>, or
312 // (2) in std::list<DeclarationConstruct>.
313 // The case (1) is only possible is the list (2) is empty.
314
315 auto &omps =
316 std::get<std::list<parser::OpenMPDeclarativeConstruct>>(spec.t);
317 auto &decls = std::get<std::list<parser::DeclarationConstruct>>(spec.t);
318
319 if (!decls.empty()) {
320 MoveUtilityConstructsFromDecls(decls, block);
321 } else {
322 MoveUtilityConstructsFromOmps(omps, block);
323 }
324 }
325
326 void MoveUtilityConstructsFromDecls(
327 std::list<parser::DeclarationConstruct> &decls, parser::Block &block) {
328 // Find the trailing range of DeclarationConstructs that are OpenMP
329 // utility construct, that are to be moved to the execution part.
330 std::list<parser::DeclarationConstruct>::reverse_iterator rlast = [&]() {
331 for (auto rit = decls.rbegin(), rend = decls.rend(); rit != rend; ++rit) {
332 parser::DeclarationConstruct &dc = *rit;
333 if (!std::holds_alternative<parser::SpecificationConstruct>(dc.u)) {
334 return rit;
335 }
336 auto &sc = std::get<parser::SpecificationConstruct>(dc.u);
337 using OpenMPDeclarativeConstruct =
338 common::Indirection<parser::OpenMPDeclarativeConstruct>;
339 if (!std::holds_alternative<OpenMPDeclarativeConstruct>(sc.u)) {
340 return rit;
341 }
342 // Got OpenMPDeclarativeConstruct. If it's not a utility construct
343 // then stop.
344 auto &odc = std::get<OpenMPDeclarativeConstruct>(sc.u).value();
345 if (!std::holds_alternative<parser::OpenMPUtilityConstruct>(odc.u)) {
346 return rit;
347 }
348 }
349 return decls.rend();
350 }();
351
352 std::transform(decls.rbegin(), rlast, std::front_inserter(block),
353 [](parser::DeclarationConstruct &dc) {
354 auto &sc = std::get<parser::SpecificationConstruct>(dc.u);
355 using OpenMPDeclarativeConstruct =
356 common::Indirection<parser::OpenMPDeclarativeConstruct>;
357 auto &oc = std::get<OpenMPDeclarativeConstruct>(sc.u).value();
358 auto &ut = std::get<parser::OpenMPUtilityConstruct>(oc.u);
359
360 return parser::ExecutionPartConstruct(parser::ExecutableConstruct(
361 common::Indirection(parser::OpenMPConstruct(std::move(ut)))));
362 });
363
364 decls.erase(rlast.base(), decls.end());
365 }
366
367 void MoveUtilityConstructsFromOmps(
368 std::list<parser::OpenMPDeclarativeConstruct> &omps,
369 parser::Block &block) {
370 using OpenMPDeclarativeConstruct = parser::OpenMPDeclarativeConstruct;
371 // Find the trailing range of OpenMPDeclarativeConstruct that are OpenMP
372 // utility construct, that are to be moved to the execution part.
373 std::list<OpenMPDeclarativeConstruct>::reverse_iterator rlast = [&]() {
374 for (auto rit = omps.rbegin(), rend = omps.rend(); rit != rend; ++rit) {
375 OpenMPDeclarativeConstruct &dc = *rit;
376 if (!std::holds_alternative<parser::OpenMPUtilityConstruct>(dc.u)) {
377 return rit;
378 }
379 }
380 return omps.rend();
381 }();
382
383 std::transform(omps.rbegin(), rlast, std::front_inserter(block),
384 [](parser::OpenMPDeclarativeConstruct &dc) {
385 auto &ut = std::get<parser::OpenMPUtilityConstruct>(dc.u);
386 return parser::ExecutionPartConstruct(parser::ExecutableConstruct(
387 common::Indirection(parser::OpenMPConstruct(std::move(ut)))));
388 });
389
390 omps.erase(rlast.base(), omps.end());
391 }
392
393 // Mapping from the specification parts to the blocks that follow in the
394 // same construct. This is for converting utility constructs to executable
395 // constructs.
396 std::map<parser::SpecificationPart *, parser::Block *> blockForSpec_;
397 parser::Messages &messages_;
398};
399
400bool CanonicalizeOmp(parser::Messages &messages, parser::Program &program) {
401 CanonicalizationOfOmp omp{messages};
402 Walk(program, omp);
403 return !messages.AnyFatalError();
404}
405} // namespace Fortran::semantics
406

source code of flang/lib/Semantics/canonicalize-omp.cpp