xref: /llvm-project/flang/lib/Semantics/program-tree.cpp (revision 4f2b65fb80a4b27e5fb88db816ed0ce174c9b1b4) 
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
329