1 //===-- lib/Semantics/canonicalize-acc.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-acc.h"
10 #include "flang/Parser/parse-tree-visitor.h"
11 #include "flang/Semantics/tools.h"
12 
13 // After Loop Canonicalization, rewrite OpenACC parse tree to make OpenACC
14 // Constructs more structured which provide explicit scopes for later
15 // structural checks and semantic analysis.
16 //   1. move structured DoConstruct into
17 //      OpenACCLoopConstruct. Compilation will not proceed in case of errors
18 //      after this pass.
19 //   2. move structured DoConstruct into OpenACCCombinedConstruct. Move
20 //      AccEndCombinedConstruct into OpenACCCombinedConstruct if present.
21 //      Compilation will not proceed in case of errors after this pass.
22 namespace Fortran::semantics {
23 
24 using namespace parser::literals;
25 
26 class CanonicalizationOfAcc {
27 public:
28   template <typename T> bool Pre(T &) { return true; }
29   template <typename T> void Post(T &) {}
30   CanonicalizationOfAcc(parser::Messages &messages) : messages_{messages} {}
31 
32   void Post(parser::Block &block) {
33     for (auto it{block.begin()}; it != block.end(); ++it) {
34       if (auto *accLoop{parser::Unwrap<parser::OpenACCLoopConstruct>(*it)}) {
35         RewriteOpenACCLoopConstruct(*accLoop, block, it);
36       } else if (auto *accCombined{
37                      parser::Unwrap<parser::OpenACCCombinedConstruct>(*it)}) {
38         RewriteOpenACCCombinedConstruct(*accCombined, block, it);
39       } else if (auto *endDir{
40                      parser::Unwrap<parser::AccEndCombinedDirective>(*it)}) {
41         // Unmatched AccEndCombinedDirective
42         messages_.Say(endDir->v.source,
43             "The %s directive must follow the DO loop associated with the "
44             "loop construct"_err_en_US,
45             parser::ToUpperCaseLetters(endDir->v.source.ToString()));
46       }
47     } // Block list
48   }
49 
50 private:
51   void RewriteOpenACCLoopConstruct(parser::OpenACCLoopConstruct &x,
52       parser::Block &block, parser::Block::iterator it) {
53     // Check the sequence of DoConstruct in the same iteration
54     //
55     // Original:
56     //   ExecutableConstruct -> OpenACCConstruct -> OpenACCLoopConstruct
57     //     ACCBeginLoopDirective
58     //   ExecutableConstruct -> DoConstruct
59     //
60     // After rewriting:
61     //   ExecutableConstruct -> OpenACCConstruct -> OpenACCLoopConstruct
62     //     AccBeginLoopDirective
63     //     DoConstruct
64     parser::Block::iterator nextIt;
65     auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
66     auto &dir{std::get<parser::AccLoopDirective>(beginDir.t)};
67 
68     nextIt = it;
69     if (++nextIt != block.end()) {
70       if (auto *doCons{parser::Unwrap<parser::DoConstruct>(*nextIt)}) {
71         if (doCons->GetLoopControl()) {
72           // move DoConstruct
73           std::get<std::optional<parser::DoConstruct>>(x.t) =
74               std::move(*doCons);
75           nextIt = block.erase(nextIt);
76         } else {
77           messages_.Say(dir.source,
78               "DO loop after the %s directive must have loop control"_err_en_US,
79               parser::ToUpperCaseLetters(dir.source.ToString()));
80         }
81         return; // found do-loop
82       }
83     }
84     messages_.Say(dir.source,
85         "A DO loop must follow the %s directive"_err_en_US,
86         parser::ToUpperCaseLetters(dir.source.ToString()));
87   }
88 
89   void RewriteOpenACCCombinedConstruct(parser::OpenACCCombinedConstruct &x,
90       parser::Block &block, parser::Block::iterator it) {
91     // Check the sequence of DoConstruct in the same iteration
92     //
93     // Original:
94     //   ExecutableConstruct -> OpenACCConstruct -> OpenACCCombinedConstruct
95     //     ACCBeginCombinedDirective
96     //   ExecutableConstruct -> DoConstruct
97     //   ExecutableConstruct -> AccEndCombinedDirective (if available)
98     //
99     // After rewriting:
100     //   ExecutableConstruct -> OpenACCConstruct -> OpenACCCombinedConstruct
101     //     ACCBeginCombinedDirective
102     //     DoConstruct
103     //     AccEndCombinedDirective (if available)
104     parser::Block::iterator nextIt;
105     auto &beginDir{std::get<parser::AccBeginCombinedDirective>(x.t)};
106     auto &dir{std::get<parser::AccCombinedDirective>(beginDir.t)};
107 
108     nextIt = it;
109     if (++nextIt != block.end()) {
110       if (auto *doCons{parser::Unwrap<parser::DoConstruct>(*nextIt)}) {
111         if (doCons->GetLoopControl()) {
112           // move DoConstruct
113           std::get<std::optional<parser::DoConstruct>>(x.t) =
114               std::move(*doCons);
115           nextIt = block.erase(nextIt);
116           // try to match AccEndCombinedDirective
117           if (nextIt != block.end()) {
118             if (auto *endDir{
119                     parser::Unwrap<parser::AccEndCombinedDirective>(*nextIt)}) {
120               std::get<std::optional<parser::AccEndCombinedDirective>>(x.t) =
121                   std::move(*endDir);
122               block.erase(nextIt);
123             }
124           }
125         } else {
126           messages_.Say(dir.source,
127               "DO loop after the %s directive must have loop control"_err_en_US,
128               parser::ToUpperCaseLetters(dir.source.ToString()));
129         }
130         return; // found do-loop
131       }
132     }
133     messages_.Say(dir.source,
134         "A DO loop must follow the %s directive"_err_en_US,
135         parser::ToUpperCaseLetters(dir.source.ToString()));
136   }
137 
138   parser::Messages &messages_;
139 };
140 
141 bool CanonicalizeAcc(parser::Messages &messages, parser::Program &program) {
142   CanonicalizationOfAcc acc{messages};
143   Walk(program, acc);
144   return !messages.AnyFatalError();
145 }
146 } // namespace Fortran::semantics
147