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 "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
  15 namespace Fortran::semantics {
  16
  17 static 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
  37 static 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 include
  49 // identically-named subprograms as specific procedures.
  50 static 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
  79 template <typename T>
  80 static 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
 105 static 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
 111 template <typename T>
 112 static 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
 133 ProgramTree &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
 144 std::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{stmt
 151           ? BuildSubprogramTree(stmt->statement.v, context, x).set_stmt(*stmt)
 152           : BuildSubprogramTree(emptyName, context, x)};
 153   return std::move(result.set_endStmt(end));
 154 }
 155
 156 std::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
 174 std::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
 190 std::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
 199 std::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
 207 std::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
 215 std::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.v
 221           ? BuildSubprogramTree(*stmt.statement.v, context, x)
 222           : BuildSubprogramTree(emptyName, context, x)};
 223   return std::move(result.set_stmt(stmt).set_endStmt(end));
 224 }
 225
 226 std::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
 234 std::optional<ProgramTree> ProgramTree::Build(
 235     const parser::OpenACCRoutineConstruct &, SemanticsContext &) {
 236   DIE("ProgramTree::Build() called for OpenACCRoutineConstruct");
 237 }
 238
 239 const 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
 245 bool ProgramTree::IsModule() const {
 246   auto kind{GetKind()};
 247   return kind == Kind::Module || kind == Kind::Submodule;
 248 }
 249
 250 Symbol::Flag ProgramTree::GetSubpFlag() const {
 251   return GetKind() == Kind::Function ? Symbol::Flag::Function
 252                                      : Symbol::Flag::Subroutine;
 253 }
 254
 255 bool ProgramTree::HasModulePrefix() const {
 256   if (std::holds_alternative<
 257           const parser::Statement<parser::MpSubprogramStmt> *>(stmt_)) {
 258     return true; // MODULE PROCEDURE foo
 259   }
 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
 282 ProgramTree::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
 310 void ProgramTree::set_scope(Scope &scope) {
 311   scope_ = &scope;
 312   CHECK(endStmt_);
 313   scope.AddSourceRange(*endStmt_);
 314 }
 315
 316 void ProgramTree::AddChild(ProgramTree &&child) {
 317   children_.emplace_back(std::move(child));
 318 }
 319
 320 void ProgramTree::AddEntry(const parser::EntryStmt &entryStmt) {
 321   entryStmts_.emplace_back(entryStmt);
 322 }
 323
 324 void ProgramTree::AddGeneric(const parser::GenericSpec &generic) {
 325   genericSpecs_.emplace_back(generic);
 326 }
 327
 328 } // namespace Fortran::semantics