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 
GetEntryStmts(ProgramTree & node,const parser::SpecificationPart & spec)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 
GetEntryStmts(ProgramTree & node,const parser::ExecutionPart & exec)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.
GetGenerics(ProgramTree & node,const parser::SpecificationPart & spec)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>
BuildSubprogramTree(const parser::Name & name,const T & x)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 
BuildSubprogramTree(const parser::Name & name,const parser::BlockData & x)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>
BuildModuleTree(const parser::Name & name,const T & x)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 
Build(const parser::ProgramUnit & x)122 ProgramTree ProgramTree::Build(const parser::ProgramUnit &x) {
123   return common::visit([](const auto &y) { return Build(y.value()); }, x.u);
124 }
125 
Build(const parser::MainProgram & x)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 
Build(const parser::FunctionSubprogram & x)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   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 
Build(const parser::SubroutineSubprogram & x)153 ProgramTree 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 
Build(const parser::SeparateModuleSubprogram & x)168 ProgramTree 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 
Build(const parser::Module & x)176 ProgramTree 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 
Build(const parser::Submodule & x)183 ProgramTree 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 
Build(const parser::BlockData & x)190 ProgramTree 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 
Build(const parser::CompilerDirective &)199 ProgramTree ProgramTree::Build(const parser::CompilerDirective &) {
200   DIE("ProgramTree::Build() called for CompilerDirective");
201 }
202 
GetParentId() const203 const parser::ParentIdentifier &ProgramTree::GetParentId() const {
204   const auto *stmt{
205       std::get<const parser::Statement<parser::SubmoduleStmt> *>(stmt_)};
206   return std::get<parser::ParentIdentifier>(stmt->statement.t);
207 }
208 
IsModule() const209 bool ProgramTree::IsModule() const {
210   auto kind{GetKind()};
211   return kind == Kind::Module || kind == Kind::Submodule;
212 }
213 
GetSubpFlag() const214 Symbol::Flag ProgramTree::GetSubpFlag() const {
215   return GetKind() == Kind::Function ? Symbol::Flag::Function
216                                      : Symbol::Flag::Subroutine;
217 }
218 
HasModulePrefix() const219 bool ProgramTree::HasModulePrefix() const {
220   using ListType = std::list<parser::PrefixSpec>;
221   const auto *prefixes{common::visit(
222       common::visitors{
223           [](const parser::Statement<parser::FunctionStmt> *x) {
224             return &std::get<ListType>(x->statement.t);
225           },
226           [](const parser::Statement<parser::SubroutineStmt> *x) {
227             return &std::get<ListType>(x->statement.t);
228           },
229           [](const auto *) -> const ListType * { return nullptr; },
230       },
231       stmt_)};
232   if (prefixes) {
233     for (const auto &prefix : *prefixes) {
234       if (std::holds_alternative<parser::PrefixSpec::Module>(prefix.u)) {
235         return true;
236       }
237     }
238   }
239   return false;
240 }
241 
GetKind() const242 ProgramTree::Kind ProgramTree::GetKind() const {
243   return common::visit(
244       common::visitors{
245           [](const parser::Statement<parser::ProgramStmt> *) {
246             return Kind::Program;
247           },
248           [](const parser::Statement<parser::FunctionStmt> *) {
249             return Kind::Function;
250           },
251           [](const parser::Statement<parser::SubroutineStmt> *) {
252             return Kind::Subroutine;
253           },
254           [](const parser::Statement<parser::MpSubprogramStmt> *) {
255             return Kind::MpSubprogram;
256           },
257           [](const parser::Statement<parser::ModuleStmt> *) {
258             return Kind::Module;
259           },
260           [](const parser::Statement<parser::SubmoduleStmt> *) {
261             return Kind::Submodule;
262           },
263           [](const parser::Statement<parser::BlockDataStmt> *) {
264             return Kind::BlockData;
265           },
266       },
267       stmt_);
268 }
269 
set_scope(Scope & scope)270 void ProgramTree::set_scope(Scope &scope) {
271   scope_ = &scope;
272   CHECK(endStmt_);
273   scope.AddSourceRange(*endStmt_);
274 }
275 
AddChild(ProgramTree && child)276 void ProgramTree::AddChild(ProgramTree &&child) {
277   children_.emplace_back(std::move(child));
278 }
279 
AddEntry(const parser::EntryStmt & entryStmt)280 void ProgramTree::AddEntry(const parser::EntryStmt &entryStmt) {
281   entryStmts_.emplace_back(entryStmt);
282 }
283 
AddGeneric(const parser::GenericSpec & generic)284 void ProgramTree::AddGeneric(const parser::GenericSpec &generic) {
285   genericSpecs_.emplace_back(generic);
286 }
287 
288 } // namespace Fortran::semantics
289