flang/lib/Semantics/program-tree.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-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   if (std::holds_alternative<
 221           const parser::Statement<parser::MpSubprogramStmt> *>(stmt_)) {
 222     return true; // MODULE PROCEDURE foo
 223   }
 224   using ListType = std::list<parser::PrefixSpec>;
 225   const auto *prefixes{common::visit(
 226       common::visitors{
 227           [](const parser::Statement<parser::FunctionStmt> *x) {
 228             return &std::get<ListType>(x->statement.t);
 229           },
 230           [](const parser::Statement<parser::SubroutineStmt> *x) {
 231             return &std::get<ListType>(x->statement.t);
 232           },
 233           [](const auto *) -> const ListType * { return nullptr; },
 234       },
 235       stmt_)};
 236   if (prefixes) {
 237     for (const auto &prefix : *prefixes) {
 238       if (std::holds_alternative<parser::PrefixSpec::Module>(prefix.u)) {
 239         return true;
 240       }
 241     }
 242   }
 243   return false;
 244 }
 245
 246 ProgramTree::Kind ProgramTree::GetKind() const {
 247   return common::visit(
 248       common::visitors{
 249           [](const parser::Statement<parser::ProgramStmt> *) {
 250             return Kind::Program;
 251           },
 252           [](const parser::Statement<parser::FunctionStmt> *) {
 253             return Kind::Function;
 254           },
 255           [](const parser::Statement<parser::SubroutineStmt> *) {
 256             return Kind::Subroutine;
 257           },
 258           [](const parser::Statement<parser::MpSubprogramStmt> *) {
 259             return Kind::MpSubprogram;
 260           },
 261           [](const parser::Statement<parser::ModuleStmt> *) {
 262             return Kind::Module;
 263           },
 264           [](const parser::Statement<parser::SubmoduleStmt> *) {
 265             return Kind::Submodule;
 266           },
 267           [](const parser::Statement<parser::BlockDataStmt> *) {
 268             return Kind::BlockData;
 269           },
 270       },
 271       stmt_);
 272 }
 273
 274 void ProgramTree::set_scope(Scope &scope) {
 275   scope_ = &scope;
 276   CHECK(endStmt_);
 277   scope.AddSourceRange(*endStmt_);
 278 }
 279
 280 void ProgramTree::AddChild(ProgramTree &&child) {
 281   children_.emplace_back(std::move(child));
 282 }
 283
 284 void ProgramTree::AddEntry(const parser::EntryStmt &entryStmt) {
 285   entryStmts_.emplace_back(entryStmt);
 286 }
 287
 288 void ProgramTree::AddGeneric(const parser::GenericSpec &generic) {
 289   genericSpecs_.emplace_back(generic);
 290 }
 291
 292 } // namespace Fortran::semantics