1//===-- lib/Semantics/openmp-utils.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// Common utilities used in OpenMP semantic checks.
10//
11//===----------------------------------------------------------------------===//
12
13#include "openmp-utils.h"
14
15#include "flang/Common/indirection.h"
16#include "flang/Common/reference.h"
17#include "flang/Common/visit.h"
18#include "flang/Evaluate/check-expression.h"
19#include "flang/Evaluate/expression.h"
20#include "flang/Evaluate/tools.h"
21#include "flang/Evaluate/traverse.h"
22#include "flang/Evaluate/type.h"
23#include "flang/Evaluate/variable.h"
24#include "flang/Parser/parse-tree.h"
25#include "flang/Semantics/expression.h"
26#include "flang/Semantics/semantics.h"
27
28#include "llvm/ADT/ArrayRef.h"
29#include "llvm/ADT/STLExtras.h"
30
31#include <optional>
32#include <string>
33#include <tuple>
34#include <type_traits>
35#include <utility>
36#include <variant>
37#include <vector>
38
39namespace Fortran::semantics::omp {
40
41SourcedActionStmt GetActionStmt(const parser::ExecutionPartConstruct *x) {
42 if (x == nullptr) {
43 return SourcedActionStmt{};
44 }
45 if (auto *exec{std::get_if<parser::ExecutableConstruct>(&x->u)}) {
46 using ActionStmt = parser::Statement<parser::ActionStmt>;
47 if (auto *stmt{std::get_if<ActionStmt>(&exec->u)}) {
48 return SourcedActionStmt{&stmt->statement, stmt->source};
49 }
50 }
51 return SourcedActionStmt{};
52}
53
54SourcedActionStmt GetActionStmt(const parser::Block &block) {
55 if (block.size() == 1) {
56 return GetActionStmt(&block.front());
57 }
58 return SourcedActionStmt{};
59}
60
61std::string ThisVersion(unsigned version) {
62 std::string tv{
63 std::to_string(val: version / 10) + "." + std::to_string(val: version % 10)};
64 return "OpenMP v" + tv;
65}
66
67std::string TryVersion(unsigned version) {
68 return "try -fopenmp-version=" + std::to_string(val: version);
69}
70
71const parser::Designator *GetDesignatorFromObj(
72 const parser::OmpObject &object) {
73 return std::get_if<parser::Designator>(&object.u);
74}
75
76const parser::DataRef *GetDataRefFromObj(const parser::OmpObject &object) {
77 if (auto *desg{GetDesignatorFromObj(object)}) {
78 return std::get_if<parser::DataRef>(&desg->u);
79 }
80 return nullptr;
81}
82
83const parser::ArrayElement *GetArrayElementFromObj(
84 const parser::OmpObject &object) {
85 if (auto *dataRef{GetDataRefFromObj(object)}) {
86 using ElementIndirection = common::Indirection<parser::ArrayElement>;
87 if (auto *ind{std::get_if<ElementIndirection>(&dataRef->u)}) {
88 return &ind->value();
89 }
90 }
91 return nullptr;
92}
93
94const Symbol *GetObjectSymbol(const parser::OmpObject &object) {
95 // Some symbols may be missing if the resolution failed, e.g. when an
96 // undeclared name is used with implicit none.
97 if (auto *name{std::get_if<parser::Name>(&object.u)}) {
98 return name->symbol ? &name->symbol->GetUltimate() : nullptr;
99 } else if (auto *desg{std::get_if<parser::Designator>(&object.u)}) {
100 auto &last{GetLastName(*desg)};
101 return last.symbol ? &GetLastName(*desg).symbol->GetUltimate() : nullptr;
102 }
103 return nullptr;
104}
105
106const Symbol *GetArgumentSymbol(const parser::OmpArgument &argument) {
107 if (auto *locator{std::get_if<parser::OmpLocator>(&argument.u)}) {
108 if (auto *object{std::get_if<parser::OmpObject>(&locator->u)}) {
109 return GetObjectSymbol(*object);
110 }
111 }
112 return nullptr;
113}
114
115std::optional<parser::CharBlock> GetObjectSource(
116 const parser::OmpObject &object) {
117 if (auto *name{std::get_if<parser::Name>(&object.u)}) {
118 return name->source;
119 } else if (auto *desg{std::get_if<parser::Designator>(&object.u)}) {
120 return GetLastName(*desg).source;
121 }
122 return std::nullopt;
123}
124
125bool IsCommonBlock(const Symbol &sym) {
126 return sym.detailsIf<CommonBlockDetails>() != nullptr;
127}
128
129bool IsVariableListItem(const Symbol &sym) {
130 return evaluate::IsVariable(sym) || sym.attrs().test(Attr::POINTER);
131}
132
133bool IsExtendedListItem(const Symbol &sym) {
134 return IsVariableListItem(sym) || sym.IsSubprogram();
135}
136
137bool IsVarOrFunctionRef(const MaybeExpr &expr) {
138 if (expr) {
139 return evaluate::UnwrapProcedureRef(*expr) != nullptr ||
140 evaluate::IsVariable(*expr);
141 } else {
142 return false;
143 }
144}
145
146std::optional<SomeExpr> GetEvaluateExpr(const parser::Expr &parserExpr) {
147 const parser::TypedExpr &typedExpr{parserExpr.typedExpr};
148 // ForwardOwningPointer typedExpr
149 // `- GenericExprWrapper ^.get()
150 // `- std::optional<Expr> ^->v
151 return typedExpr.get()->v;
152}
153
154std::optional<evaluate::DynamicType> GetDynamicType(
155 const parser::Expr &parserExpr) {
156 if (auto maybeExpr{GetEvaluateExpr(parserExpr)}) {
157 return maybeExpr->GetType();
158 } else {
159 return std::nullopt;
160 }
161}
162
163namespace {
164struct ContiguousHelper {
165 ContiguousHelper(SemanticsContext &context)
166 : fctx_(context.foldingContext()) {}
167
168 template <typename Contained>
169 std::optional<bool> Visit(const common::Indirection<Contained> &x) {
170 return Visit(x.value());
171 }
172 template <typename Contained>
173 std::optional<bool> Visit(const common::Reference<Contained> &x) {
174 return Visit(x.get());
175 }
176 template <typename T> std::optional<bool> Visit(const evaluate::Expr<T> &x) {
177 return common::visit([&](auto &&s) { return Visit(s); }, x.u);
178 }
179 template <typename T>
180 std::optional<bool> Visit(const evaluate::Designator<T> &x) {
181 return common::visit(
182 [this](auto &&s) { return evaluate::IsContiguous(s, fctx_); }, x.u);
183 }
184 template <typename T> std::optional<bool> Visit(const T &) {
185 // Everything else.
186 return std::nullopt;
187 }
188
189private:
190 evaluate::FoldingContext &fctx_;
191};
192} // namespace
193
194// Return values:
195// - std::optional<bool>{true} if the object is known to be contiguous
196// - std::optional<bool>{false} if the object is known not to be contiguous
197// - std::nullopt if the object contiguity cannot be determined
198std::optional<bool> IsContiguous(
199 SemanticsContext &semaCtx, const parser::OmpObject &object) {
200 return common::visit( //
201 common::visitors{
202 [&](const parser::Name &x) {
203 // Any member of a common block must be contiguous.
204 return std::optional<bool>{true};
205 },
206 [&](const parser::Designator &x) {
207 evaluate::ExpressionAnalyzer ea{semaCtx};
208 if (MaybeExpr maybeExpr{ea.Analyze(x)}) {
209 return ContiguousHelper{semaCtx}.Visit(*maybeExpr);
210 }
211 return std::optional<bool>{};
212 },
213 },
214 object.u);
215}
216
217struct DesignatorCollector : public evaluate::Traverse<DesignatorCollector,
218 std::vector<SomeExpr>, false> {
219 using Result = std::vector<SomeExpr>;
220 using Base = evaluate::Traverse<DesignatorCollector, Result, false>;
221 DesignatorCollector() : Base(*this) {}
222
223 Result Default() const { return {}; }
224
225 using Base::operator();
226
227 template <typename T> //
228 Result operator()(const evaluate::Designator<T> &x) const {
229 // Once in a designator, don't traverse it any further (i.e. only
230 // collect top-level designators).
231 auto copy{x};
232 return Result{AsGenericExpr(std::move(copy))};
233 }
234
235 template <typename... Rs> //
236 Result Combine(Result &&result, Rs &&...results) const {
237 Result v(std::move(result));
238 auto moveAppend{[](auto &accum, auto &&other) {
239 for (auto &&s : other) {
240 accum.push_back(std::move(s));
241 }
242 }};
243 (moveAppend(v, std::move(results)), ...);
244 return v;
245 }
246};
247
248struct VariableFinder : public evaluate::AnyTraverse<VariableFinder> {
249 using Base = evaluate::AnyTraverse<VariableFinder>;
250 VariableFinder(const SomeExpr &v) : Base(*this), var(v) {}
251
252 using Base::operator();
253
254 template <typename T>
255 bool operator()(const evaluate::Designator<T> &x) const {
256 auto copy{x};
257 return evaluate::AsGenericExpr(std::move(copy)) == var;
258 }
259
260 template <typename T>
261 bool operator()(const evaluate::FunctionRef<T> &x) const {
262 auto copy{x};
263 return evaluate::AsGenericExpr(std::move(copy)) == var;
264 }
265
266private:
267 const SomeExpr &var;
268};
269
270std::vector<SomeExpr> GetAllDesignators(const SomeExpr &expr) {
271 return DesignatorCollector{}(expr);
272}
273
274static bool HasCommonDesignatorSymbols(
275 const evaluate::SymbolVector &baseSyms, const SomeExpr &other) {
276 // Compare the designators used in "other" with the designators whose
277 // symbols are given in baseSyms.
278 // This is a part of the check if these two expressions can access the same
279 // storage: if the designators used in them are different enough, then they
280 // will be assumed not to access the same memory.
281 //
282 // Consider an (array element) expression x%y(w%z), the corresponding symbol
283 // vector will be {x, y, w, z} (i.e. the symbols for these names).
284 // Check whether this exact sequence appears anywhere in any the symbol
285 // vector for "other". This will be true for x(y) and x(y+1), so this is
286 // not a sufficient condition, but can be used to eliminate candidates
287 // before doing more exhaustive checks.
288 //
289 // If any of the symbols in this sequence are function names, assume that
290 // there is no storage overlap, mostly because it would be impossible in
291 // general to determine what storage the function will access.
292 // Note: if f is pure, then two calls to f will access the same storage
293 // when called with the same arguments. This check is not done yet.
294
295 if (llvm::any_of(
296 baseSyms, [](const SymbolRef &s) { return s->IsSubprogram(); })) {
297 // If there is a function symbol in the chain then we can't infer much
298 // about the accessed storage.
299 return false;
300 }
301
302 auto isSubsequence{// Is u a subsequence of v.
303 [](const evaluate::SymbolVector &u, const evaluate::SymbolVector &v) {
304 size_t us{u.size()}, vs{v.size()};
305 if (us > vs) {
306 return false;
307 }
308 for (size_t off{0}; off != vs - us + 1; ++off) {
309 bool same{true};
310 for (size_t i{0}; i != us; ++i) {
311 if (u[i] != v[off + i]) {
312 same = false;
313 break;
314 }
315 }
316 if (same) {
317 return true;
318 }
319 }
320 return false;
321 }};
322
323 evaluate::SymbolVector otherSyms{evaluate::GetSymbolVector(other)};
324 return isSubsequence(baseSyms, otherSyms);
325}
326
327static bool HasCommonTopLevelDesignators(
328 const std::vector<SomeExpr> &baseDsgs, const SomeExpr &other) {
329 // Compare designators directly as expressions. This will ensure
330 // that x(y) and x(y+1) are not flagged as overlapping, whereas
331 // the symbol vectors for both of these would be identical.
332 std::vector<SomeExpr> otherDsgs{GetAllDesignators(other)};
333
334 for (auto &s : baseDsgs) {
335 if (llvm::any_of(otherDsgs, [&](auto &&t) { return s == t; })) {
336 return true;
337 }
338 }
339 return false;
340}
341
342const SomeExpr *HasStorageOverlap(
343 const SomeExpr &base, llvm::ArrayRef<SomeExpr> exprs) {
344 evaluate::SymbolVector baseSyms{evaluate::GetSymbolVector(base)};
345 std::vector<SomeExpr> baseDsgs{GetAllDesignators(base)};
346
347 for (const SomeExpr &expr : exprs) {
348 if (!HasCommonDesignatorSymbols(baseSyms, expr)) {
349 continue;
350 }
351 if (HasCommonTopLevelDesignators(baseDsgs, expr)) {
352 return &expr;
353 }
354 }
355 return nullptr;
356}
357
358bool IsSubexpressionOf(const SomeExpr &sub, const SomeExpr &super) {
359 return VariableFinder{sub}(super);
360}
361
362// Check if the ActionStmt is actually a [Pointer]AssignmentStmt. This is
363// to separate cases where the source has something that looks like an
364// assignment, but is semantically wrong (diagnosed by general semantic
365// checks), and where the source has some other statement (which we want
366// to report as "should be an assignment").
367bool IsAssignment(const parser::ActionStmt *x) {
368 if (x == nullptr) {
369 return false;
370 }
371
372 using AssignmentStmt = common::Indirection<parser::AssignmentStmt>;
373 using PointerAssignmentStmt =
374 common::Indirection<parser::PointerAssignmentStmt>;
375
376 return common::visit(
377 [](auto &&s) -> bool {
378 using BareS = llvm::remove_cvref_t<decltype(s)>;
379 return std::is_same_v<BareS, AssignmentStmt> ||
380 std::is_same_v<BareS, PointerAssignmentStmt>;
381 },
382 x->u);
383}
384
385bool IsPointerAssignment(const evaluate::Assignment &x) {
386 return std::holds_alternative<evaluate::Assignment::BoundsSpec>(x.u) ||
387 std::holds_alternative<evaluate::Assignment::BoundsRemapping>(x.u);
388}
389
390/// parser::Block is a list of executable constructs, parser::BlockConstruct
391/// is Fortran's BLOCK/ENDBLOCK construct.
392/// Strip the outermost BlockConstructs, return the reference to the Block
393/// in the executable part of the innermost of the stripped constructs.
394/// Specifically, if the given `block` has a single entry (it's a list), and
395/// the entry is a BlockConstruct, get the Block contained within. Repeat
396/// this step as many times as possible.
397const parser::Block &GetInnermostExecPart(const parser::Block &block) {
398 const parser::Block *iter{&block};
399 while (iter->size() == 1) {
400 const parser::ExecutionPartConstruct &ep{iter->front()};
401 if (auto *exec{std::get_if<parser::ExecutableConstruct>(&ep.u)}) {
402 using BlockConstruct = common::Indirection<parser::BlockConstruct>;
403 if (auto *bc{std::get_if<BlockConstruct>(&exec->u)}) {
404 iter = &std::get<parser::Block>(bc->value().t);
405 continue;
406 }
407 }
408 break;
409 }
410 return *iter;
411}
412
413} // namespace Fortran::semantics::omp
414

source code of flang/lib/Semantics/openmp-utils.cpp