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>( |
58 | dir.u) || |
59 | std::holds_alternative<parser::CompilerDirective::Unroll>(dir.u) || |
60 | std::holds_alternative<parser::CompilerDirective::UnrollAndJam>(dir.u) || |
61 | std::holds_alternative<parser::CompilerDirective::NoVector>(dir.u) || |
62 | std::holds_alternative<parser::CompilerDirective::NoUnroll>(dir.u) || |
63 | std::holds_alternative<parser::CompilerDirective::NoUnrollAndJam>(dir.u); |
64 | } |
65 | |
66 | void CanonicalizationOfDirectives::Post(parser::SpecificationPart &spec) { |
67 | auto &list{ |
68 | std::get<std::list<common::Indirection<parser::CompilerDirective>>>( |
69 | spec.t)}; |
70 | for (auto it{list.begin()}; it != list.end();) { |
71 | if (IsExecutionDirective(it->value())) { |
72 | directivesToConvert_.emplace_back(std::move(*it)); |
73 | it = list.erase(it); |
74 | } else { |
75 | ++it; |
76 | } |
77 | } |
78 | } |
79 | |
80 | bool CanonicalizationOfDirectives::Pre(parser::ExecutionPart &x) { |
81 | auto origFirst{x.v.begin()}; |
82 | for (auto &dir : directivesToConvert_) { |
83 | x.v.insert(origFirst, |
84 | parser::ExecutionPartConstruct{ |
85 | parser::ExecutableConstruct{std::move(dir)}}); |
86 | } |
87 | |
88 | directivesToConvert_.clear(); |
89 | return true; |
90 | } |
91 | |
92 | void CanonicalizationOfDirectives::CheckLoopDirective( |
93 | parser::CompilerDirective &dir, parser::Block &block, |
94 | std::list<parser::ExecutionPartConstruct>::iterator it) { |
95 | |
96 | // Skip over this and other compiler directives |
97 | while (it != block.end() && parser::Unwrap<parser::CompilerDirective>(*it)) { |
98 | ++it; |
99 | } |
100 | |
101 | if (it == block.end() || |
102 | (!parser::Unwrap<parser::DoConstruct>(*it) && |
103 | !parser::Unwrap<parser::OpenACCLoopConstruct>(*it) && |
104 | !parser::Unwrap<parser::OpenACCCombinedConstruct>(*it))) { |
105 | std::string s{parser::ToUpperCaseLetters(dir.source.ToString())}; |
106 | s.pop_back(); // Remove trailing newline from source string |
107 | messages_.Say( |
108 | dir.source, "A DO loop must follow the %s directive"_warn_en_US , s); |
109 | } |
110 | } |
111 | |
112 | void CanonicalizationOfDirectives::Post(parser::Block &block) { |
113 | for (auto it{block.begin()}; it != block.end(); ++it) { |
114 | if (auto *dir{parser::Unwrap<parser::CompilerDirective>(*it)}) { |
115 | std::visit( |
116 | common::visitors{[&](parser::CompilerDirective::VectorAlways &) { |
117 | CheckLoopDirective(*dir, block, it); |
118 | }, |
119 | [&](parser::CompilerDirective::Unroll &) { |
120 | CheckLoopDirective(*dir, block, it); |
121 | }, |
122 | [&](parser::CompilerDirective::UnrollAndJam &) { |
123 | CheckLoopDirective(*dir, block, it); |
124 | }, |
125 | [&](parser::CompilerDirective::NoVector &) { |
126 | CheckLoopDirective(*dir, block, it); |
127 | }, |
128 | [&](parser::CompilerDirective::NoUnroll &) { |
129 | CheckLoopDirective(*dir, block, it); |
130 | }, |
131 | [&](parser::CompilerDirective::NoUnrollAndJam &) { |
132 | CheckLoopDirective(*dir, block, it); |
133 | }, |
134 | [&](auto &) {}}, |
135 | dir->u); |
136 | } |
137 | } |
138 | } |
139 | |
140 | } // namespace Fortran::semantics |
141 | |