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