1 //===-- Lower/PFTBuilder.h -- PFT builder -----------------------*- C++ -*-===//
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 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
10 //
11 //===----------------------------------------------------------------------===//
12 //
13 // PFT (Pre-FIR Tree) interface.
14 //
15 //===----------------------------------------------------------------------===//
16 
17 #ifndef FORTRAN_LOWER_PFTBUILDER_H
18 #define FORTRAN_LOWER_PFTBUILDER_H
19 
20 #include "flang/Common/reference.h"
21 #include "flang/Common/template.h"
22 #include "flang/Lower/PFTDefs.h"
23 #include "flang/Parser/parse-tree.h"
24 #include "flang/Semantics/attr.h"
25 #include "flang/Semantics/symbol.h"
26 #include "llvm/Support/ErrorHandling.h"
27 #include "llvm/Support/raw_ostream.h"
28 
29 namespace Fortran::lower::pft {
30 
31 struct Evaluation;
32 struct Program;
33 struct ModuleLikeUnit;
34 struct FunctionLikeUnit;
35 
36 using EvaluationList = std::list<Evaluation>;
37 using LabelEvalMap = llvm::DenseMap<Fortran::parser::Label, Evaluation *>;
38 
39 /// Provide a variant like container that can hold references. It can hold
40 /// constant or mutable references. It is used in the other classes to provide
41 /// union of const references to parse-tree nodes.
42 template <bool isConst, typename... A>
43 class ReferenceVariantBase {
44 public:
45   template <typename B>
46   using BaseType = std::conditional_t<isConst, const B, B>;
47   template <typename B>
48   using Ref = common::Reference<BaseType<B>>;
49 
50   ReferenceVariantBase() = delete;
ReferenceVariantBase(std::variant<Ref<A>...> b)51   ReferenceVariantBase(std::variant<Ref<A>...> b) : u(b) {}
52   template <typename T>
ReferenceVariantBase(Ref<T> b)53   ReferenceVariantBase(Ref<T> b) : u(b) {}
54 
55   template <typename B>
get()56   constexpr BaseType<B> &get() const {
57     return std::get<Ref<B>>(u).get();
58   }
59   template <typename B>
getStatement()60   constexpr BaseType<B> &getStatement() const {
61     return std::get<Ref<parser::Statement<B>>>(u).get().statement;
62   }
63   template <typename B>
getIf()64   constexpr BaseType<B> *getIf() const {
65     auto *ptr = std::get_if<Ref<B>>(&u);
66     return ptr ? &ptr->get() : nullptr;
67   }
68   template <typename B>
isA()69   constexpr bool isA() const {
70     return std::holds_alternative<Ref<B>>(u);
71   }
72   template <typename VISITOR>
visit(VISITOR && visitor)73   constexpr auto visit(VISITOR &&visitor) const {
74     return std::visit(
75         common::visitors{[&visitor](auto ref) { return visitor(ref.get()); }},
76         u);
77   }
78 
79 private:
80   std::variant<Ref<A>...> u;
81 };
82 template <typename... A>
83 using ReferenceVariant = ReferenceVariantBase<true, A...>;
84 template <typename... A>
85 using MutableReferenceVariant = ReferenceVariantBase<false, A...>;
86 
87 /// PftNode is used to provide a reference to the unit a parse-tree node
88 /// belongs to. It is a variant of non-nullable pointers.
89 using PftNode = MutableReferenceVariant<Program, ModuleLikeUnit,
90                                         FunctionLikeUnit, Evaluation>;
91 
92 /// Classify the parse-tree nodes from ExecutablePartConstruct
93 
94 using ActionStmts = std::tuple<
95     parser::AllocateStmt, parser::AssignmentStmt, parser::BackspaceStmt,
96     parser::CallStmt, parser::CloseStmt, parser::ContinueStmt,
97     parser::CycleStmt, parser::DeallocateStmt, parser::EndfileStmt,
98     parser::EventPostStmt, parser::EventWaitStmt, parser::ExitStmt,
99     parser::FailImageStmt, parser::FlushStmt, parser::FormTeamStmt,
100     parser::GotoStmt, parser::IfStmt, parser::InquireStmt, parser::LockStmt,
101     parser::NullifyStmt, parser::OpenStmt, parser::PointerAssignmentStmt,
102     parser::PrintStmt, parser::ReadStmt, parser::ReturnStmt, parser::RewindStmt,
103     parser::StopStmt, parser::SyncAllStmt, parser::SyncImagesStmt,
104     parser::SyncMemoryStmt, parser::SyncTeamStmt, parser::UnlockStmt,
105     parser::WaitStmt, parser::WhereStmt, parser::WriteStmt,
106     parser::ComputedGotoStmt, parser::ForallStmt, parser::ArithmeticIfStmt,
107     parser::AssignStmt, parser::AssignedGotoStmt, parser::PauseStmt>;
108 
109 using OtherStmts =
110     std::tuple<parser::FormatStmt, parser::EntryStmt, parser::NamelistStmt>;
111 
112 using ConstructStmts = std::tuple<
113     parser::AssociateStmt, parser::EndAssociateStmt, parser::BlockStmt,
114     parser::EndBlockStmt, parser::SelectCaseStmt, parser::CaseStmt,
115     parser::EndSelectStmt, parser::ChangeTeamStmt, parser::EndChangeTeamStmt,
116     parser::CriticalStmt, parser::EndCriticalStmt, parser::NonLabelDoStmt,
117     parser::EndDoStmt, parser::IfThenStmt, parser::ElseIfStmt, parser::ElseStmt,
118     parser::EndIfStmt, parser::SelectRankStmt, parser::SelectRankCaseStmt,
119     parser::SelectTypeStmt, parser::TypeGuardStmt, parser::WhereConstructStmt,
120     parser::MaskedElsewhereStmt, parser::ElsewhereStmt, parser::EndWhereStmt,
121     parser::ForallConstructStmt, parser::EndForallStmt>;
122 
123 using EndStmts =
124     std::tuple<parser::EndProgramStmt, parser::EndFunctionStmt,
125                parser::EndSubroutineStmt, parser::EndMpSubprogramStmt>;
126 
127 using Constructs =
128     std::tuple<parser::AssociateConstruct, parser::BlockConstruct,
129                parser::CaseConstruct, parser::ChangeTeamConstruct,
130                parser::CriticalConstruct, parser::DoConstruct,
131                parser::IfConstruct, parser::SelectRankConstruct,
132                parser::SelectTypeConstruct, parser::WhereConstruct,
133                parser::ForallConstruct>;
134 
135 using Directives =
136     std::tuple<parser::CompilerDirective, parser::OpenACCConstruct,
137                parser::OpenMPConstruct, parser::OmpEndLoopDirective>;
138 
139 template <typename A>
140 static constexpr bool isActionStmt{common::HasMember<A, ActionStmts>};
141 
142 template <typename A>
143 static constexpr bool isOtherStmt{common::HasMember<A, OtherStmts>};
144 
145 template <typename A>
146 static constexpr bool isConstructStmt{common::HasMember<A, ConstructStmts>};
147 
148 template <typename A>
149 static constexpr bool isEndStmt{common::HasMember<A, EndStmts>};
150 
151 template <typename A>
152 static constexpr bool isConstruct{common::HasMember<A, Constructs>};
153 
154 template <typename A>
155 static constexpr bool isDirective{common::HasMember<A, Directives>};
156 
157 template <typename A>
158 static constexpr bool isIntermediateConstructStmt{common::HasMember<
159     A, std::tuple<parser::CaseStmt, parser::ElseIfStmt, parser::ElseStmt,
160                   parser::SelectRankCaseStmt, parser::TypeGuardStmt>>};
161 
162 template <typename A>
163 static constexpr bool isNopConstructStmt{common::HasMember<
164     A, std::tuple<parser::EndAssociateStmt, parser::CaseStmt,
165                   parser::EndSelectStmt, parser::ElseIfStmt, parser::ElseStmt,
166                   parser::EndIfStmt, parser::SelectRankCaseStmt,
167                   parser::TypeGuardStmt>>};
168 
169 template <typename A>
170 static constexpr bool isFunctionLike{common::HasMember<
171     A, std::tuple<parser::MainProgram, parser::FunctionSubprogram,
172                   parser::SubroutineSubprogram,
173                   parser::SeparateModuleSubprogram>>};
174 
175 template <typename A>
176 struct MakeReferenceVariantHelper {};
177 template <typename... A>
178 struct MakeReferenceVariantHelper<std::variant<A...>> {
179   using type = ReferenceVariant<A...>;
180 };
181 template <typename... A>
182 struct MakeReferenceVariantHelper<std::tuple<A...>> {
183   using type = ReferenceVariant<A...>;
184 };
185 template <typename A>
186 using MakeReferenceVariant = typename MakeReferenceVariantHelper<A>::type;
187 
188 using EvaluationTuple =
189     common::CombineTuples<ActionStmts, OtherStmts, ConstructStmts, EndStmts,
190                           Constructs, Directives>;
191 /// Hide non-nullable pointers to the parse-tree node.
192 /// Build type std::variant<const A* const, const B* const, ...>
193 /// from EvaluationTuple type (std::tuple<A, B, ...>).
194 using EvaluationVariant = MakeReferenceVariant<EvaluationTuple>;
195 
196 /// Function-like units contain lists of evaluations.  These can be simple
197 /// statements or constructs, where a construct contains its own evaluations.
198 struct Evaluation : EvaluationVariant {
199 
200   /// General ctor
201   template <typename A>
202   Evaluation(const A &a, const PftNode &parent,
203              const parser::CharBlock &position,
204              const std::optional<parser::Label> &label)
205       : EvaluationVariant{a}, parent{parent}, position{position}, label{label} {
206   }
207 
208   /// Construct and Directive ctor
209   template <typename A>
210   Evaluation(const A &a, const PftNode &parent)
211       : EvaluationVariant{a}, parent{parent} {
212     static_assert(pft::isConstruct<A> || pft::isDirective<A>,
213                   "must be a construct or directive");
214   }
215 
216   /// Evaluation classification predicates.
217   constexpr bool isActionStmt() const {
218     return visit(common::visitors{
219         [](auto &r) { return pft::isActionStmt<std::decay_t<decltype(r)>>; }});
220   }
221   constexpr bool isOtherStmt() const {
222     return visit(common::visitors{
223         [](auto &r) { return pft::isOtherStmt<std::decay_t<decltype(r)>>; }});
224   }
225   constexpr bool isConstructStmt() const {
226     return visit(common::visitors{[](auto &r) {
227       return pft::isConstructStmt<std::decay_t<decltype(r)>>;
228     }});
229   }
230   constexpr bool isEndStmt() const {
231     return visit(common::visitors{
232         [](auto &r) { return pft::isEndStmt<std::decay_t<decltype(r)>>; }});
233   }
234   constexpr bool isConstruct() const {
235     return visit(common::visitors{
236         [](auto &r) { return pft::isConstruct<std::decay_t<decltype(r)>>; }});
237   }
238   constexpr bool isDirective() const {
239     return visit(common::visitors{
240         [](auto &r) { return pft::isDirective<std::decay_t<decltype(r)>>; }});
241   }
242   constexpr bool isNopConstructStmt() const {
243     return visit(common::visitors{[](auto &r) {
244       return pft::isNopConstructStmt<std::decay_t<decltype(r)>>;
245     }});
246   }
247 
248   /// Return the predicate:  "This is a non-initial, non-terminal construct
249   /// statement."  For an IfConstruct, this is ElseIfStmt and ElseStmt.
250   constexpr bool isIntermediateConstructStmt() const {
251     return visit(common::visitors{[](auto &r) {
252       return pft::isIntermediateConstructStmt<std::decay_t<decltype(r)>>;
253     }});
254   }
255 
256   LLVM_DUMP_METHOD void dump() const;
257 
258   /// Return the first non-nop successor of an evaluation, possibly exiting
259   /// from one or more enclosing constructs.
260   Evaluation &nonNopSuccessor() const {
261     Evaluation *successor = lexicalSuccessor;
262     if (successor && successor->isNopConstructStmt()) {
263       successor = successor->parentConstruct->constructExit;
264     }
265     assert(successor && "missing successor");
266     return *successor;
267   }
268 
269   /// Return true if this Evaluation has at least one nested evaluation.
270   bool hasNestedEvaluations() const {
271     return evaluationList && !evaluationList->empty();
272   }
273 
274   /// Return nested evaluation list.
275   EvaluationList &getNestedEvaluations() {
276     assert(evaluationList && "no nested evaluations");
277     return *evaluationList;
278   }
279 
280   Evaluation &getFirstNestedEvaluation() {
281     assert(hasNestedEvaluations() && "no nested evaluations");
282     return evaluationList->front();
283   }
284 
285   Evaluation &getLastNestedEvaluation() {
286     assert(hasNestedEvaluations() && "no nested evaluations");
287     return evaluationList->back();
288   }
289 
290   /// Return the FunctionLikeUnit containing this evaluation (or nullptr).
291   FunctionLikeUnit *getOwningProcedure() const;
292 
293   bool lowerAsStructured() const;
294   bool lowerAsUnstructured() const;
295 
296   // FIR generation looks primarily at PFT ActionStmt and ConstructStmt leaf
297   // nodes.  Members such as lexicalSuccessor and block are applicable only
298   // to these nodes.  The controlSuccessor member is used for nonlexical
299   // successors, such as linking to a GOTO target.  For multiway branches,
300   // it is set to the first target.  Successor and exit links always target
301   // statements.  An internal Construct node has a constructExit link that
302   // applies to exits from anywhere within the construct.
303   //
304   // An unstructured construct is one that contains some form of goto.  This
305   // is indicated by the isUnstructured member flag, which may be set on a
306   // statement and propagated to enclosing constructs.  This distinction allows
307   // a structured IF or DO statement to be materialized with custom structured
308   // FIR operations.  An unstructured statement is materialized as mlir
309   // operation sequences that include explicit branches.
310   //
311   // The block member is set for statements that begin a new block.  This
312   // block is the target of any branch to the statement.  Statements may have
313   // additional (unstructured) "local" blocks, but such blocks cannot be the
314   // target of any explicit branch.  The primary example of an (unstructured)
315   // statement that may have multiple associated blocks is NonLabelDoStmt,
316   // which may have a loop preheader block for loop initialization code (the
317   // block member), and always has a "local" header block that is the target
318   // of the loop back edge.  If the NonLabelDoStmt is a concurrent loop, it
319   // may be associated with an arbitrary number of nested preheader, header,
320   // and mask blocks.
321   //
322   // The printIndex member is only set for statements.  It is used for dumps
323   // (and debugging) and does not affect FIR generation.
324 
325   PftNode parent;
326   parser::CharBlock position{};
327   std::optional<parser::Label> label{};
328   std::unique_ptr<EvaluationList> evaluationList; // nested evaluations
329   Evaluation *parentConstruct{nullptr};  // set for nodes below the top level
330   Evaluation *lexicalSuccessor{nullptr}; // set for ActionStmt, ConstructStmt
331   Evaluation *controlSuccessor{nullptr}; // set for some statements
332   Evaluation *constructExit{nullptr};    // set for constructs
333   bool isNewBlock{false};                // evaluation begins a new basic block
334   bool isUnstructured{false};  // evaluation has unstructured control flow
335   bool negateCondition{false}; // If[Then]Stmt condition must be negated
336   mlir::Block *block{nullptr}; // isNewBlock block (ActionStmt, ConstructStmt)
337   int printIndex{0}; // (ActionStmt, ConstructStmt) evaluation index for dumps
338 };
339 
340 using ProgramVariant =
341     ReferenceVariant<parser::MainProgram, parser::FunctionSubprogram,
342                      parser::SubroutineSubprogram, parser::Module,
343                      parser::Submodule, parser::SeparateModuleSubprogram,
344                      parser::BlockData, parser::CompilerDirective>;
345 /// A program is a list of program units.
346 /// These units can be function like, module like, or block data.
347 struct ProgramUnit : ProgramVariant {
348   template <typename A>
349   ProgramUnit(const A &p, const PftNode &parent)
350       : ProgramVariant{p}, parent{parent} {}
351   ProgramUnit(ProgramUnit &&) = default;
352   ProgramUnit(const ProgramUnit &) = delete;
353 
354   PftNode parent;
355 };
356 
357 /// A variable captures an object to be created per the declaration part of a
358 /// function like unit.
359 ///
360 /// Fortran EQUIVALENCE statements are a mechanism that introduces aliasing
361 /// between named variables. The set of overlapping aliases will materialize a
362 /// generic store object with a designated offset and size. Participant
363 /// symbols will simply be pointers into the aggregate store.
364 ///
365 /// EQUIVALENCE can also interact with COMMON and other global variables to
366 /// imply aliasing between (subparts of) a global and other local variable
367 /// names.
368 ///
369 /// Properties can be applied by lowering. For example, a local array that is
370 /// known to be very large may be transformed into a heap allocated entity by
371 /// lowering. That decision would be tracked in its Variable instance.
372 struct Variable {
373   /// Most variables are nominal and require the allocation of local/global
374   /// storage space. A nominal variable may also be an alias for some other
375   /// (subpart) of storage.
376   struct Nominal {
377     Nominal(const semantics::Symbol *symbol, int depth, bool global)
378         : symbol{symbol}, depth{depth}, global{global} {}
379     const semantics::Symbol *symbol{};
380 
381     bool isGlobal() const { return global; }
382     bool isDeclaration() const {
383       return !symbol || symbol != &symbol->GetUltimate();
384     }
385 
386     int depth{};
387     bool global{};
388     bool heapAlloc{}; // variable needs deallocation on exit
389     bool pointer{};
390     bool target{};
391     bool aliaser{}; // participates in EQUIVALENCE union
392     std::size_t aliasOffset{};
393   };
394 
395   using Interval = std::tuple<std::size_t, std::size_t>;
396 
397   /// An interval of storage is a contiguous block of memory to be allocated or
398   /// mapped onto another variable. Aliasing variables will be pointers into
399   /// interval stores and may overlap each other.
400   struct AggregateStore {
401     AggregateStore(Interval &&interval, const Fortran::semantics::Scope &scope,
402                    bool isDeclaration = false)
403         : interval{std::move(interval)}, scope{&scope}, isDecl{isDeclaration} {}
404     AggregateStore(Interval &&interval, const Fortran::semantics::Scope &scope,
405                    const llvm::SmallVector<const semantics::Symbol *, 8> &vars,
406                    bool isDeclaration = false)
407         : interval{std::move(interval)}, scope{&scope}, vars{vars},
408           isDecl{isDeclaration} {}
409 
410     bool isGlobal() const { return vars.size() > 0; }
411     bool isDeclaration() const { return isDecl; }
412     /// Get offset of the aggregate inside its scope.
413     std::size_t getOffset() const { return std::get<0>(interval); }
414 
415     Interval interval{};
416     /// scope in which the interval is.
417     const Fortran::semantics::Scope *scope;
418     llvm::SmallVector<const semantics::Symbol *, 8> vars{};
419     /// Is this a declaration of a storage defined in another scope ?
420     bool isDecl;
421   };
422 
423   explicit Variable(const Fortran::semantics::Symbol &sym, bool global = false,
424                     int depth = 0)
425       : var{Nominal(&sym, depth, global)} {}
426   explicit Variable(AggregateStore &&istore) : var{std::move(istore)} {}
427 
428   /// Return the front-end symbol for a nominal variable.
429   const Fortran::semantics::Symbol &getSymbol() const {
430     assert(hasSymbol() && "variable is not nominal");
431     return *std::get<Nominal>(var).symbol;
432   }
433 
434   /// Return the aggregate store.
435   const AggregateStore &getAggregateStore() const {
436     assert(isAggregateStore());
437     return std::get<AggregateStore>(var);
438   }
439 
440   /// Return the interval range of an aggregate store.
441   const Interval &getInterval() const {
442     assert(isAggregateStore());
443     return std::get<AggregateStore>(var).interval;
444   }
445 
446   /// Only nominal variable have front-end symbols.
447   bool hasSymbol() const { return std::holds_alternative<Nominal>(var); }
448 
449   /// Is this an aggregate store?
450   bool isAggregateStore() const {
451     return std::holds_alternative<AggregateStore>(var);
452   }
453 
454   /// Is this variable a global?
455   bool isGlobal() const {
456     return std::visit([](const auto &x) { return x.isGlobal(); }, var);
457   }
458 
459   /// Is this a declaration of a variable owned by another scope ?
460   bool isDeclaration() const {
461     return std::visit([](const auto &x) { return x.isDeclaration(); }, var);
462   }
463 
464   const Fortran::semantics::Scope *getOwningScope() const {
465     return std::visit(
466         common::visitors{
467             [](const Nominal &x) { return &x.symbol->GetUltimate().owner(); },
468             [](const AggregateStore &agg) { return agg.scope; }},
469         var);
470   }
471 
472   bool isHeapAlloc() const {
473     if (const auto *s = std::get_if<Nominal>(&var))
474       return s->heapAlloc;
475     return false;
476   }
477   bool isPointer() const {
478     if (const auto *s = std::get_if<Nominal>(&var))
479       return s->pointer;
480     return false;
481   }
482   bool isTarget() const {
483     if (const auto *s = std::get_if<Nominal>(&var))
484       return s->target;
485     return false;
486   }
487 
488   /// An alias(er) is a variable that is part of a EQUIVALENCE that is allocated
489   /// locally on the stack.
490   bool isAlias() const {
491     if (const auto *s = std::get_if<Nominal>(&var))
492       return s->aliaser;
493     return false;
494   }
495   std::size_t getAlias() const {
496     if (auto *s = std::get_if<Nominal>(&var))
497       return s->aliasOffset;
498     return 0;
499   }
500   void setAlias(std::size_t offset) {
501     if (auto *s = std::get_if<Nominal>(&var)) {
502       s->aliaser = true;
503       s->aliasOffset = offset;
504     } else {
505       llvm_unreachable("not a nominal var");
506     }
507   }
508 
509   void setHeapAlloc(bool to = true) {
510     if (auto *s = std::get_if<Nominal>(&var))
511       s->heapAlloc = to;
512     else
513       llvm_unreachable("not a nominal var");
514   }
515   void setPointer(bool to = true) {
516     if (auto *s = std::get_if<Nominal>(&var))
517       s->pointer = to;
518     else
519       llvm_unreachable("not a nominal var");
520   }
521   void setTarget(bool to = true) {
522     if (auto *s = std::get_if<Nominal>(&var))
523       s->target = to;
524     else
525       llvm_unreachable("not a nominal var");
526   }
527 
528   /// The depth is recorded for nominal variables as a debugging aid.
529   int getDepth() const {
530     if (const auto *s = std::get_if<Nominal>(&var))
531       return s->depth;
532     return 0;
533   }
534 
535   LLVM_DUMP_METHOD void dump() const;
536 
537 private:
538   std::variant<Nominal, AggregateStore> var;
539 };
540 
541 /// Function-like units may contain evaluations (executable statements) and
542 /// nested function-like units (internal procedures and function statements).
543 struct FunctionLikeUnit : public ProgramUnit {
544   // wrapper statements for function-like syntactic structures
545   using FunctionStatement =
546       ReferenceVariant<parser::Statement<parser::ProgramStmt>,
547                        parser::Statement<parser::EndProgramStmt>,
548                        parser::Statement<parser::FunctionStmt>,
549                        parser::Statement<parser::EndFunctionStmt>,
550                        parser::Statement<parser::SubroutineStmt>,
551                        parser::Statement<parser::EndSubroutineStmt>,
552                        parser::Statement<parser::MpSubprogramStmt>,
553                        parser::Statement<parser::EndMpSubprogramStmt>>;
554 
555   FunctionLikeUnit(
556       const parser::MainProgram &f, const PftNode &parent,
557       const Fortran::semantics::SemanticsContext &semanticsContext);
558   FunctionLikeUnit(
559       const parser::FunctionSubprogram &f, const PftNode &parent,
560       const Fortran::semantics::SemanticsContext &semanticsContext);
561   FunctionLikeUnit(
562       const parser::SubroutineSubprogram &f, const PftNode &parent,
563       const Fortran::semantics::SemanticsContext &semanticsContext);
564   FunctionLikeUnit(
565       const parser::SeparateModuleSubprogram &f, const PftNode &parent,
566       const Fortran::semantics::SemanticsContext &semanticsContext);
567   FunctionLikeUnit(FunctionLikeUnit &&) = default;
568   FunctionLikeUnit(const FunctionLikeUnit &) = delete;
569 
570   /// Return true iff this function like unit is Fortran recursive (actually
571   /// meaning it's reentrant).
572   bool isRecursive() const {
573     if (isMainProgram())
574       return false;
575     const auto &sym = getSubprogramSymbol();
576     return sym.attrs().test(semantics::Attr::RECURSIVE) ||
577            (!sym.attrs().test(semantics::Attr::NON_RECURSIVE) &&
578             defaultRecursiveFunctionSetting());
579   }
580 
581   std::vector<Variable> getOrderedSymbolTable() { return varList[0]; }
582 
583   bool isMainProgram() const {
584     return endStmt.isA<parser::Statement<parser::EndProgramStmt>>();
585   }
586 
587   /// Get the starting source location for this function like unit
588   parser::CharBlock getStartingSourceLoc() {
589     if (beginStmt)
590       return stmtSourceLoc(*beginStmt);
591     if (!evaluationList.empty())
592       return evaluationList.front().position;
593     return stmtSourceLoc(endStmt);
594   }
595 
596   void setActiveEntry(int entryIndex) {
597     assert(entryIndex >= 0 && entryIndex < (int)entryPointList.size() &&
598            "invalid entry point index");
599     activeEntry = entryIndex;
600   }
601 
602   /// Return a reference to the subprogram symbol of this FunctionLikeUnit.
603   /// This should not be called if the FunctionLikeUnit is the main program
604   /// since anonymous main programs do not have a symbol.
605   const semantics::Symbol &getSubprogramSymbol() const {
606     const auto *symbol = entryPointList[activeEntry].first;
607     if (!symbol)
608       llvm::report_fatal_error(
609           "not inside a procedure; do not call on main program.");
610     return *symbol;
611   }
612 
613   /// Return a pointer to the current entry point Evaluation.
614   /// This is null for a primary entry point.
615   Evaluation *getEntryEval() const {
616     return entryPointList[activeEntry].second;
617   }
618 
619   /// Helper to get location from FunctionLikeUnit begin/end statements.
620   static parser::CharBlock stmtSourceLoc(const FunctionStatement &stmt) {
621     return stmt.visit(common::visitors{[](const auto &x) { return x.source; }});
622   }
623 
624   LLVM_DUMP_METHOD void dump() const;
625 
626   /// Anonymous programs do not have a begin statement
627   std::optional<FunctionStatement> beginStmt;
628   FunctionStatement endStmt;
629   EvaluationList evaluationList;
630   LabelEvalMap labelEvaluationMap;
631   SymbolLabelMap assignSymbolLabelMap;
632   std::list<FunctionLikeUnit> nestedFunctions;
633   /// <Symbol, Evaluation> pairs for each entry point.  The pair at index 0
634   /// is the primary entry point; remaining pairs are alternate entry points.
635   /// The primary entry point symbol is Null for an anonymous program.
636   /// A named program symbol has MainProgramDetails.  Other symbols have
637   /// SubprogramDetails.  Evaluations are filled in for alternate entries.
638   llvm::SmallVector<std::pair<const semantics::Symbol *, Evaluation *>, 1>
639       entryPointList{std::pair{nullptr, nullptr}};
640   /// Current index into entryPointList.  Index 0 is the primary entry point.
641   int activeEntry = 0;
642   /// Dummy arguments that are not universal across entry points.
643   llvm::SmallVector<const semantics::Symbol *, 3> nonUniversalDummyArguments;
644   /// Primary result for function subprograms with alternate entries.  This
645   /// is one of the largest result values, not necessarily the first one.
646   const semantics::Symbol *primaryResult{nullptr};
647   /// Terminal basic block (if any)
648   mlir::Block *finalBlock{};
649   std::vector<std::vector<Variable>> varList;
650 };
651 
652 /// Module-like units contain a list of function-like units.
653 struct ModuleLikeUnit : public ProgramUnit {
654   // wrapper statements for module-like syntactic structures
655   using ModuleStatement =
656       ReferenceVariant<parser::Statement<parser::ModuleStmt>,
657                        parser::Statement<parser::EndModuleStmt>,
658                        parser::Statement<parser::SubmoduleStmt>,
659                        parser::Statement<parser::EndSubmoduleStmt>>;
660 
661   ModuleLikeUnit(const parser::Module &m, const PftNode &parent);
662   ModuleLikeUnit(const parser::Submodule &m, const PftNode &parent);
663   ~ModuleLikeUnit() = default;
664   ModuleLikeUnit(ModuleLikeUnit &&) = default;
665   ModuleLikeUnit(const ModuleLikeUnit &) = delete;
666 
667   LLVM_DUMP_METHOD void dump() const;
668 
669   std::vector<Variable> getOrderedSymbolTable() { return varList[0]; }
670 
671   ModuleStatement beginStmt;
672   ModuleStatement endStmt;
673   std::list<FunctionLikeUnit> nestedFunctions;
674   std::vector<std::vector<Variable>> varList;
675 };
676 
677 /// Block data units contain the variables and data initializers for common
678 /// blocks, etc.
679 struct BlockDataUnit : public ProgramUnit {
680   BlockDataUnit(const parser::BlockData &bd, const PftNode &parent,
681                 const Fortran::semantics::SemanticsContext &semanticsContext);
682   BlockDataUnit(BlockDataUnit &&) = default;
683   BlockDataUnit(const BlockDataUnit &) = delete;
684 
685   LLVM_DUMP_METHOD void dump() const;
686 
687   const Fortran::semantics::Scope &symTab; // symbol table
688 };
689 
690 // Top level compiler directives
691 struct CompilerDirectiveUnit : public ProgramUnit {
692   CompilerDirectiveUnit(const parser::CompilerDirective &directive,
693                         const PftNode &parent)
694       : ProgramUnit{directive, parent} {};
695   CompilerDirectiveUnit(CompilerDirectiveUnit &&) = default;
696   CompilerDirectiveUnit(const CompilerDirectiveUnit &) = delete;
697 };
698 
699 /// A Program is the top-level root of the PFT.
700 struct Program {
701   using Units = std::variant<FunctionLikeUnit, ModuleLikeUnit, BlockDataUnit,
702                              CompilerDirectiveUnit>;
703 
704   Program() = default;
705   Program(Program &&) = default;
706   Program(const Program &) = delete;
707 
708   const std::list<Units> &getUnits() const { return units; }
709   std::list<Units> &getUnits() { return units; }
710 
711   /// LLVM dump method on a Program.
712   LLVM_DUMP_METHOD void dump() const;
713 
714 private:
715   std::list<Units> units;
716 };
717 
718 } // namespace Fortran::lower::pft
719 
720 namespace Fortran::lower {
721 /// Create a PFT (Pre-FIR Tree) from the parse tree.
722 ///
723 /// A PFT is a light weight tree over the parse tree that is used to create FIR.
724 /// The PFT captures pointers back into the parse tree, so the parse tree must
725 /// not be changed between the construction of the PFT and its last use.  The
726 /// PFT captures a structured view of a program.  A program is a list of units.
727 /// A function like unit contains a list of evaluations.  An evaluation is
728 /// either a statement, or a construct with a nested list of evaluations.
729 std::unique_ptr<pft::Program>
730 createPFT(const parser::Program &root,
731           const Fortran::semantics::SemanticsContext &semanticsContext);
732 
733 /// Dumper for displaying a PFT.
734 void dumpPFT(llvm::raw_ostream &outputStream, const pft::Program &pft);
735 
736 } // namespace Fortran::lower
737 
738 #endif // FORTRAN_LOWER_PFTBUILDER_H
739