flang/lib/Semantics/rewrite-directives.cpp

   1 //===-- lib/Semantics/rewrite-directives.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 "rewrite-directives.h"
  10 #include "flang/Parser/parse-tree-visitor.h"
  11 #include "flang/Parser/parse-tree.h"
  12 #include "flang/Semantics/semantics.h"
  13 #include "flang/Semantics/symbol.h"
  14 #include "llvm/Frontend/OpenMP/OMP.h"
  15 #include <list>
  16
  17 namespace Fortran::semantics {
  18
  19 using namespace parser::literals;
  20
  21 class DirectiveRewriteMutator {
  22 public:
  23   explicit DirectiveRewriteMutator(SemanticsContext &context)
  24       : context_{context} {}
  25
  26   // Default action for a parse tree node is to visit children.
  27   template <typename T> bool Pre(T &) { return true; }
  28   template <typename T> void Post(T &) {}
  29
  30 protected:
  31   SemanticsContext &context_;
  32 };
  33
  34 // Rewrite atomic constructs to add an explicit memory ordering to all that do
  35 // not specify it, honoring in this way the `atomic_default_mem_order` clause of
  36 // the REQUIRES directive.
  37 class OmpRewriteMutator : public DirectiveRewriteMutator {
  38 public:
  39   explicit OmpRewriteMutator(SemanticsContext &context)
  40       : DirectiveRewriteMutator(context) {}
  41
  42   template <typename T> bool Pre(T &) { return true; }
  43   template <typename T> void Post(T &) {}
  44
  45   bool Pre(parser::OpenMPAtomicConstruct &);
  46   bool Pre(parser::OpenMPRequiresConstruct &);
  47
  48 private:
  49   bool atomicDirectiveDefaultOrderFound_{false};
  50 };
  51
  52 bool OmpRewriteMutator::Pre(parser::OpenMPAtomicConstruct &x) {
  53   // Find top-level parent of the operation.
  54   Symbol *topLevelParent{common::visit(
  55       [&](auto &atomic) {
  56         Symbol *symbol{nullptr};
  57         Scope *scope{
  58             &context_.FindScope(std::get<parser::Verbatim>(atomic.t).source)};
  59         do {
  60           if (Symbol * parent{scope->symbol()}) {
  61             symbol = parent;
  62           }
  63           scope = &scope->parent();
  64         } while (!scope->IsGlobal());
  65
  66         assert(symbol &&
  67             "Atomic construct must be within a scope associated with a symbol");
  68         return symbol;
  69       },
  70       x.u)};
  71
  72   // Get the `atomic_default_mem_order` clause from the top-level parent.
  73   std::optional<common::OmpAtomicDefaultMemOrderType> defaultMemOrder;
  74   common::visit(
  75       [&](auto &details) {
  76         if constexpr (std::is_convertible_v<decltype(&details),
  77                           WithOmpDeclarative *>) {
  78           if (details.has_ompAtomicDefaultMemOrder()) {
  79             defaultMemOrder = *details.ompAtomicDefaultMemOrder();
  80           }
  81         }
  82       },
  83       topLevelParent->details());
  84
  85   if (!defaultMemOrder) {
  86     return false;
  87   }
  88
  89   auto findMemOrderClause =
  90       [](const std::list<parser::OmpAtomicClause> &clauses) {
  91         return llvm::any_of(clauses, [](const auto &clause) {
  92           return std::get_if<parser::OmpMemoryOrderClause>(&clause.u);
  93         });
  94       };
  95
  96   // Get the clause list to which the new memory order clause must be added,
  97   // only if there are no other memory order clauses present for this atomic
  98   // directive.
  99   std::list<parser::OmpAtomicClause> *clauseList = common::visit(
 100       common::visitors{[&](parser::OmpAtomic &atomicConstruct) {
 101                          // OmpAtomic only has a single list of clauses.
 102                          auto &clauses{std::get<parser::OmpAtomicClauseList>(
 103                              atomicConstruct.t)};
 104                          return !findMemOrderClause(clauses.v) ? &clauses.v
 105                                                                : nullptr;
 106                        },
 107           [&](auto &atomicConstruct) {
 108             // All other atomic constructs have two lists of clauses.
 109             auto &clausesLhs{std::get<0>(atomicConstruct.t)};
 110             auto &clausesRhs{std::get<2>(atomicConstruct.t)};
 111             return !findMemOrderClause(clausesLhs.v) &&
 112                     !findMemOrderClause(clausesRhs.v)
 113                 ? &clausesRhs.v
 114                 : nullptr;
 115           }},
 116       x.u);
 117
 118   // Add a memory order clause to the atomic directive.
 119   if (clauseList) {
 120     atomicDirectiveDefaultOrderFound_ = true;
 121     switch (*defaultMemOrder) {
 122     case common::OmpAtomicDefaultMemOrderType::AcqRel:
 123       clauseList->emplace_back<parser::OmpMemoryOrderClause>(common::visit(
 124           common::visitors{[](parser::OmpAtomicRead &) -> parser::OmpClause {
 125                              return parser::OmpClause::Acquire{};
 126                            },
 127               [](parser::OmpAtomicCapture &) -> parser::OmpClause {
 128                 return parser::OmpClause::AcqRel{};
 129               },
 130               [](auto &) -> parser::OmpClause {
 131                 // parser::{OmpAtomic, OmpAtomicUpdate, OmpAtomicWrite}
 132                 return parser::OmpClause::Release{};
 133               }},
 134           x.u));
 135       break;
 136     case common::OmpAtomicDefaultMemOrderType::Relaxed:
 137       clauseList->emplace_back<parser::OmpMemoryOrderClause>(
 138           parser::OmpClause{parser::OmpClause::Relaxed{}});
 139       break;
 140     case common::OmpAtomicDefaultMemOrderType::SeqCst:
 141       clauseList->emplace_back<parser::OmpMemoryOrderClause>(
 142           parser::OmpClause{parser::OmpClause::SeqCst{}});
 143       break;
 144     }
 145   }
 146
 147   return false;
 148 }
 149
 150 bool OmpRewriteMutator::Pre(parser::OpenMPRequiresConstruct &x) {
 151   for (parser::OmpClause &clause : std::get<parser::OmpClauseList>(x.t).v) {
 152     if (std::holds_alternative<parser::OmpClause::AtomicDefaultMemOrder>(
 153             clause.u) &&
 154         atomicDirectiveDefaultOrderFound_) {
 155       context_.Say(clause.source,
 156           "REQUIRES directive with '%s' clause found lexically after atomic "
 157           "operation without a memory order clause"_err_en_US,
 158           parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(
 159               llvm::omp::OMPC_atomic_default_mem_order)
 160                                          .str()));
 161     }
 162   }
 163   return false;
 164 }
 165
 166 bool RewriteOmpParts(SemanticsContext &context, parser::Program &program) {
 167   if (!context.IsEnabled(common::LanguageFeature::OpenMP)) {
 168     return true;
 169   }
 170   OmpRewriteMutator ompMutator{context};
 171   parser::Walk(program, ompMutator);
 172   return !context.AnyFatalError();
 173 }
 174
 175 } // namespace Fortran::semantics