1//===-- lib/Semantics/canonicalize-acc.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-acc.h"
10#include "flang/Parser/parse-tree-visitor.h"
11#include "flang/Semantics/tools.h"
12
13// After Loop Canonicalization, rewrite OpenACC parse tree to make OpenACC
14// Constructs more structured which provide explicit scopes for later
15// structural checks and semantic analysis.
16// 1. move structured DoConstruct into
17// OpenACCLoopConstruct. Compilation will not proceed in case of errors
18// after this pass.
19// 2. move structured DoConstruct into OpenACCCombinedConstruct. Move
20// AccEndCombinedConstruct into OpenACCCombinedConstruct if present.
21// Compilation will not proceed in case of errors after this pass.
22namespace Fortran::semantics {
23
24using namespace parser::literals;
25
26class CanonicalizationOfAcc {
27public:
28 template <typename T> bool Pre(T &) { return true; }
29 template <typename T> void Post(T &) {}
30 CanonicalizationOfAcc(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 *accLoop{parser::Unwrap<parser::OpenACCLoopConstruct>(*it)}) {
35 RewriteOpenACCLoopConstruct(*accLoop, block, it);
36 } else if (auto *accCombined{
37 parser::Unwrap<parser::OpenACCCombinedConstruct>(*it)}) {
38 RewriteOpenACCCombinedConstruct(*accCombined, block, it);
39 } else if (auto *endDir{
40 parser::Unwrap<parser::AccEndCombinedDirective>(*it)}) {
41 // Unmatched AccEndCombinedDirective
42 messages_.Say(endDir->v.source,
43 "The %s directive must follow the DO loop associated with the "
44 "loop construct"_err_en_US,
45 parser::ToUpperCaseLetters(endDir->v.source.ToString()));
46 }
47 } // Block list
48 }
49
50private:
51 // Check constraint in 2.9.7
52 // If there are n tile sizes in the list, the loop construct must be
53 // immediately followed by n tightly-nested loops.
54 template <typename C, typename D>
55 void CheckTileClauseRestriction(
56 const C &x, const parser::DoConstruct &outer) {
57 const auto &beginLoopDirective = std::get<D>(x.t);
58 const auto &accClauseList =
59 std::get<parser::AccClauseList>(beginLoopDirective.t);
60 for (const auto &clause : accClauseList.v) {
61 if (const auto *tileClause =
62 std::get_if<parser::AccClause::Tile>(&clause.u)) {
63 const parser::AccTileExprList &tileExprList = tileClause->v;
64 const std::list<parser::AccTileExpr> &listTileExpr = tileExprList.v;
65 std::size_t tileArgNb = listTileExpr.size();
66
67 if (outer.IsDoConcurrent()) {
68 return; // Tile is not allowed on DO CONCURRENT
69 }
70 for (const parser::DoConstruct *loop{&outer}; loop && tileArgNb > 0;
71 --tileArgNb) {
72 const auto &block{std::get<parser::Block>(loop->t)};
73 const auto it{block.begin()};
74 loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
75 : nullptr;
76 }
77
78 if (tileArgNb > 0) {
79 messages_.Say(beginLoopDirective.source,
80 "The loop construct with the TILE clause must be followed by %d "
81 "tightly-nested loops"_err_en_US,
82 listTileExpr.size());
83 }
84 }
85 }
86 }
87
88 // Check constraint on line 1835 in Section 2.9
89 // A tile and collapse clause may not appear on loop that is associated with
90 // do concurrent.
91 template <typename C, typename D>
92 void CheckDoConcurrentClauseRestriction(
93 const C &x, const parser::DoConstruct &doCons) {
94 if (!doCons.IsDoConcurrent()) {
95 return;
96 }
97 const auto &beginLoopDirective = std::get<D>(x.t);
98 const auto &accClauseList =
99 std::get<parser::AccClauseList>(beginLoopDirective.t);
100 for (const auto &clause : accClauseList.v) {
101 if (std::holds_alternative<parser::AccClause::Collapse>(clause.u) ||
102 std::holds_alternative<parser::AccClause::Tile>(clause.u)) {
103 messages_.Say(beginLoopDirective.source,
104 "TILE and COLLAPSE clause may not appear on loop construct "
105 "associated with DO CONCURRENT"_err_en_US);
106 }
107 }
108 }
109
110 void RewriteOpenACCLoopConstruct(parser::OpenACCLoopConstruct &x,
111 parser::Block &block, parser::Block::iterator it) {
112 parser::Block::iterator nextIt;
113 auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
114 auto &dir{std::get<parser::AccLoopDirective>(beginDir.t)};
115 auto &nestedDo{std::get<std::optional<parser::DoConstruct>>(x.t)};
116
117 if (!nestedDo) {
118 nextIt = it;
119 if (++nextIt != block.end()) {
120 if (auto *doCons{parser::Unwrap<parser::DoConstruct>(*nextIt)}) {
121 nestedDo = std::move(*doCons);
122 nextIt = block.erase(nextIt);
123 }
124 }
125 }
126
127 if (nestedDo) {
128 if (!nestedDo->GetLoopControl()) {
129 messages_.Say(dir.source,
130 "DO loop after the %s directive must have loop control"_err_en_US,
131 parser::ToUpperCaseLetters(dir.source.ToString()));
132 return;
133 }
134 CheckDoConcurrentClauseRestriction<parser::OpenACCLoopConstruct,
135 parser::AccBeginLoopDirective>(x, *nestedDo);
136 CheckTileClauseRestriction<parser::OpenACCLoopConstruct,
137 parser::AccBeginLoopDirective>(x, *nestedDo);
138 return;
139 }
140 messages_.Say(dir.source,
141 "A DO loop must follow the %s directive"_err_en_US,
142 parser::ToUpperCaseLetters(dir.source.ToString()));
143 }
144
145 void RewriteOpenACCCombinedConstruct(parser::OpenACCCombinedConstruct &x,
146 parser::Block &block, parser::Block::iterator it) {
147 // Check the sequence of DoConstruct in the same iteration.
148 parser::Block::iterator nextIt;
149 auto &beginDir{std::get<parser::AccBeginCombinedDirective>(x.t)};
150 auto &dir{std::get<parser::AccCombinedDirective>(beginDir.t)};
151 auto &nestedDo{std::get<std::optional<parser::DoConstruct>>(x.t)};
152
153 if (!nestedDo) {
154 nextIt = it;
155 if (++nextIt != block.end()) {
156 if (auto *doCons{parser::Unwrap<parser::DoConstruct>(*nextIt)}) {
157 nestedDo = std::move(*doCons);
158 nextIt = block.erase(nextIt);
159 }
160 }
161 }
162
163 if (nestedDo) {
164 CheckDoConcurrentClauseRestriction<parser::OpenACCCombinedConstruct,
165 parser::AccBeginCombinedDirective>(x, *nestedDo);
166 CheckTileClauseRestriction<parser::OpenACCCombinedConstruct,
167 parser::AccBeginCombinedDirective>(x, *nestedDo);
168 if (!nestedDo->GetLoopControl()) {
169 messages_.Say(dir.source,
170 "DO loop after the %s directive must have loop control"_err_en_US,
171 parser::ToUpperCaseLetters(dir.source.ToString()));
172 return;
173 }
174 return;
175 }
176 messages_.Say(dir.source,
177 "A DO loop must follow the %s directive"_err_en_US,
178 parser::ToUpperCaseLetters(dir.source.ToString()));
179 }
180
181 parser::Messages &messages_;
182};
183
184bool CanonicalizeAcc(parser::Messages &messages, parser::Program &program) {
185 CanonicalizationOfAcc acc{messages};
186 Walk(program, acc);
187 return !messages.AnyFatalError();
188}
189} // namespace Fortran::semantics
190

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