xref: /llvm-project/flang/lib/Semantics/program-tree.cpp (revision 2ab9990c9eb79682a4d4b183dfbc7612d3e55328) 
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   return BuildSubprogramTree(name, x).set_stmt(stmt).set_endStmt(end);
141 }
142 
143 ProgramTree ProgramTree::Build(const parser::SubroutineSubprogram &x) {
144   const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)};
145   const auto &end{std::get<parser::Statement<parser::EndSubroutineStmt>>(x.t)};
146   const auto &name{std::get<parser::Name>(stmt.statement.t)};
147   return BuildSubprogramTree(name, x).set_stmt(stmt).set_endStmt(end);
148 }
149 
150 ProgramTree ProgramTree::Build(const parser::SeparateModuleSubprogram &x) {
151   const auto &stmt{std::get<parser::Statement<parser::MpSubprogramStmt>>(x.t)};
152   const auto &end{
153       std::get<parser::Statement<parser::EndMpSubprogramStmt>>(x.t)};
154   const auto &name{stmt.statement.v};
155   return BuildSubprogramTree(name, x).set_stmt(stmt).set_endStmt(end);
156 }
157 
158 ProgramTree ProgramTree::Build(const parser::Module &x) {
159   const auto &stmt{std::get<parser::Statement<parser::ModuleStmt>>(x.t)};
160   const auto &end{std::get<parser::Statement<parser::EndModuleStmt>>(x.t)};
161   const auto &name{stmt.statement.v};
162   return BuildModuleTree(name, x).set_stmt(stmt).set_endStmt(end);
163 }
164 
165 ProgramTree ProgramTree::Build(const parser::Submodule &x) {
166   const auto &stmt{std::get<parser::Statement<parser::SubmoduleStmt>>(x.t)};
167   const auto &end{std::get<parser::Statement<parser::EndSubmoduleStmt>>(x.t)};
168   const auto &name{std::get<parser::Name>(stmt.statement.t)};
169   return BuildModuleTree(name, x).set_stmt(stmt).set_endStmt(end);
170 }
171 
172 ProgramTree ProgramTree::Build(const parser::BlockData &x) {
173   const auto &stmt{std::get<parser::Statement<parser::BlockDataStmt>>(x.t)};
174   const auto &end{std::get<parser::Statement<parser::EndBlockDataStmt>>(x.t)};
175   static parser::Name emptyName;
176   auto result{stmt.statement.v ? BuildSubprogramTree(*stmt.statement.v, x)
177                                : BuildSubprogramTree(emptyName, x)};
178   return result.set_stmt(stmt).set_endStmt(end);
179 }
180 
181 ProgramTree ProgramTree::Build(const parser::CompilerDirective &) {
182   DIE("ProgramTree::Build() called for CompilerDirective");
183 }
184 
185 const parser::ParentIdentifier &ProgramTree::GetParentId() const {
186   const auto *stmt{
187       std::get<const parser::Statement<parser::SubmoduleStmt> *>(stmt_)};
188   return std::get<parser::ParentIdentifier>(stmt->statement.t);
189 }
190 
191 bool ProgramTree::IsModule() const {
192   auto kind{GetKind()};
193   return kind == Kind::Module || kind == Kind::Submodule;
194 }
195 
196 Symbol::Flag ProgramTree::GetSubpFlag() const {
197   return GetKind() == Kind::Function ? Symbol::Flag::Function
198                                      : Symbol::Flag::Subroutine;
199 }
200 
201 bool ProgramTree::HasModulePrefix() const {
202   using ListType = std::list<parser::PrefixSpec>;
203   const auto *prefixes{common::visit(
204       common::visitors{
205           [](const parser::Statement<parser::FunctionStmt> *x) {
206             return &std::get<ListType>(x->statement.t);
207           },
208           [](const parser::Statement<parser::SubroutineStmt> *x) {
209             return &std::get<ListType>(x->statement.t);
210           },
211           [](const auto *) -> const ListType * { return nullptr; },
212       },
213       stmt_)};
214   if (prefixes) {
215     for (const auto &prefix : *prefixes) {
216       if (std::holds_alternative<parser::PrefixSpec::Module>(prefix.u)) {
217         return true;
218       }
219     }
220   }
221   return false;
222 }
223 
224 ProgramTree::Kind ProgramTree::GetKind() const {
225   return common::visit(
226       common::visitors{
227           [](const parser::Statement<parser::ProgramStmt> *) {
228             return Kind::Program;
229           },
230           [](const parser::Statement<parser::FunctionStmt> *) {
231             return Kind::Function;
232           },
233           [](const parser::Statement<parser::SubroutineStmt> *) {
234             return Kind::Subroutine;
235           },
236           [](const parser::Statement<parser::MpSubprogramStmt> *) {
237             return Kind::MpSubprogram;
238           },
239           [](const parser::Statement<parser::ModuleStmt> *) {
240             return Kind::Module;
241           },
242           [](const parser::Statement<parser::SubmoduleStmt> *) {
243             return Kind::Submodule;
244           },
245           [](const parser::Statement<parser::BlockDataStmt> *) {
246             return Kind::BlockData;
247           },
248       },
249       stmt_);
250 }
251 
252 void ProgramTree::set_scope(Scope &scope) {
253   scope_ = &scope;
254   CHECK(endStmt_);
255   scope.AddSourceRange(*endStmt_);
256 }
257 
258 void ProgramTree::AddChild(ProgramTree &&child) {
259   children_.emplace_back(std::move(child));
260 }
261 
262 void ProgramTree::AddEntry(const parser::EntryStmt &entryStmt) {
263   entryStmts_.emplace_back(entryStmt);
264 }
265 
266 void ProgramTree::AddGeneric(const parser::GenericSpec &generic) {
267   genericSpecs_.emplace_back(generic);
268 }
269 
270 } // namespace Fortran::semantics
271