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
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 include
49// 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{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
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.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
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::Function
252 : 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 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
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::semantics
329

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