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