1//===-- lib/Semantics/check-omp-metadirective.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// Semantic checks for METADIRECTIVE and related constructs/clauses.
10//
11//===----------------------------------------------------------------------===//
12
13#include "check-omp-structure.h"
14
15#include "openmp-utils.h"
16
17#include "flang/Common/idioms.h"
18#include "flang/Common/indirection.h"
19#include "flang/Common/visit.h"
20#include "flang/Parser/characters.h"
21#include "flang/Parser/message.h"
22#include "flang/Parser/parse-tree.h"
23#include "flang/Semantics/openmp-modifiers.h"
24#include "flang/Semantics/tools.h"
25
26#include "llvm/Frontend/OpenMP/OMP.h"
27
28#include <list>
29#include <map>
30#include <optional>
31#include <set>
32#include <string>
33#include <tuple>
34#include <utility>
35#include <variant>
36
37namespace Fortran::semantics {
38
39using namespace Fortran::semantics::omp;
40
41void OmpStructureChecker::Enter(const parser::OmpClause::When &x) {
42 CheckAllowedClause(clause: llvm::omp::Clause::OMPC_when);
43 OmpVerifyModifiers(
44 x.v, llvm::omp::OMPC_when, GetContext().clauseSource, context_);
45}
46
47void OmpStructureChecker::Enter(const parser::OmpContextSelector &ctx) {
48 EnterDirectiveNest(index: ContextSelectorNest);
49
50 using SetName = parser::OmpTraitSetSelectorName;
51 std::map<SetName::Value, const SetName *> visited;
52
53 for (const parser::OmpTraitSetSelector &traitSet : ctx.v) {
54 auto &name{std::get<SetName>(traitSet.t)};
55 auto [prev, unique]{visited.insert(std::make_pair(name.v, &name))};
56 if (!unique) {
57 std::string showName{parser::ToUpperCaseLetters(name.ToString())};
58 parser::MessageFormattedText txt(
59 "Repeated trait set name %s in a context specifier"_err_en_US,
60 showName);
61 parser::Message message(name.source, txt);
62 message.Attach(prev->second->source,
63 "Previous trait set %s provided here"_en_US, showName);
64 context_.Say(std::move(message));
65 }
66 CheckTraitSetSelector(traitSet);
67 }
68}
69
70void OmpStructureChecker::Leave(const parser::OmpContextSelector &) {
71 ExitDirectiveNest(index: ContextSelectorNest);
72}
73
74const std::list<parser::OmpTraitProperty> &
75OmpStructureChecker::GetTraitPropertyList(
76 const parser::OmpTraitSelector &trait) {
77 static const std::list<parser::OmpTraitProperty> empty{};
78 auto &[_, maybeProps]{trait.t};
79 if (maybeProps) {
80 using PropertyList = std::list<parser::OmpTraitProperty>;
81 return std::get<PropertyList>(maybeProps->t);
82 } else {
83 return empty;
84 }
85}
86
87std::optional<llvm::omp::Clause> OmpStructureChecker::GetClauseFromProperty(
88 const parser::OmpTraitProperty &property) {
89 using MaybeClause = std::optional<llvm::omp::Clause>;
90
91 // The parser for OmpClause will only succeed if the clause was
92 // given with all required arguments.
93 // If this is a string or complex extension with a clause name,
94 // treat it as a clause and let the trait checker deal with it.
95
96 auto getClauseFromString{[&](const std::string &s) -> MaybeClause {
97 auto id{llvm::omp::getOpenMPClauseKind(parser::ToLowerCaseLetters(s))};
98 if (id != llvm::omp::Clause::OMPC_unknown) {
99 return id;
100 } else {
101 return std::nullopt;
102 }
103 }};
104
105 return common::visit( //
106 common::visitors{
107 [&](const parser::OmpTraitPropertyName &x) -> MaybeClause {
108 return getClauseFromString(x.v);
109 },
110 [&](const common::Indirection<parser::OmpClause> &x) -> MaybeClause {
111 return x.value().Id();
112 },
113 [&](const parser::ScalarExpr &x) -> MaybeClause {
114 return std::nullopt;
115 },
116 [&](const parser::OmpTraitPropertyExtension &x) -> MaybeClause {
117 using ExtProperty = parser::OmpTraitPropertyExtension;
118 if (auto *name{std::get_if<parser::OmpTraitPropertyName>(&x.u)}) {
119 return getClauseFromString(name->v);
120 } else if (auto *cpx{std::get_if<ExtProperty::Complex>(&x.u)}) {
121 return getClauseFromString(
122 std::get<parser::OmpTraitPropertyName>(cpx->t).v);
123 }
124 return std::nullopt;
125 },
126 },
127 property.u);
128}
129
130void OmpStructureChecker::CheckTraitSelectorList(
131 const std::list<parser::OmpTraitSelector> &traits) {
132 // [6.0:322:20]
133 // Each trait-selector-name may only be specified once in a trait selector
134 // set.
135
136 // Cannot store OmpTraitSelectorName directly, because it's not copyable.
137 using TraitName = parser::OmpTraitSelectorName;
138 using BareName = decltype(TraitName::u);
139 std::map<BareName, const TraitName *> visited;
140
141 for (const parser::OmpTraitSelector &trait : traits) {
142 auto &name{std::get<TraitName>(trait.t)};
143
144 auto [prev, unique]{visited.insert(std::make_pair(name.u, &name))};
145 if (!unique) {
146 std::string showName{parser::ToUpperCaseLetters(name.ToString())};
147 parser::MessageFormattedText txt(
148 "Repeated trait name %s in a trait set"_err_en_US, showName);
149 parser::Message message(name.source, txt);
150 message.Attach(prev->second->source,
151 "Previous trait %s provided here"_en_US, showName);
152 context_.Say(std::move(message));
153 }
154 }
155}
156
157void OmpStructureChecker::CheckTraitSetSelector(
158 const parser::OmpTraitSetSelector &traitSet) {
159
160 // Trait Set | Allowed traits | D-traits | X-traits | Score |
161 //
162 // Construct | Simd, directive-name | Yes | No | No |
163 // Device | Arch, Isa, Kind | No | Yes | No |
164 // Implementation | Atomic_Default_Mem_Order | No | Yes | Yes |
165 // | Extension, Requires | | | |
166 // | Vendor | | | |
167 // Target_Device | Arch, Device_Num, Isa | No | Yes | No |
168 // | Kind, Uid | | | |
169 // User | Condition | No | No | Yes |
170
171 struct TraitSetConfig {
172 std::set<parser::OmpTraitSelectorName::Value> allowed;
173 bool allowsDirectiveTraits;
174 bool allowsExtensionTraits;
175 bool allowsScore;
176 };
177
178 using SName = parser::OmpTraitSetSelectorName::Value;
179 using TName = parser::OmpTraitSelectorName::Value;
180
181 static const std::map<SName, TraitSetConfig> configs{
182 {SName::Construct, //
183 {{TName::Simd}, true, false, false}},
184 {SName::Device, //
185 {{TName::Arch, TName::Isa, TName::Kind}, false, true, false}},
186 {SName::Implementation, //
187 {{TName::Atomic_Default_Mem_Order, TName::Extension, TName::Requires,
188 TName::Vendor},
189 false, true, true}},
190 {SName::Target_Device, //
191 {{TName::Arch, TName::Device_Num, TName::Isa, TName::Kind,
192 TName::Uid},
193 false, true, false}},
194 {SName::User, //
195 {{TName::Condition}, false, false, true}},
196 };
197
198 auto checkTraitSet{[&](const TraitSetConfig &config) {
199 auto &[setName, traits]{traitSet.t};
200 auto usn{parser::ToUpperCaseLetters(setName.ToString())};
201
202 // Check if there are any duplicate traits.
203 CheckTraitSelectorList(traits);
204
205 for (const parser::OmpTraitSelector &trait : traits) {
206 // Don't use structured bindings here, because they cannot be captured
207 // before C++20.
208 auto &traitName = std::get<parser::OmpTraitSelectorName>(trait.t);
209 auto &maybeProps =
210 std::get<std::optional<parser::OmpTraitSelector::Properties>>(
211 trait.t);
212
213 // Check allowed traits
214 common::visit( //
215 common::visitors{
216 [&](parser::OmpTraitSelectorName::Value v) {
217 if (!config.allowed.count(v)) {
218 context_.Say(traitName.source,
219 "%s is not a valid trait for %s trait set"_err_en_US,
220 parser::ToUpperCaseLetters(traitName.ToString()), usn);
221 }
222 },
223 [&](llvm::omp::Directive) {
224 if (!config.allowsDirectiveTraits) {
225 context_.Say(traitName.source,
226 "Directive name is not a valid trait for %s trait set"_err_en_US,
227 usn);
228 }
229 },
230 [&](const std::string &) {
231 if (!config.allowsExtensionTraits) {
232 context_.Say(traitName.source,
233 "Extension traits are not valid for %s trait set"_err_en_US,
234 usn);
235 }
236 },
237 },
238 traitName.u);
239
240 // Check score
241 if (maybeProps) {
242 auto &[maybeScore, _]{maybeProps->t};
243 if (maybeScore) {
244 CheckTraitScore(*maybeScore);
245 }
246 }
247
248 // Check the properties of the individual traits
249 CheckTraitSelector(traitSet, trait);
250 }
251 }};
252
253 checkTraitSet(
254 configs.at(std::get<parser::OmpTraitSetSelectorName>(traitSet.t).v));
255}
256
257void OmpStructureChecker::CheckTraitScore(const parser::OmpTraitScore &score) {
258 // [6.0:322:23]
259 // A score-expression must be a non-negative constant integer expression.
260 if (auto value{GetIntValue(score)}; !value || value < 0) {
261 context_.Say(score.source,
262 "SCORE expression must be a non-negative constant integer expression"_err_en_US);
263 }
264}
265
266bool OmpStructureChecker::VerifyTraitPropertyLists(
267 const parser::OmpTraitSetSelector &traitSet,
268 const parser::OmpTraitSelector &trait) {
269 using TraitName = parser::OmpTraitSelectorName;
270 using PropertyList = std::list<parser::OmpTraitProperty>;
271 auto &[traitName, maybeProps]{trait.t};
272
273 auto checkPropertyList{[&](const PropertyList &properties, auto isValid,
274 const std::string &message) {
275 bool foundInvalid{false};
276 for (const parser::OmpTraitProperty &prop : properties) {
277 if (!isValid(prop)) {
278 if (foundInvalid) {
279 context_.Say(
280 prop.source, "More invalid properties are present"_err_en_US);
281 break;
282 }
283 context_.Say(prop.source, "%s"_err_en_US, message);
284 foundInvalid = true;
285 }
286 }
287 return !foundInvalid;
288 }};
289
290 bool invalid{false};
291
292 if (std::holds_alternative<llvm::omp::Directive>(traitName.u)) {
293 // Directive-name traits don't have properties.
294 if (maybeProps) {
295 context_.Say(trait.source,
296 "Directive-name traits cannot have properties"_err_en_US);
297 invalid = true;
298 }
299 }
300 // Ignore properties on extension traits.
301
302 // See `TraitSelectorParser` in openmp-parser.cpp
303 if (auto *v{std::get_if<TraitName::Value>(&traitName.u)}) {
304 switch (*v) {
305 // name-list properties
306 case parser::OmpTraitSelectorName::Value::Arch:
307 case parser::OmpTraitSelectorName::Value::Extension:
308 case parser::OmpTraitSelectorName::Value::Isa:
309 case parser::OmpTraitSelectorName::Value::Kind:
310 case parser::OmpTraitSelectorName::Value::Uid:
311 case parser::OmpTraitSelectorName::Value::Vendor:
312 if (maybeProps) {
313 auto isName{[](const parser::OmpTraitProperty &prop) {
314 return std::holds_alternative<parser::OmpTraitPropertyName>(prop.u);
315 }};
316 invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
317 isName, "Trait property should be a name");
318 }
319 break;
320 // clause-list
321 case parser::OmpTraitSelectorName::Value::Atomic_Default_Mem_Order:
322 case parser::OmpTraitSelectorName::Value::Requires:
323 case parser::OmpTraitSelectorName::Value::Simd:
324 if (maybeProps) {
325 auto isClause{[&](const parser::OmpTraitProperty &prop) {
326 return GetClauseFromProperty(prop).has_value();
327 }};
328 invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
329 isClause, "Trait property should be a clause");
330 }
331 break;
332 // expr-list
333 case parser::OmpTraitSelectorName::Value::Condition:
334 case parser::OmpTraitSelectorName::Value::Device_Num:
335 if (maybeProps) {
336 auto isExpr{[](const parser::OmpTraitProperty &prop) {
337 return std::holds_alternative<parser::ScalarExpr>(prop.u);
338 }};
339 invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
340 isExpr, "Trait property should be a scalar expression");
341 }
342 break;
343 } // switch
344 }
345
346 return !invalid;
347}
348
349void OmpStructureChecker::CheckTraitSelector(
350 const parser::OmpTraitSetSelector &traitSet,
351 const parser::OmpTraitSelector &trait) {
352 using TraitName = parser::OmpTraitSelectorName;
353 auto &[traitName, maybeProps]{trait.t};
354
355 // Only do the detailed checks if the property lists are valid.
356 if (VerifyTraitPropertyLists(traitSet, trait)) {
357 if (std::holds_alternative<llvm::omp::Directive>(traitName.u) ||
358 std::holds_alternative<std::string>(traitName.u)) {
359 // No properties here: directives don't have properties, and
360 // we don't implement any extension traits now.
361 return;
362 }
363
364 // Specific traits we want to check.
365 // Limitations:
366 // (1) The properties for these traits are defined in "Additional
367 // Definitions for the OpenMP API Specification". It's not clear how
368 // to define them in a portable way, and how to verify their validity,
369 // especially if they get replaced by their integer values (in case
370 // they are defined as enums).
371 // (2) These are entirely implementation-defined, and at the moment
372 // there is no known schema to validate these values.
373 auto v{std::get<TraitName::Value>(traitName.u)};
374 switch (v) {
375 case TraitName::Value::Arch:
376 // Unchecked, TBD(1)
377 break;
378 case TraitName::Value::Atomic_Default_Mem_Order:
379 CheckTraitADMO(traitSet, trait);
380 break;
381 case TraitName::Value::Condition:
382 CheckTraitCondition(traitSet, trait);
383 break;
384 case TraitName::Value::Device_Num:
385 CheckTraitDeviceNum(traitSet, trait);
386 break;
387 case TraitName::Value::Extension:
388 // Ignore
389 break;
390 case TraitName::Value::Isa:
391 // Unchecked, TBD(1)
392 break;
393 case TraitName::Value::Kind:
394 // Unchecked, TBD(1)
395 break;
396 case TraitName::Value::Requires:
397 CheckTraitRequires(traitSet, trait);
398 break;
399 case TraitName::Value::Simd:
400 CheckTraitSimd(traitSet, trait);
401 break;
402 case TraitName::Value::Uid:
403 // Unchecked, TBD(2)
404 break;
405 case TraitName::Value::Vendor:
406 // Unchecked, TBD(1)
407 break;
408 }
409 }
410}
411
412void OmpStructureChecker::CheckTraitADMO(
413 const parser::OmpTraitSetSelector &traitSet,
414 const parser::OmpTraitSelector &trait) {
415 auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
416 auto &properties{GetTraitPropertyList(trait)};
417
418 if (properties.size() != 1) {
419 context_.Say(trait.source,
420 "%s trait requires a single clause property"_err_en_US,
421 parser::ToUpperCaseLetters(traitName.ToString()));
422 } else {
423 const parser::OmpTraitProperty &property{properties.front()};
424 auto clauseId{*GetClauseFromProperty(property)};
425 // Check that the clause belongs to the memory-order clause-set.
426 // Clause sets will hopefully be autogenerated at some point.
427 switch (clauseId) {
428 case llvm::omp::Clause::OMPC_acq_rel:
429 case llvm::omp::Clause::OMPC_acquire:
430 case llvm::omp::Clause::OMPC_relaxed:
431 case llvm::omp::Clause::OMPC_release:
432 case llvm::omp::Clause::OMPC_seq_cst:
433 break;
434 default:
435 context_.Say(property.source,
436 "%s trait requires a clause from the memory-order clause set"_err_en_US,
437 parser::ToUpperCaseLetters(traitName.ToString()));
438 }
439
440 using ClauseProperty = common::Indirection<parser::OmpClause>;
441 if (!std::holds_alternative<ClauseProperty>(property.u)) {
442 context_.Say(property.source,
443 "Invalid clause specification for %s"_err_en_US,
444 parser::ToUpperCaseLetters(getClauseName(clauseId)));
445 }
446 }
447}
448
449void OmpStructureChecker::CheckTraitCondition(
450 const parser::OmpTraitSetSelector &traitSet,
451 const parser::OmpTraitSelector &trait) {
452 auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
453 auto &properties{GetTraitPropertyList(trait)};
454
455 if (properties.size() != 1) {
456 context_.Say(trait.source,
457 "%s trait requires a single expression property"_err_en_US,
458 parser::ToUpperCaseLetters(traitName.ToString()));
459 } else {
460 const parser::OmpTraitProperty &property{properties.front()};
461 auto &scalarExpr{std::get<parser::ScalarExpr>(property.u)};
462
463 auto maybeType{GetDynamicType(scalarExpr.thing.value())};
464 if (!maybeType || maybeType->category() != TypeCategory::Logical) {
465 context_.Say(property.source,
466 "%s trait requires a single LOGICAL expression"_err_en_US,
467 parser::ToUpperCaseLetters(traitName.ToString()));
468 }
469 }
470}
471
472void OmpStructureChecker::CheckTraitDeviceNum(
473 const parser::OmpTraitSetSelector &traitSet,
474 const parser::OmpTraitSelector &trait) {
475 auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
476 auto &properties{GetTraitPropertyList(trait)};
477
478 if (properties.size() != 1) {
479 context_.Say(trait.source,
480 "%s trait requires a single expression property"_err_en_US,
481 parser::ToUpperCaseLetters(traitName.ToString()));
482 }
483 // No other checks at the moment.
484}
485
486void OmpStructureChecker::CheckTraitRequires(
487 const parser::OmpTraitSetSelector &traitSet,
488 const parser::OmpTraitSelector &trait) {
489 unsigned version{context_.langOptions().OpenMPVersion};
490 auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
491 auto &properties{GetTraitPropertyList(trait)};
492
493 for (const parser::OmpTraitProperty &property : properties) {
494 auto clauseId{*GetClauseFromProperty(property)};
495 if (!llvm::omp::isAllowedClauseForDirective(
496 llvm::omp::OMPD_requires, clauseId, version)) {
497 context_.Say(property.source,
498 "%s trait requires a clause from the requirement clause set"_err_en_US,
499 parser::ToUpperCaseLetters(traitName.ToString()));
500 }
501
502 using ClauseProperty = common::Indirection<parser::OmpClause>;
503 if (!std::holds_alternative<ClauseProperty>(property.u)) {
504 context_.Say(property.source,
505 "Invalid clause specification for %s"_err_en_US,
506 parser::ToUpperCaseLetters(getClauseName(clauseId)));
507 }
508 }
509}
510
511void OmpStructureChecker::CheckTraitSimd(
512 const parser::OmpTraitSetSelector &traitSet,
513 const parser::OmpTraitSelector &trait) {
514 unsigned version{context_.langOptions().OpenMPVersion};
515 auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
516 auto &properties{GetTraitPropertyList(trait)};
517
518 for (const parser::OmpTraitProperty &property : properties) {
519 auto clauseId{*GetClauseFromProperty(property)};
520 if (!llvm::omp::isAllowedClauseForDirective(
521 llvm::omp::OMPD_declare_simd, clauseId, version)) {
522 context_.Say(property.source,
523 "%s trait requires a clause that is allowed on the %s directive"_err_en_US,
524 parser::ToUpperCaseLetters(traitName.ToString()),
525 parser::ToUpperCaseLetters(
526 getDirectiveName(llvm::omp::OMPD_declare_simd)));
527 }
528
529 using ClauseProperty = common::Indirection<parser::OmpClause>;
530 if (!std::holds_alternative<ClauseProperty>(property.u)) {
531 context_.Say(property.source,
532 "Invalid clause specification for %s"_err_en_US,
533 parser::ToUpperCaseLetters(getClauseName(clauseId)));
534 }
535 }
536}
537
538void OmpStructureChecker::Enter(const parser::OmpMetadirectiveDirective &x) {
539 EnterDirectiveNest(index: MetadirectiveNest);
540 PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_metadirective);
541}
542
543void OmpStructureChecker::Leave(const parser::OmpMetadirectiveDirective &) {
544 ExitDirectiveNest(index: MetadirectiveNest);
545 dirContext_.pop_back();
546}
547
548} // namespace Fortran::semantics
549

source code of flang/lib/Semantics/check-omp-metadirective.cpp