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 | |