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
14namespace Fortran::semantics {
15
16static 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
36static 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.
49static 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
78template <typename T>
79static 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
99static 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
105template <typename T>
106static 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
122ProgramTree ProgramTree::Build(const parser::ProgramUnit &x) {
123 return common::visit([](const auto &y) { return Build(y.value()); }, x.u);
124}
125
126ProgramTree 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
136ProgramTree 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
153ProgramTree 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
168ProgramTree 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
176ProgramTree 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
183ProgramTree 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
190ProgramTree 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
199ProgramTree ProgramTree::Build(const parser::CompilerDirective &) {
200 DIE("ProgramTree::Build() called for CompilerDirective");
201}
202
203ProgramTree ProgramTree::Build(const parser::OpenACCRoutineConstruct &) {
204 DIE("ProgramTree::Build() called for OpenACCRoutineConstruct");
205}
206
207const parser::ParentIdentifier &ProgramTree::GetParentId() const {
208 const auto *stmt{
209 std::get<const parser::Statement<parser::SubmoduleStmt> *>(stmt_)};
210 return std::get<parser::ParentIdentifier>(stmt->statement.t);
211}
212
213bool ProgramTree::IsModule() const {
214 auto kind{GetKind()};
215 return kind == Kind::Module || kind == Kind::Submodule;
216}
217
218Symbol::Flag ProgramTree::GetSubpFlag() const {
219 return GetKind() == Kind::Function ? Symbol::Flag::Function
220 : Symbol::Flag::Subroutine;
221}
222
223bool ProgramTree::HasModulePrefix() const {
224 if (std::holds_alternative<
225 const parser::Statement<parser::MpSubprogramStmt> *>(stmt_)) {
226 return true; // MODULE PROCEDURE foo
227 }
228 using ListType = std::list<parser::PrefixSpec>;
229 const auto *prefixes{common::visit(
230 common::visitors{
231 [](const parser::Statement<parser::FunctionStmt> *x) {
232 return &std::get<ListType>(x->statement.t);
233 },
234 [](const parser::Statement<parser::SubroutineStmt> *x) {
235 return &std::get<ListType>(x->statement.t);
236 },
237 [](const auto *) -> const ListType * { return nullptr; },
238 },
239 stmt_)};
240 if (prefixes) {
241 for (const auto &prefix : *prefixes) {
242 if (std::holds_alternative<parser::PrefixSpec::Module>(prefix.u)) {
243 return true;
244 }
245 }
246 }
247 return false;
248}
249
250ProgramTree::Kind ProgramTree::GetKind() const {
251 return common::visit(
252 common::visitors{
253 [](const parser::Statement<parser::ProgramStmt> *) {
254 return Kind::Program;
255 },
256 [](const parser::Statement<parser::FunctionStmt> *) {
257 return Kind::Function;
258 },
259 [](const parser::Statement<parser::SubroutineStmt> *) {
260 return Kind::Subroutine;
261 },
262 [](const parser::Statement<parser::MpSubprogramStmt> *) {
263 return Kind::MpSubprogram;
264 },
265 [](const parser::Statement<parser::ModuleStmt> *) {
266 return Kind::Module;
267 },
268 [](const parser::Statement<parser::SubmoduleStmt> *) {
269 return Kind::Submodule;
270 },
271 [](const parser::Statement<parser::BlockDataStmt> *) {
272 return Kind::BlockData;
273 },
274 },
275 stmt_);
276}
277
278void ProgramTree::set_scope(Scope &scope) {
279 scope_ = &scope;
280 CHECK(endStmt_);
281 scope.AddSourceRange(*endStmt_);
282}
283
284void ProgramTree::AddChild(ProgramTree &&child) {
285 children_.emplace_back(args: std::move(child));
286}
287
288void ProgramTree::AddEntry(const parser::EntryStmt &entryStmt) {
289 entryStmts_.emplace_back(entryStmt);
290}
291
292void ProgramTree::AddGeneric(const parser::GenericSpec &generic) {
293 genericSpecs_.emplace_back(generic);
294}
295
296} // namespace Fortran::semantics
297

source code of flang/lib/Semantics/program-tree.cpp