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