1 //===-- lib/Semantics/program-tree.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 "program-tree.h" 10 #include "flang/Common/idioms.h" 11 #include "flang/Parser/char-block.h" 12 #include "flang/Semantics/scope.h" 13 14 namespace Fortran::semantics { 15 16 static void GetEntryStmts( 17 ProgramTree &node, const parser::SpecificationPart &spec) { 18 const auto &implicitPart{std::get<parser::ImplicitPart>(spec.t)}; 19 for (const parser::ImplicitPartStmt &stmt : implicitPart.v) { 20 if (const auto *entryStmt{std::get_if< 21 parser::Statement<common::Indirection<parser::EntryStmt>>>( 22 &stmt.u)}) { 23 node.AddEntry(entryStmt->statement.value()); 24 } 25 } 26 for (const auto &decl : 27 std::get<std::list<parser::DeclarationConstruct>>(spec.t)) { 28 if (const auto *entryStmt{std::get_if< 29 parser::Statement<common::Indirection<parser::EntryStmt>>>( 30 &decl.u)}) { 31 node.AddEntry(entryStmt->statement.value()); 32 } 33 } 34 } 35 36 static void GetEntryStmts( 37 ProgramTree &node, const parser::ExecutionPart &exec) { 38 for (const auto &epConstruct : exec.v) { 39 if (const auto *entryStmt{std::get_if< 40 parser::Statement<common::Indirection<parser::EntryStmt>>>( 41 &epConstruct.u)}) { 42 node.AddEntry(entryStmt->statement.value()); 43 } 44 } 45 } 46 47 // Collects generics that define simple names that could include 48 // identically-named subprograms as specific procedures. 49 static void GetGenerics( 50 ProgramTree &node, const parser::SpecificationPart &spec) { 51 for (const auto &decl : 52 std::get<std::list<parser::DeclarationConstruct>>(spec.t)) { 53 if (const auto *spec{ 54 std::get_if<parser::SpecificationConstruct>(&decl.u)}) { 55 if (const auto *generic{std::get_if< 56 parser::Statement<common::Indirection<parser::GenericStmt>>>( 57 &spec->u)}) { 58 const parser::GenericStmt &genericStmt{generic->statement.value()}; 59 const auto &genericSpec{std::get<parser::GenericSpec>(genericStmt.t)}; 60 node.AddGeneric(genericSpec); 61 } else if (const auto *interface{ 62 std::get_if<common::Indirection<parser::InterfaceBlock>>( 63 &spec->u)}) { 64 const parser::InterfaceBlock &interfaceBlock{interface->value()}; 65 const parser::InterfaceStmt &interfaceStmt{ 66 std::get<parser::Statement<parser::InterfaceStmt>>(interfaceBlock.t) 67 .statement}; 68 const auto *genericSpec{ 69 std::get_if<std::optional<parser::GenericSpec>>(&interfaceStmt.u)}; 70 if (genericSpec && genericSpec->has_value()) { 71 node.AddGeneric(**genericSpec); 72 } 73 } 74 } 75 } 76 } 77 78 template <typename T> 79 static ProgramTree BuildSubprogramTree(const parser::Name &name, const T &x) { 80 const auto &spec{std::get<parser::SpecificationPart>(x.t)}; 81 const auto &exec{std::get<parser::ExecutionPart>(x.t)}; 82 const auto &subps{ 83 std::get<std::optional<parser::InternalSubprogramPart>>(x.t)}; 84 ProgramTree node{name, spec, &exec}; 85 GetEntryStmts(node, spec); 86 GetEntryStmts(node, exec); 87 GetGenerics(node, spec); 88 if (subps) { 89 for (const auto &subp : 90 std::get<std::list<parser::InternalSubprogram>>(subps->t)) { 91 common::visit( 92 [&](const auto &y) { node.AddChild(ProgramTree::Build(y.value())); }, 93 subp.u); 94 } 95 } 96 return node; 97 } 98 99 static ProgramTree BuildSubprogramTree( 100 const parser::Name &name, const parser::BlockData &x) { 101 const auto &spec{std::get<parser::SpecificationPart>(x.t)}; 102 return ProgramTree{name, spec}; 103 } 104 105 template <typename T> 106 static ProgramTree BuildModuleTree(const parser::Name &name, const T &x) { 107 const auto &spec{std::get<parser::SpecificationPart>(x.t)}; 108 const auto &subps{std::get<std::optional<parser::ModuleSubprogramPart>>(x.t)}; 109 ProgramTree node{name, spec}; 110 GetGenerics(node, spec); 111 if (subps) { 112 for (const auto &subp : 113 std::get<std::list<parser::ModuleSubprogram>>(subps->t)) { 114 common::visit( 115 [&](const auto &y) { node.AddChild(ProgramTree::Build(y.value())); }, 116 subp.u); 117 } 118 } 119 return node; 120 } 121 122 ProgramTree ProgramTree::Build(const parser::ProgramUnit &x) { 123 return common::visit([](const auto &y) { return Build(y.value()); }, x.u); 124 } 125 126 ProgramTree ProgramTree::Build(const parser::MainProgram &x) { 127 const auto &stmt{ 128 std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(x.t)}; 129 const auto &end{std::get<parser::Statement<parser::EndProgramStmt>>(x.t)}; 130 static parser::Name emptyName; 131 auto result{stmt ? BuildSubprogramTree(stmt->statement.v, x).set_stmt(*stmt) 132 : BuildSubprogramTree(emptyName, x)}; 133 return result.set_endStmt(end); 134 } 135 136 ProgramTree ProgramTree::Build(const parser::FunctionSubprogram &x) { 137 const auto &stmt{std::get<parser::Statement<parser::FunctionStmt>>(x.t)}; 138 const auto &end{std::get<parser::Statement<parser::EndFunctionStmt>>(x.t)}; 139 const auto &name{std::get<parser::Name>(stmt.statement.t)}; 140 const parser::LanguageBindingSpec *bindingSpec{}; 141 if (const auto &suffix{ 142 std::get<std::optional<parser::Suffix>>(stmt.statement.t)}) { 143 if (suffix->binding) { 144 bindingSpec = &*suffix->binding; 145 } 146 } 147 return BuildSubprogramTree(name, x) 148 .set_stmt(stmt) 149 .set_endStmt(end) 150 .set_bindingSpec(bindingSpec); 151 } 152 153 ProgramTree ProgramTree::Build(const parser::SubroutineSubprogram &x) { 154 const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)}; 155 const auto &end{std::get<parser::Statement<parser::EndSubroutineStmt>>(x.t)}; 156 const auto &name{std::get<parser::Name>(stmt.statement.t)}; 157 const parser::LanguageBindingSpec *bindingSpec{}; 158 if (const auto &binding{std::get<std::optional<parser::LanguageBindingSpec>>( 159 stmt.statement.t)}) { 160 bindingSpec = &*binding; 161 } 162 return BuildSubprogramTree(name, x) 163 .set_stmt(stmt) 164 .set_endStmt(end) 165 .set_bindingSpec(bindingSpec); 166 } 167 168 ProgramTree ProgramTree::Build(const parser::SeparateModuleSubprogram &x) { 169 const auto &stmt{std::get<parser::Statement<parser::MpSubprogramStmt>>(x.t)}; 170 const auto &end{ 171 std::get<parser::Statement<parser::EndMpSubprogramStmt>>(x.t)}; 172 const auto &name{stmt.statement.v}; 173 return BuildSubprogramTree(name, x).set_stmt(stmt).set_endStmt(end); 174 } 175 176 ProgramTree ProgramTree::Build(const parser::Module &x) { 177 const auto &stmt{std::get<parser::Statement<parser::ModuleStmt>>(x.t)}; 178 const auto &end{std::get<parser::Statement<parser::EndModuleStmt>>(x.t)}; 179 const auto &name{stmt.statement.v}; 180 return BuildModuleTree(name, x).set_stmt(stmt).set_endStmt(end); 181 } 182 183 ProgramTree ProgramTree::Build(const parser::Submodule &x) { 184 const auto &stmt{std::get<parser::Statement<parser::SubmoduleStmt>>(x.t)}; 185 const auto &end{std::get<parser::Statement<parser::EndSubmoduleStmt>>(x.t)}; 186 const auto &name{std::get<parser::Name>(stmt.statement.t)}; 187 return BuildModuleTree(name, x).set_stmt(stmt).set_endStmt(end); 188 } 189 190 ProgramTree ProgramTree::Build(const parser::BlockData &x) { 191 const auto &stmt{std::get<parser::Statement<parser::BlockDataStmt>>(x.t)}; 192 const auto &end{std::get<parser::Statement<parser::EndBlockDataStmt>>(x.t)}; 193 static parser::Name emptyName; 194 auto result{stmt.statement.v ? BuildSubprogramTree(*stmt.statement.v, x) 195 : BuildSubprogramTree(emptyName, x)}; 196 return result.set_stmt(stmt).set_endStmt(end); 197 } 198 199 ProgramTree ProgramTree::Build(const parser::CompilerDirective &) { 200 DIE("ProgramTree::Build() called for CompilerDirective"); 201 } 202 203 const parser::ParentIdentifier &ProgramTree::GetParentId() const { 204 const auto *stmt{ 205 std::get<const parser::Statement<parser::SubmoduleStmt> *>(stmt_)}; 206 return std::get<parser::ParentIdentifier>(stmt->statement.t); 207 } 208 209 bool ProgramTree::IsModule() const { 210 auto kind{GetKind()}; 211 return kind == Kind::Module || kind == Kind::Submodule; 212 } 213 214 Symbol::Flag ProgramTree::GetSubpFlag() const { 215 return GetKind() == Kind::Function ? Symbol::Flag::Function 216 : Symbol::Flag::Subroutine; 217 } 218 219 bool ProgramTree::HasModulePrefix() const { 220 using ListType = std::list<parser::PrefixSpec>; 221 const auto *prefixes{common::visit( 222 common::visitors{ 223 [](const parser::Statement<parser::FunctionStmt> *x) { 224 return &std::get<ListType>(x->statement.t); 225 }, 226 [](const parser::Statement<parser::SubroutineStmt> *x) { 227 return &std::get<ListType>(x->statement.t); 228 }, 229 [](const auto *) -> const ListType * { return nullptr; }, 230 }, 231 stmt_)}; 232 if (prefixes) { 233 for (const auto &prefix : *prefixes) { 234 if (std::holds_alternative<parser::PrefixSpec::Module>(prefix.u)) { 235 return true; 236 } 237 } 238 } 239 return false; 240 } 241 242 ProgramTree::Kind ProgramTree::GetKind() const { 243 return common::visit( 244 common::visitors{ 245 [](const parser::Statement<parser::ProgramStmt> *) { 246 return Kind::Program; 247 }, 248 [](const parser::Statement<parser::FunctionStmt> *) { 249 return Kind::Function; 250 }, 251 [](const parser::Statement<parser::SubroutineStmt> *) { 252 return Kind::Subroutine; 253 }, 254 [](const parser::Statement<parser::MpSubprogramStmt> *) { 255 return Kind::MpSubprogram; 256 }, 257 [](const parser::Statement<parser::ModuleStmt> *) { 258 return Kind::Module; 259 }, 260 [](const parser::Statement<parser::SubmoduleStmt> *) { 261 return Kind::Submodule; 262 }, 263 [](const parser::Statement<parser::BlockDataStmt> *) { 264 return Kind::BlockData; 265 }, 266 }, 267 stmt_); 268 } 269 270 void ProgramTree::set_scope(Scope &scope) { 271 scope_ = &scope; 272 CHECK(endStmt_); 273 scope.AddSourceRange(*endStmt_); 274 } 275 276 void ProgramTree::AddChild(ProgramTree &&child) { 277 children_.emplace_back(std::move(child)); 278 } 279 280 void ProgramTree::AddEntry(const parser::EntryStmt &entryStmt) { 281 entryStmts_.emplace_back(entryStmt); 282 } 283 284 void ProgramTree::AddGeneric(const parser::GenericSpec &generic) { 285 genericSpecs_.emplace_back(generic); 286 } 287 288 } // namespace Fortran::semantics 289