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 
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 
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 template <typename T>
48 static ProgramTree BuildSubprogramTree(const parser::Name &name, const T &x) {
49   const auto &spec{std::get<parser::SpecificationPart>(x.t)};
50   const auto &exec{std::get<parser::ExecutionPart>(x.t)};
51   const auto &subps{
52       std::get<std::optional<parser::InternalSubprogramPart>>(x.t)};
53   ProgramTree node{name, spec, &exec};
54   GetEntryStmts(node, spec);
55   GetEntryStmts(node, exec);
56   if (subps) {
57     for (const auto &subp :
58         std::get<std::list<parser::InternalSubprogram>>(subps->t)) {
59       std::visit(
60           [&](const auto &y) { node.AddChild(ProgramTree::Build(y.value())); },
61           subp.u);
62     }
63   }
64   return node;
65 }
66 
67 static ProgramTree BuildSubprogramTree(
68     const parser::Name &name, const parser::BlockData &x) {
69   const auto &spec{std::get<parser::SpecificationPart>(x.t)};
70   return ProgramTree{name, spec};
71 }
72 
73 template <typename T>
74 static ProgramTree BuildModuleTree(const parser::Name &name, const T &x) {
75   const auto &spec{std::get<parser::SpecificationPart>(x.t)};
76   const auto &subps{std::get<std::optional<parser::ModuleSubprogramPart>>(x.t)};
77   ProgramTree node{name, spec};
78   if (subps) {
79     for (const auto &subp :
80         std::get<std::list<parser::ModuleSubprogram>>(subps->t)) {
81       std::visit(
82           [&](const auto &y) { node.AddChild(ProgramTree::Build(y.value())); },
83           subp.u);
84     }
85   }
86   return node;
87 }
88 
89 ProgramTree ProgramTree::Build(const parser::ProgramUnit &x) {
90   return std::visit([](const auto &y) { return Build(y.value()); }, x.u);
91 }
92 
93 ProgramTree ProgramTree::Build(const parser::MainProgram &x) {
94   const auto &stmt{
95       std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(x.t)};
96   const auto &end{std::get<parser::Statement<parser::EndProgramStmt>>(x.t)};
97   static parser::Name emptyName;
98   auto result{stmt ? BuildSubprogramTree(stmt->statement.v, x).set_stmt(*stmt)
99                    : BuildSubprogramTree(emptyName, x)};
100   return result.set_endStmt(end);
101 }
102 
103 ProgramTree ProgramTree::Build(const parser::FunctionSubprogram &x) {
104   const auto &stmt{std::get<parser::Statement<parser::FunctionStmt>>(x.t)};
105   const auto &end{std::get<parser::Statement<parser::EndFunctionStmt>>(x.t)};
106   const auto &name{std::get<parser::Name>(stmt.statement.t)};
107   return BuildSubprogramTree(name, x).set_stmt(stmt).set_endStmt(end);
108 }
109 
110 ProgramTree ProgramTree::Build(const parser::SubroutineSubprogram &x) {
111   const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)};
112   const auto &end{std::get<parser::Statement<parser::EndSubroutineStmt>>(x.t)};
113   const auto &name{std::get<parser::Name>(stmt.statement.t)};
114   return BuildSubprogramTree(name, x).set_stmt(stmt).set_endStmt(end);
115 }
116 
117 ProgramTree ProgramTree::Build(const parser::SeparateModuleSubprogram &x) {
118   const auto &stmt{std::get<parser::Statement<parser::MpSubprogramStmt>>(x.t)};
119   const auto &end{
120       std::get<parser::Statement<parser::EndMpSubprogramStmt>>(x.t)};
121   const auto &name{stmt.statement.v};
122   return BuildSubprogramTree(name, x).set_stmt(stmt).set_endStmt(end);
123 }
124 
125 ProgramTree ProgramTree::Build(const parser::Module &x) {
126   const auto &stmt{std::get<parser::Statement<parser::ModuleStmt>>(x.t)};
127   const auto &end{std::get<parser::Statement<parser::EndModuleStmt>>(x.t)};
128   const auto &name{stmt.statement.v};
129   return BuildModuleTree(name, x).set_stmt(stmt).set_endStmt(end);
130 }
131 
132 ProgramTree ProgramTree::Build(const parser::Submodule &x) {
133   const auto &stmt{std::get<parser::Statement<parser::SubmoduleStmt>>(x.t)};
134   const auto &end{std::get<parser::Statement<parser::EndSubmoduleStmt>>(x.t)};
135   const auto &name{std::get<parser::Name>(stmt.statement.t)};
136   return BuildModuleTree(name, x).set_stmt(stmt).set_endStmt(end);
137 }
138 
139 ProgramTree ProgramTree::Build(const parser::BlockData &x) {
140   const auto &stmt{std::get<parser::Statement<parser::BlockDataStmt>>(x.t)};
141   const auto &end{std::get<parser::Statement<parser::EndBlockDataStmt>>(x.t)};
142   static parser::Name emptyName;
143   auto result{stmt.statement.v ? BuildSubprogramTree(*stmt.statement.v, x)
144                                : BuildSubprogramTree(emptyName, x)};
145   return result.set_stmt(stmt).set_endStmt(end);
146 }
147 
148 ProgramTree ProgramTree::Build(const parser::CompilerDirective &) {
149   DIE("ProgramTree::Build() called for CompilerDirective");
150 }
151 
152 const parser::ParentIdentifier &ProgramTree::GetParentId() const {
153   const auto *stmt{
154       std::get<const parser::Statement<parser::SubmoduleStmt> *>(stmt_)};
155   return std::get<parser::ParentIdentifier>(stmt->statement.t);
156 }
157 
158 bool ProgramTree::IsModule() const {
159   auto kind{GetKind()};
160   return kind == Kind::Module || kind == Kind::Submodule;
161 }
162 
163 Symbol::Flag ProgramTree::GetSubpFlag() const {
164   return GetKind() == Kind::Function ? Symbol::Flag::Function
165                                      : Symbol::Flag::Subroutine;
166 }
167 
168 bool ProgramTree::HasModulePrefix() const {
169   using ListType = std::list<parser::PrefixSpec>;
170   const auto *prefixes{
171       std::visit(common::visitors{
172                      [](const parser::Statement<parser::FunctionStmt> *x) {
173                        return &std::get<ListType>(x->statement.t);
174                      },
175                      [](const parser::Statement<parser::SubroutineStmt> *x) {
176                        return &std::get<ListType>(x->statement.t);
177                      },
178                      [](const auto *) -> const ListType * { return nullptr; },
179                  },
180           stmt_)};
181   if (prefixes) {
182     for (const auto &prefix : *prefixes) {
183       if (std::holds_alternative<parser::PrefixSpec::Module>(prefix.u)) {
184         return true;
185       }
186     }
187   }
188   return false;
189 }
190 
191 ProgramTree::Kind ProgramTree::GetKind() const {
192   return std::visit(
193       common::visitors{
194           [](const parser::Statement<parser::ProgramStmt> *) {
195             return Kind::Program;
196           },
197           [](const parser::Statement<parser::FunctionStmt> *) {
198             return Kind::Function;
199           },
200           [](const parser::Statement<parser::SubroutineStmt> *) {
201             return Kind::Subroutine;
202           },
203           [](const parser::Statement<parser::MpSubprogramStmt> *) {
204             return Kind::MpSubprogram;
205           },
206           [](const parser::Statement<parser::ModuleStmt> *) {
207             return Kind::Module;
208           },
209           [](const parser::Statement<parser::SubmoduleStmt> *) {
210             return Kind::Submodule;
211           },
212           [](const parser::Statement<parser::BlockDataStmt> *) {
213             return Kind::BlockData;
214           },
215       },
216       stmt_);
217 }
218 
219 void ProgramTree::set_scope(Scope &scope) {
220   scope_ = &scope;
221   CHECK(endStmt_);
222   scope.AddSourceRange(*endStmt_);
223 }
224 
225 void ProgramTree::AddChild(ProgramTree &&child) {
226   children_.emplace_back(std::move(child));
227 }
228 
229 void ProgramTree::AddEntry(const parser::EntryStmt &entryStmt) {
230   entryStmts_.emplace_back(entryStmt);
231 }
232 
233 } // namespace Fortran::semantics
234