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