flang/lib/Semantics/canonicalize-omp.cpp

   1 //===-- lib/Semantics/canonicalize-omp.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-omp.h"
  10 #include "flang/Parser/parse-tree-visitor.h"
  11
  12 // After Loop Canonicalization, rewrite OpenMP parse tree to make OpenMP
  13 // Constructs more structured which provide explicit scopes for later
  14 // structural checks and semantic analysis.
  15 //   1. move structured DoConstruct and OmpEndLoopDirective into
  16 //      OpenMPLoopConstruct. Compilation will not proceed in case of errors
  17 //      after this pass.
  18 //   2. TBD
  19 namespace Fortran::semantics {
  20
  21 using namespace parser::literals;
  22
  23 class CanonicalizationOfOmp {
  24 public:
  25   template <typename T> bool Pre(T &) { return true; }
  26   template <typename T> void Post(T &) {}
  27   CanonicalizationOfOmp(parser::Messages &messages) : messages_{messages} {}
  28
  29   void Post(parser::Block &block) {
  30     for (auto it{block.begin()}; it != block.end(); ++it) {
  31       if (auto *ompCons{GetConstructIf<parser::OpenMPConstruct>(*it)}) {
  32         // OpenMPLoopConstruct
  33         if (auto *ompLoop{
  34                 std::get_if<parser::OpenMPLoopConstruct>(&ompCons->u)}) {
  35           RewriteOpenMPLoopConstruct(*ompLoop, block, it);
  36         }
  37       } else if (auto *endDir{
  38                      GetConstructIf<parser::OmpEndLoopDirective>(*it)}) {
  39         // Unmatched OmpEndLoopDirective
  40         auto &dir{std::get<parser::OmpLoopDirective>(endDir->t)};
  41         messages_.Say(dir.source,
  42             "The %s directive must follow the DO loop associated with the "
  43             "loop construct"_err_en_US,
  44             parser::ToUpperCaseLetters(dir.source.ToString()));
  45       }
  46     } // Block list
  47   }
  48
  49 private:
  50   template <typename T> T *GetConstructIf(parser::ExecutionPartConstruct &x) {
  51     if (auto *y{std::get_if<parser::ExecutableConstruct>(&x.u)}) {
  52       if (auto *z{std::get_if<common::Indirection<T>>(&y->u)}) {
  53         return &z->value();
  54       }
  55     }
  56     return nullptr;
  57   }
  58
  59   void RewriteOpenMPLoopConstruct(parser::OpenMPLoopConstruct &x,
  60       parser::Block &block, parser::Block::iterator it) {
  61     // Check the sequence of DoConstruct and OmpEndLoopDirective
  62     // in the same iteration
  63     //
  64     // Original:
  65     //   ExecutableConstruct -> OpenMPConstruct -> OpenMPLoopConstruct
  66     //     OmpBeginLoopDirective
  67     //   ExecutableConstruct -> DoConstruct
  68     //   ExecutableConstruct -> OmpEndLoopDirective (if available)
  69     //
  70     // After rewriting:
  71     //   ExecutableConstruct -> OpenMPConstruct -> OpenMPLoopConstruct
  72     //     OmpBeginLoopDirective
  73     //     DoConstruct
  74     //     OmpEndLoopDirective (if available)
  75     parser::Block::iterator nextIt;
  76     auto &beginDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
  77     auto &dir{std::get<parser::OmpLoopDirective>(beginDir.t)};
  78
  79     nextIt = it;
  80     if (++nextIt != block.end()) {
  81       if (auto *doCons{GetConstructIf<parser::DoConstruct>(*nextIt)}) {
  82         if (doCons->GetLoopControl()) {
  83           // move DoConstruct
  84           std::get<std::optional<parser::DoConstruct>>(x.t) =
  85               std::move(*doCons);
  86           nextIt = block.erase(nextIt);
  87           // try to match OmpEndLoopDirective
  88           if (nextIt != block.end()) {
  89             if (auto *endDir{
  90                     GetConstructIf<parser::OmpEndLoopDirective>(*nextIt)}) {
  91               std::get<std::optional<parser::OmpEndLoopDirective>>(x.t) =
  92                   std::move(*endDir);
  93               block.erase(nextIt);
  94             }
  95           }
  96         } else {
  97           messages_.Say(dir.source,
  98               "DO loop after the %s directive must have loop control"_err_en_US,
  99               parser::ToUpperCaseLetters(dir.source.ToString()));
 100         }
 101         return; // found do-loop
 102       }
 103     }
 104     messages_.Say(dir.source,
 105         "A DO loop must follow the %s directive"_err_en_US,
 106         parser::ToUpperCaseLetters(dir.source.ToString()));
 107   }
 108
 109   parser::Messages &messages_;
 110 };
 111
 112 bool CanonicalizeOmp(parser::Messages &messages, parser::Program &program) {
 113   CanonicalizationOfOmp omp{messages};
 114   Walk(program, omp);
 115   return !messages.AnyFatalError();
 116 }
 117 } // namespace Fortran::semantics