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:
Pre(T &)25 template <typename T> bool Pre(T &) { return true; }
Post(T &)26 template <typename T> void Post(T &) {}
CanonicalizationOfOmp(parser::Messages & messages)27 CanonicalizationOfOmp(parser::Messages &messages) : messages_{messages} {}
28
Post(parser::Block & block)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:
GetConstructIf(parser::ExecutionPartConstruct & x)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
RewriteOpenMPLoopConstruct(parser::OpenMPLoopConstruct & x,parser::Block & block,parser::Block::iterator it)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
CanonicalizeOmp(parser::Messages & messages,parser::Program & program)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
118