1 //===-- lib/Lower/PFTBuilder.cc -------------------------------------------===//
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/Lower/PFTBuilder.h"
10 #include "flang/Parser/dump-parse-tree.h"
11 #include "flang/Parser/parse-tree-visitor.h"
12 #include "llvm/ADT/DenseMap.h"
13 #include <algorithm>
14 #include <cassert>
15 #include <utility>
16 
17 namespace Fortran::lower {
18 namespace {
19 
20 /// Helpers to unveil parser node inside parser::Statement<>,
21 /// parser::UnlabeledStatement, and common::Indirection<>
22 template <typename A>
23 struct RemoveIndirectionHelper {
24   using Type = A;
25   static constexpr const Type &unwrap(const A &a) { return a; }
26 };
27 template <typename A>
28 struct RemoveIndirectionHelper<common::Indirection<A>> {
29   using Type = A;
30   static constexpr const Type &unwrap(const common::Indirection<A> &a) {
31     return a.value();
32   }
33 };
34 
35 template <typename A>
36 const auto &removeIndirection(const A &a) {
37   return RemoveIndirectionHelper<A>::unwrap(a);
38 }
39 
40 template <typename A>
41 struct UnwrapStmt {
42   static constexpr bool isStmt{false};
43 };
44 template <typename A>
45 struct UnwrapStmt<parser::Statement<A>> {
46   static constexpr bool isStmt{true};
47   using Type = typename RemoveIndirectionHelper<A>::Type;
48   constexpr UnwrapStmt(const parser::Statement<A> &a)
49       : unwrapped{removeIndirection(a.statement)}, pos{a.source}, lab{a.label} {
50   }
51   const Type &unwrapped;
52   parser::CharBlock pos;
53   std::optional<parser::Label> lab;
54 };
55 template <typename A>
56 struct UnwrapStmt<parser::UnlabeledStatement<A>> {
57   static constexpr bool isStmt{true};
58   using Type = typename RemoveIndirectionHelper<A>::Type;
59   constexpr UnwrapStmt(const parser::UnlabeledStatement<A> &a)
60       : unwrapped{removeIndirection(a.statement)}, pos{a.source} {}
61   const Type &unwrapped;
62   parser::CharBlock pos;
63   std::optional<parser::Label> lab;
64 };
65 
66 /// The instantiation of a parse tree visitor (Pre and Post) is extremely
67 /// expensive in terms of compile and link time, so one goal here is to limit
68 /// the bridge to one such instantiation.
69 class PFTBuilder {
70 public:
71   PFTBuilder() : pgm{new pft::Program}, parents{*pgm.get()} {}
72 
73   /// Get the result
74   std::unique_ptr<pft::Program> result() { return std::move(pgm); }
75 
76   template <typename A>
77   constexpr bool Pre(const A &a) {
78     bool visit{true};
79     if constexpr (pft::isFunctionLike<A>) {
80       return enterFunc(a);
81     } else if constexpr (pft::isConstruct<A>) {
82       return enterConstruct(a);
83     } else if constexpr (UnwrapStmt<A>::isStmt) {
84       using T = typename UnwrapStmt<A>::Type;
85       // Node "a" being visited has one of the following types:
86       // Statement<T>, Statement<Indirection<T>, UnlabeledStatement<T>,
87       // or UnlabeledStatement<Indirection<T>>
88       auto stmt{UnwrapStmt<A>(a)};
89       if constexpr (pft::isConstructStmt<T> || pft::isOtherStmt<T>) {
90         addEval(pft::Evaluation{stmt.unwrapped, parents.back(), stmt.pos,
91                                 stmt.lab});
92         visit = false;
93       } else if constexpr (std::is_same_v<T, parser::ActionStmt>) {
94         addEval(makeEvalAction(stmt.unwrapped, stmt.pos, stmt.lab));
95         visit = false;
96       }
97     }
98     return visit;
99   }
100 
101   template <typename A>
102   constexpr void Post(const A &) {
103     if constexpr (pft::isFunctionLike<A>) {
104       exitFunc();
105     } else if constexpr (pft::isConstruct<A>) {
106       exitConstruct();
107     }
108   }
109 
110   // Module like
111   bool Pre(const parser::Module &node) { return enterModule(node); }
112   bool Pre(const parser::Submodule &node) { return enterModule(node); }
113 
114   void Post(const parser::Module &) { exitModule(); }
115   void Post(const parser::Submodule &) { exitModule(); }
116 
117   // Block data
118   bool Pre(const parser::BlockData &node) {
119     addUnit(pft::BlockDataUnit{node, parents.back()});
120     return false;
121   }
122 
123   // Get rid of production wrapper
124   bool Pre(const parser::UnlabeledStatement<parser::ForallAssignmentStmt>
125                &statement) {
126     addEval(std::visit(
127         [&](const auto &x) {
128           return pft::Evaluation{x, parents.back(), statement.source, {}};
129         },
130         statement.statement.u));
131     return false;
132   }
133   bool Pre(const parser::Statement<parser::ForallAssignmentStmt> &statement) {
134     addEval(std::visit(
135         [&](const auto &x) {
136           return pft::Evaluation{x, parents.back(), statement.source,
137                                  statement.label};
138         },
139         statement.statement.u));
140     return false;
141   }
142   bool Pre(const parser::WhereBodyConstruct &whereBody) {
143     return std::visit(
144         common::visitors{
145             [&](const parser::Statement<parser::AssignmentStmt> &stmt) {
146               // Not caught as other AssignmentStmt because it is not
147               // wrapped in a parser::ActionStmt.
148               addEval(pft::Evaluation{stmt.statement, parents.back(),
149                                       stmt.source, stmt.label});
150               return false;
151             },
152             [&](const auto &) { return true; },
153         },
154         whereBody.u);
155   }
156 
157 private:
158   // ActionStmt has a couple of non-conforming cases, which get handled
159   // explicitly here.  The other cases use an Indirection, which we discard in
160   // the PFT.
161   pft::Evaluation makeEvalAction(const parser::ActionStmt &statement,
162                                  parser::CharBlock pos,
163                                  std::optional<parser::Label> lab) {
164     return std::visit(
165         common::visitors{
166             [&](const auto &x) {
167               return pft::Evaluation{removeIndirection(x), parents.back(), pos,
168                                      lab};
169             },
170         },
171         statement.u);
172   }
173 
174   // When we enter a function-like structure, we want to build a new unit and
175   // set the builder's cursors to point to it.
176   template <typename A>
177   bool enterFunc(const A &func) {
178     auto &unit = addFunc(pft::FunctionLikeUnit{func, parents.back()});
179     funclist = &unit.funcs;
180     pushEval(&unit.evals);
181     parents.emplace_back(unit);
182     return true;
183   }
184   /// Make funclist to point to current parent function list if it exists.
185   void setFunctListToParentFuncs() {
186     if (!parents.empty()) {
187       std::visit(common::visitors{
188                      [&](pft::FunctionLikeUnit *p) { funclist = &p->funcs; },
189                      [&](pft::ModuleLikeUnit *p) { funclist = &p->funcs; },
190                      [&](auto *) { funclist = nullptr; },
191                  },
192                  parents.back().p);
193     }
194   }
195 
196   void exitFunc() {
197     popEval();
198     parents.pop_back();
199     setFunctListToParentFuncs();
200   }
201 
202   // When we enter a construct structure, we want to build a new construct and
203   // set the builder's evaluation cursor to point to it.
204   template <typename A>
205   bool enterConstruct(const A &construct) {
206     auto &con = addEval(pft::Evaluation{construct, parents.back()});
207     con.subs.reset(new pft::EvaluationCollection);
208     pushEval(con.subs.get());
209     parents.emplace_back(con);
210     return true;
211   }
212 
213   void exitConstruct() {
214     popEval();
215     parents.pop_back();
216   }
217 
218   // When we enter a module structure, we want to build a new module and
219   // set the builder's function cursor to point to it.
220   template <typename A>
221   bool enterModule(const A &func) {
222     auto &unit = addUnit(pft::ModuleLikeUnit{func, parents.back()});
223     funclist = &unit.funcs;
224     parents.emplace_back(unit);
225     return true;
226   }
227 
228   void exitModule() {
229     parents.pop_back();
230     setFunctListToParentFuncs();
231   }
232 
233   template <typename A>
234   A &addUnit(A &&unit) {
235     pgm->getUnits().emplace_back(std::move(unit));
236     return std::get<A>(pgm->getUnits().back());
237   }
238 
239   template <typename A>
240   A &addFunc(A &&func) {
241     if (funclist) {
242       funclist->emplace_back(std::move(func));
243       return funclist->back();
244     }
245     return addUnit(std::move(func));
246   }
247 
248   /// move the Evaluation to the end of the current list
249   pft::Evaluation &addEval(pft::Evaluation &&eval) {
250     assert(funclist && "not in a function");
251     assert(evallist.size() > 0);
252     evallist.back()->emplace_back(std::move(eval));
253     return evallist.back()->back();
254   }
255 
256   /// push a new list on the stack of Evaluation lists
257   void pushEval(pft::EvaluationCollection *eval) {
258     assert(funclist && "not in a function");
259     assert(eval && eval->empty() && "evaluation list isn't correct");
260     evallist.emplace_back(eval);
261   }
262 
263   /// pop the current list and return to the last Evaluation list
264   void popEval() {
265     assert(funclist && "not in a function");
266     evallist.pop_back();
267   }
268 
269   std::unique_ptr<pft::Program> pgm;
270   /// funclist points to FunctionLikeUnit::funcs list (resp.
271   /// ModuleLikeUnit::funcs) when building a FunctionLikeUnit (resp.
272   /// ModuleLikeUnit) to store internal procedures (resp. module procedures).
273   /// Otherwise (e.g. when building the top level Program), it is null.
274   std::list<pft::FunctionLikeUnit> *funclist{nullptr};
275   /// evallist is a stack of pointer to FunctionLikeUnit::evals (or
276   /// Evaluation::subs) that are being build.
277   std::vector<pft::EvaluationCollection *> evallist;
278   std::vector<pft::ParentType> parents;
279 };
280 
281 template <typename Label, typename A>
282 constexpr bool hasLabel(const A &stmt) {
283   auto isLabel{
284       [](const auto &v) { return std::holds_alternative<Label>(v.u); }};
285   if constexpr (std::is_same_v<A, parser::ReadStmt> ||
286                 std::is_same_v<A, parser::WriteStmt>) {
287     return std::any_of(std::begin(stmt.controls), std::end(stmt.controls),
288                        isLabel);
289   }
290   if constexpr (std::is_same_v<A, parser::WaitStmt>) {
291     return std::any_of(std::begin(stmt.v), std::end(stmt.v), isLabel);
292   }
293   if constexpr (std::is_same_v<Label, parser::ErrLabel>) {
294     if constexpr (common::HasMember<
295                       A, std::tuple<parser::OpenStmt, parser::CloseStmt,
296                                     parser::BackspaceStmt, parser::EndfileStmt,
297                                     parser::RewindStmt, parser::FlushStmt>>)
298       return std::any_of(std::begin(stmt.v), std::end(stmt.v), isLabel);
299     if constexpr (std::is_same_v<A, parser::InquireStmt>) {
300       const auto &specifiers{std::get<std::list<parser::InquireSpec>>(stmt.u)};
301       return std::any_of(std::begin(specifiers), std::end(specifiers), isLabel);
302     }
303   }
304   return false;
305 }
306 
307 bool hasAltReturns(const parser::CallStmt &callStmt) {
308   const auto &args{std::get<std::list<parser::ActualArgSpec>>(callStmt.v.t)};
309   for (const auto &arg : args) {
310     const auto &actual{std::get<parser::ActualArg>(arg.t)};
311     if (std::holds_alternative<parser::AltReturnSpec>(actual.u))
312       return true;
313   }
314   return false;
315 }
316 
317 /// Determine if `callStmt` has alternate returns and if so set `e` to be the
318 /// origin of a switch-like control flow
319 ///
320 /// \param cstr points to the current construct. It may be null at the top-level
321 /// of a FunctionLikeUnit.
322 void altRet(pft::Evaluation &evaluation, const parser::CallStmt &callStmt,
323             pft::Evaluation *cstr) {
324   if (hasAltReturns(callStmt))
325     evaluation.setCFG(pft::CFGAnnotation::Switch, cstr);
326 }
327 
328 /// \param cstr points to the current construct. It may be null at the top-level
329 /// of a FunctionLikeUnit.
330 void annotateEvalListCFG(pft::EvaluationCollection &evaluationCollection,
331                          pft::Evaluation *cstr) {
332   bool nextIsTarget = false;
333   for (auto &eval : evaluationCollection) {
334     eval.isTarget = nextIsTarget;
335     nextIsTarget = false;
336     if (auto *subs{eval.getConstructEvals()}) {
337       annotateEvalListCFG(*subs, &eval);
338       // assume that the entry and exit are both possible branch targets
339       nextIsTarget = true;
340     }
341 
342     if (eval.isActionOrGenerated() && eval.lab.has_value())
343       eval.isTarget = true;
344     eval.visit(common::visitors{
345         [&](const parser::CallStmt &statement) {
346           altRet(eval, statement, cstr);
347         },
348         [&](const parser::CycleStmt &) {
349           eval.setCFG(pft::CFGAnnotation::Goto, cstr);
350         },
351         [&](const parser::ExitStmt &) {
352           eval.setCFG(pft::CFGAnnotation::Goto, cstr);
353         },
354         [&](const parser::FailImageStmt &) {
355           eval.setCFG(pft::CFGAnnotation::Terminate, cstr);
356         },
357         [&](const parser::GotoStmt &) {
358           eval.setCFG(pft::CFGAnnotation::Goto, cstr);
359         },
360         [&](const parser::IfStmt &) {
361           eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
362         },
363         [&](const parser::ReturnStmt &) {
364           eval.setCFG(pft::CFGAnnotation::Return, cstr);
365         },
366         [&](const parser::StopStmt &) {
367           eval.setCFG(pft::CFGAnnotation::Terminate, cstr);
368         },
369         [&](const parser::ArithmeticIfStmt &) {
370           eval.setCFG(pft::CFGAnnotation::Switch, cstr);
371         },
372         [&](const parser::AssignedGotoStmt &) {
373           eval.setCFG(pft::CFGAnnotation::IndGoto, cstr);
374         },
375         [&](const parser::ComputedGotoStmt &) {
376           eval.setCFG(pft::CFGAnnotation::Switch, cstr);
377         },
378         [&](const parser::WhereStmt &) {
379           // fir.loop + fir.where around the next stmt
380           eval.isTarget = true;
381           eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
382         },
383         [&](const parser::ForallStmt &) {
384           // fir.loop around the next stmt
385           eval.isTarget = true;
386           eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
387         },
388         [&](pft::CGJump &) { eval.setCFG(pft::CFGAnnotation::Goto, cstr); },
389         [&](const parser::SelectCaseStmt &) {
390           eval.setCFG(pft::CFGAnnotation::Switch, cstr);
391         },
392         [&](const parser::NonLabelDoStmt &) {
393           eval.isTarget = true;
394           eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
395         },
396         [&](const parser::EndDoStmt &) {
397           eval.isTarget = true;
398           eval.setCFG(pft::CFGAnnotation::Goto, cstr);
399         },
400         [&](const parser::IfThenStmt &) {
401           eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
402         },
403         [&](const parser::ElseIfStmt &) {
404           eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
405         },
406         [&](const parser::SelectRankStmt &) {
407           eval.setCFG(pft::CFGAnnotation::Switch, cstr);
408         },
409         [&](const parser::SelectTypeStmt &) {
410           eval.setCFG(pft::CFGAnnotation::Switch, cstr);
411         },
412         [&](const parser::WhereConstruct &) {
413           // mark the WHERE as if it were a DO loop
414           eval.isTarget = true;
415           eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
416         },
417         [&](const parser::WhereConstructStmt &) {
418           eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
419         },
420         [&](const parser::MaskedElsewhereStmt &) {
421           eval.isTarget = true;
422           eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
423         },
424         [&](const parser::ForallConstructStmt &) {
425           eval.isTarget = true;
426           eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
427         },
428 
429         [&](const auto &stmt) {
430           // Handle statements with similar impact on control flow
431           using IoStmts = std::tuple<parser::BackspaceStmt, parser::CloseStmt,
432                                      parser::EndfileStmt, parser::FlushStmt,
433                                      parser::InquireStmt, parser::OpenStmt,
434                                      parser::ReadStmt, parser::RewindStmt,
435                                      parser::WaitStmt, parser::WriteStmt>;
436 
437           using TargetStmts =
438               std::tuple<parser::EndAssociateStmt, parser::EndBlockStmt,
439                          parser::CaseStmt, parser::EndSelectStmt,
440                          parser::EndChangeTeamStmt, parser::EndCriticalStmt,
441                          parser::ElseStmt, parser::EndIfStmt,
442                          parser::SelectRankCaseStmt, parser::TypeGuardStmt,
443                          parser::ElsewhereStmt, parser::EndWhereStmt,
444                          parser::EndForallStmt>;
445 
446           using DoNothingConstructStmts =
447               std::tuple<parser::BlockStmt, parser::AssociateStmt,
448                          parser::CriticalStmt, parser::ChangeTeamStmt>;
449 
450           using A = std::decay_t<decltype(stmt)>;
451           if constexpr (common::HasMember<A, IoStmts>) {
452             if (hasLabel<parser::ErrLabel>(stmt) ||
453                 hasLabel<parser::EorLabel>(stmt) ||
454                 hasLabel<parser::EndLabel>(stmt))
455               eval.setCFG(pft::CFGAnnotation::IoSwitch, cstr);
456           } else if constexpr (common::HasMember<A, TargetStmts>) {
457             eval.isTarget = true;
458           } else if constexpr (common::HasMember<A, DoNothingConstructStmts>) {
459             // Explicitly do nothing for these construct statements
460           } else {
461             static_assert(!pft::isConstructStmt<A>,
462                           "All ConstructStmts impact on the control flow "
463                           "should be explicitly handled");
464           }
465           /* else do nothing */
466         },
467     });
468   }
469 }
470 
471 /// Annotate the PFT with CFG source decorations (see CFGAnnotation) and mark
472 /// potential branch targets
473 inline void annotateFuncCFG(pft::FunctionLikeUnit &functionLikeUnit) {
474   annotateEvalListCFG(functionLikeUnit.evals, nullptr);
475   for (auto &internalFunc : functionLikeUnit.funcs)
476     annotateFuncCFG(internalFunc);
477 }
478 
479 class PFTDumper {
480 public:
481   void dumpPFT(llvm::raw_ostream &outputStream, pft::Program &pft) {
482     for (auto &unit : pft.getUnits()) {
483       std::visit(common::visitors{
484                      [&](pft::BlockDataUnit &unit) {
485                        outputStream << getNodeIndex(unit) << " ";
486                        outputStream << "BlockData: ";
487                        outputStream << "\nEndBlockData\n\n";
488                      },
489                      [&](pft::FunctionLikeUnit &func) {
490                        dumpFunctionLikeUnit(outputStream, func);
491                      },
492                      [&](pft::ModuleLikeUnit &unit) {
493                        dumpModuleLikeUnit(outputStream, unit);
494                      },
495                  },
496                  unit);
497     }
498     resetIndexes();
499   }
500 
501   llvm::StringRef evalName(pft::Evaluation &eval) {
502     return eval.visit(common::visitors{
503         [](const pft::CGJump) { return "CGJump"; },
504         [](const auto &parseTreeNode) {
505           return parser::ParseTreeDumper::GetNodeName(parseTreeNode);
506         },
507     });
508   }
509 
510   void dumpEvalList(llvm::raw_ostream &outputStream,
511                     pft::EvaluationCollection &evaluationCollection,
512                     int indent = 1) {
513     static const std::string white{"                                      ++"};
514     std::string indentString{white.substr(0, indent * 2)};
515     for (pft::Evaluation &eval : evaluationCollection) {
516       outputStream << indentString << getNodeIndex(eval) << " ";
517       llvm::StringRef name{evalName(eval)};
518       if (auto *subs{eval.getConstructEvals()}) {
519         outputStream << "<<" << name << ">>";
520         outputStream << "\n";
521         dumpEvalList(outputStream, *subs, indent + 1);
522         outputStream << indentString << "<<End" << name << ">>\n";
523       } else {
524         outputStream << name;
525         outputStream << ": " << eval.pos.ToString() + "\n";
526       }
527     }
528   }
529 
530   void dumpFunctionLikeUnit(llvm::raw_ostream &outputStream,
531                             pft::FunctionLikeUnit &functionLikeUnit) {
532     outputStream << getNodeIndex(functionLikeUnit) << " ";
533     llvm::StringRef unitKind{};
534     std::string name{};
535     std::string header{};
536     if (functionLikeUnit.beginStmt) {
537       std::visit(
538           common::visitors{
539               [&](const parser::Statement<parser::ProgramStmt> *statement) {
540                 unitKind = "Program";
541                 name = statement->statement.v.ToString();
542               },
543               [&](const parser::Statement<parser::FunctionStmt> *statement) {
544                 unitKind = "Function";
545                 name =
546                     std::get<parser::Name>(statement->statement.t).ToString();
547                 header = statement->source.ToString();
548               },
549               [&](const parser::Statement<parser::SubroutineStmt> *statement) {
550                 unitKind = "Subroutine";
551                 name =
552                     std::get<parser::Name>(statement->statement.t).ToString();
553                 header = statement->source.ToString();
554               },
555               [&](const parser::Statement<parser::MpSubprogramStmt>
556                       *statement) {
557                 unitKind = "MpSubprogram";
558                 name = statement->statement.v.ToString();
559                 header = statement->source.ToString();
560               },
561               [&](auto *) {},
562           },
563           *functionLikeUnit.beginStmt);
564     } else {
565       unitKind = "Program";
566       name = "<anonymous>";
567     }
568     outputStream << unitKind << ' ' << name;
569     if (header.size())
570       outputStream << ": " << header;
571     outputStream << '\n';
572     dumpEvalList(outputStream, functionLikeUnit.evals);
573     if (!functionLikeUnit.funcs.empty()) {
574       outputStream << "\nContains\n";
575       for (auto &func : functionLikeUnit.funcs)
576         dumpFunctionLikeUnit(outputStream, func);
577       outputStream << "EndContains\n";
578     }
579     outputStream << "End" << unitKind << ' ' << name << "\n\n";
580   }
581 
582   void dumpModuleLikeUnit(llvm::raw_ostream &outputStream,
583                           pft::ModuleLikeUnit &moduleLikeUnit) {
584     outputStream << getNodeIndex(moduleLikeUnit) << " ";
585     outputStream << "ModuleLike: ";
586     outputStream << "\nContains\n";
587     for (auto &func : moduleLikeUnit.funcs)
588       dumpFunctionLikeUnit(outputStream, func);
589     outputStream << "EndContains\nEndModuleLike\n\n";
590   }
591 
592   template <typename T>
593   std::size_t getNodeIndex(const T &node) {
594     auto addr{static_cast<const void *>(&node)};
595     auto it{nodeIndexes.find(addr)};
596     if (it != nodeIndexes.end()) {
597       return it->second;
598     }
599     nodeIndexes.try_emplace(addr, nextIndex);
600     return nextIndex++;
601   }
602   std::size_t getNodeIndex(const pft::Program &) { return 0; }
603 
604   void resetIndexes() {
605     nodeIndexes.clear();
606     nextIndex = 1;
607   }
608 
609 private:
610   llvm::DenseMap<const void *, std::size_t> nodeIndexes;
611   std::size_t nextIndex{1}; // 0 is the root
612 };
613 
614 template <typename A, typename T>
615 pft::FunctionLikeUnit::FunctionStatement getFunctionStmt(const T &func) {
616   return pft::FunctionLikeUnit::FunctionStatement{
617       &std::get<parser::Statement<A>>(func.t)};
618 }
619 template <typename A, typename T>
620 pft::ModuleLikeUnit::ModuleStatement getModuleStmt(const T &mod) {
621   return pft::ModuleLikeUnit::ModuleStatement{
622       &std::get<parser::Statement<A>>(mod.t)};
623 }
624 
625 } // namespace
626 
627 pft::FunctionLikeUnit::FunctionLikeUnit(const parser::MainProgram &func,
628                                         const pft::ParentType &parent)
629     : ProgramUnit{func, parent} {
630   auto &ps{
631       std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(func.t)};
632   if (ps.has_value()) {
633     const parser::Statement<parser::ProgramStmt> &statement{ps.value()};
634     beginStmt = &statement;
635   }
636   endStmt = getFunctionStmt<parser::EndProgramStmt>(func);
637 }
638 
639 pft::FunctionLikeUnit::FunctionLikeUnit(const parser::FunctionSubprogram &func,
640                                         const pft::ParentType &parent)
641     : ProgramUnit{func, parent},
642       beginStmt{getFunctionStmt<parser::FunctionStmt>(func)},
643       endStmt{getFunctionStmt<parser::EndFunctionStmt>(func)} {}
644 
645 pft::FunctionLikeUnit::FunctionLikeUnit(
646     const parser::SubroutineSubprogram &func, const pft::ParentType &parent)
647     : ProgramUnit{func, parent},
648       beginStmt{getFunctionStmt<parser::SubroutineStmt>(func)},
649       endStmt{getFunctionStmt<parser::EndSubroutineStmt>(func)} {}
650 
651 pft::FunctionLikeUnit::FunctionLikeUnit(
652     const parser::SeparateModuleSubprogram &func, const pft::ParentType &parent)
653     : ProgramUnit{func, parent},
654       beginStmt{getFunctionStmt<parser::MpSubprogramStmt>(func)},
655       endStmt{getFunctionStmt<parser::EndMpSubprogramStmt>(func)} {}
656 
657 pft::ModuleLikeUnit::ModuleLikeUnit(const parser::Module &m,
658                                     const pft::ParentType &parent)
659     : ProgramUnit{m, parent}, beginStmt{getModuleStmt<parser::ModuleStmt>(m)},
660       endStmt{getModuleStmt<parser::EndModuleStmt>(m)} {}
661 
662 pft::ModuleLikeUnit::ModuleLikeUnit(const parser::Submodule &m,
663                                     const pft::ParentType &parent)
664     : ProgramUnit{m, parent}, beginStmt{getModuleStmt<parser::SubmoduleStmt>(
665                                   m)},
666       endStmt{getModuleStmt<parser::EndSubmoduleStmt>(m)} {}
667 
668 pft::BlockDataUnit::BlockDataUnit(const parser::BlockData &bd,
669                                   const pft::ParentType &parent)
670     : ProgramUnit{bd, parent} {}
671 
672 std::unique_ptr<pft::Program> createPFT(const parser::Program &root) {
673   PFTBuilder walker;
674   Walk(root, walker);
675   return walker.result();
676 }
677 
678 void annotateControl(pft::Program &pft) {
679   for (auto &unit : pft.getUnits()) {
680     std::visit(common::visitors{
681                    [](pft::BlockDataUnit &) {},
682                    [](pft::FunctionLikeUnit &func) { annotateFuncCFG(func); },
683                    [](pft::ModuleLikeUnit &unit) {
684                      for (auto &func : unit.funcs)
685                        annotateFuncCFG(func);
686                    },
687                },
688                unit);
689   }
690 }
691 
692 /// Dump a PFT.
693 void dumpPFT(llvm::raw_ostream &outputStream, pft::Program &pft) {
694   PFTDumper{}.dumpPFT(outputStream, pft);
695 }
696 
697 } // namespace Fortran::lower
698