flang/lib/Semantics/canonicalize-directives.cpp

   1 //===-- lib/Semantics/canonicalize-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 "canonicalize-directives.h"
  10 #include "flang/Parser/parse-tree-visitor.h"
  11 #include "flang/Semantics/tools.h"
  12
  13 namespace Fortran::semantics {
  14
  15 using namespace parser::literals;
  16
  17 // Check that directives are associated with the correct constructs.
  18 // Directives that need to be associated with other constructs in the execution
  19 // part are moved to the execution part so they can be checked there.
  20 class CanonicalizationOfDirectives {
  21 public:
  22   CanonicalizationOfDirectives(parser::Messages &messages)
  23       : messages_{messages} {}
  24
  25   template <typename T> bool Pre(T &) { return true; }
  26   template <typename T> void Post(T &) {}
  27
  28   // Move directives that must appear in the Execution part out of the
  29   // Specification part.
  30   void Post(parser::SpecificationPart &spec);
  31   bool Pre(parser::ExecutionPart &x);
  32
  33   // Ensure that directives associated with constructs appear accompanying the
  34   // construct.
  35   void Post(parser::Block &block);
  36
  37 private:
  38   // Ensure that loop directives appear immediately before a loop.
  39   void CheckLoopDirective(parser::CompilerDirective &dir, parser::Block &block,
  40       std::list<parser::ExecutionPartConstruct>::iterator it);
  41
  42   parser::Messages &messages_;
  43
  44   // Directives to be moved to the Execution part from the Specification part.
  45   std::list<common::Indirection<parser::CompilerDirective>>
  46       directivesToConvert_;
  47 };
  48
  49 bool CanonicalizeDirectives(
  50     parser::Messages &messages, parser::Program &program) {
  51   CanonicalizationOfDirectives dirs{messages};
  52   Walk(program, dirs);
  53   return !messages.AnyFatalError();
  54 }
  55
  56 static bool IsExecutionDirective(const parser::CompilerDirective &dir) {
  57   return std::holds_alternative<parser::CompilerDirective::VectorAlways>(dir.u);
  58 }
  59
  60 void CanonicalizationOfDirectives::Post(parser::SpecificationPart &spec) {
  61   auto &list{
  62       std::get<std::list<common::Indirection<parser::CompilerDirective>>>(
  63           spec.t)};
  64   for (auto it{list.begin()}; it != list.end();) {
  65     if (IsExecutionDirective(it->value())) {
  66       directivesToConvert_.emplace_back(std::move(*it));
  67       it = list.erase(it);
  68     } else {
  69       ++it;
  70     }
  71   }
  72 }
  73
  74 bool CanonicalizationOfDirectives::Pre(parser::ExecutionPart &x) {
  75   auto origFirst{x.v.begin()};
  76   for (auto &dir : directivesToConvert_) {
  77     x.v.insert(origFirst,
  78         parser::ExecutionPartConstruct{
  79             parser::ExecutableConstruct{std::move(dir)}});
  80   }
  81
  82   directivesToConvert_.clear();
  83   return true;
  84 }
  85
  86 void CanonicalizationOfDirectives::CheckLoopDirective(
  87     parser::CompilerDirective &dir, parser::Block &block,
  88     std::list<parser::ExecutionPartConstruct>::iterator it) {
  89
  90   // Skip over this and other compiler directives
  91   while (it != block.end() && parser::Unwrap<parser::CompilerDirective>(*it)) {
  92     ++it;
  93   }
  94
  95   if (it == block.end() ||
  96       (!parser::Unwrap<parser::DoConstruct>(*it) &&
  97           !parser::Unwrap<parser::OpenACCLoopConstruct>(*it) &&
  98           !parser::Unwrap<parser::OpenACCCombinedConstruct>(*it))) {
  99     std::string s{parser::ToUpperCaseLetters(dir.source.ToString())};
 100     s.pop_back(); // Remove trailing newline from source string
 101     messages_.Say(
 102         dir.source, "A DO loop must follow the %s directive"_warn_en_US, s);
 103   }
 104 }
 105
 106 void CanonicalizationOfDirectives::Post(parser::Block &block) {
 107   for (auto it{block.begin()}; it != block.end(); ++it) {
 108     if (auto *dir{parser::Unwrap<parser::CompilerDirective>(*it)}) {
 109       std::visit(
 110           common::visitors{[&](parser::CompilerDirective::VectorAlways &) {
 111                              CheckLoopDirective(*dir, block, it);
 112                            },
 113               [&](auto &) {}},
 114           dir->u);
 115     }
 116   }
 117 }
 118
 119 } // namespace Fortran::semantics