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
13namespace Fortran::semantics {
14
15using 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.
20class CanonicalizationOfDirectives {
21public:
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
37private:
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
49bool CanonicalizeDirectives(
50 parser::Messages &messages, parser::Program &program) {
51 CanonicalizationOfDirectives dirs{messages};
52 Walk(program, dirs);
53 return !messages.AnyFatalError();
54}
55
56static 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
66void 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
80bool 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
92void 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
112void 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

source code of flang/lib/Semantics/canonicalize-directives.cpp