[flang] Upstream changes to the PFT data structure

[schweitz]

Summary

[flang] Batch together the changes to the PFT intermediate data
structure for upstreaming to llvm-project.

These files have had many changes since they were originally upstreamed.
Some of the changes are cosmetic.  Most of the functional changes were
done to support the lowering of control-flow syntax from the front-end
parse trees to the FIR dialect.

This patch is meant to be a reviewable size. The functionality it
provides will be used by code yet to be upstreamed in lowering.

Generation of FIR (Fortran IR, a dialect of MLIR) from the front end f18 parse tree, occurs in two steps.

The first step builds a Pre-Fir Tree (PFT), a light weight tree of relevant indexes into the parse tree. This is done with a primary pass over the parse tree for a source file, which invokes a secondary pass at the function level. The primary pass creates the PFT data structure and fills in sequential pass information such as lexical successors for statements. The secondary pass (function analyzeBranches) is invoked at the end of each source function to fill in non-sequential branching information, such as the targets of goto statements.

The second step traverses the PFT to generate FIR. This step also has a primary traversal pass and a secondary, per-function pass. In this case, the secondary pass (function createEmptyBlocks) is a pre-pass invoked at the beginning of the primary pass for each function, which uses information gathered in the first step to generate most MLIR basic blocks in advance. The primary pass over the PFT then generates code in sequential order, which is possible since branch targets are valid without differentiating between forward and backward branches.

[kiranchandramohan]

Thanks @schweitz for submitting this change. I also felt that putting out all the changes in PFTBuilder as a single step is the best way forward while preparing D79731. I guess this will simplify the introduction of the bridge code.

I see that bulk of the changes are in PFTBuilder.h and PFTBuilder.cpp. Many are cosmetic but some changes look like a design change? I have summarised below the changes that I saw just for reference. It will be great to have some more explanation for the key changes in the code or in the commit message. Particularly for the introduction of the ReferenceVariant, removal of the annote functions, CFGannotations enum and the introduction of analyse functions.

Also, should any of the new pointers introduced in Evaluation/PFTBuilder struct/class be smart pointers?

PFTBuilder.h
-> Rename
EvaluationCollection to EvaluationList
ParentType to ParentVariant
Split constructs into constructs and directives.
FunctionLikeUnit:
evals -> evaluationList
funcs -> nestedFunctions (also in Module like unit)

-> Modification
createPFT function takes another argument semanticsContext

-> Introduce
LabelEvalMap type (an llvm dense map from Label to Evaluation*)
isIntermediateConstructStmt, isNopConstructStmt template variable expressions.
Types LabelSet, SymbolRef, SymbolLabelMap
ReferenceVariant class and helpers.
EvaluationTuple, EvaluationVariant, struct Evaluation
Struct variable
FunctionLikeUnit:
Functions to get location
LabelEvalMap labelEvaluationMap;
SymbolLabelMap assignSymbolLabelMap;
const semantics::Symbol *symbol{nullptr};
mlir::Block *finalBlock{};
std::vector<std::vector<Variable>> varList;

-> Remove
CFGAnnotation
CGJump
annotateControlFunction

PFTBuilder.cpp
-> Rename
All names with Eval changed to Evaluation. (dumpEvalList -> dumpEvaluationList)
evallist -> evaluationListStack
parents -> parentVariantStack

-> Introduce
getConstructName function
struct SymbolDependenceDepth and processSymbolTable function
const semantics::SemanticsContext &semanticsContext;
std::vector<lower::pft::Evaluation *> constructAndDirectiveStack{};
std::vector<lower::pft::Evaluation *> doConstructStack{};
llvm::DenseMap<parser::Label, lower::pft::Evaluation *> *labelEvaluationMap{nullptr};
lower::pft::SymbolLabelMap *assignSymbolLabelMap{nullptr};
std::map<std::string, lower::pft::Evaluation *> constructNameMap{};
lower::pft::Evaluation *lastLexicalEvaluation{nullptr};

-> Modification
analyzeBranches kind of replaces the annotate* functions. It is also called during PFT construction and hence need not be called separately, hence the call to annotateControl is not needed from f18.cpp.

Pre-fir tree tests
Minor change in tests {introduces space, distinguishes structured and unstructured}

flang/include/flang/Lower/PFTBuilder.h

46

Why is this not a reference variant?

134

nit: holds->hold

336

nit: remove this?

flang/lib/Lower/PFTBuilder.cpp

1044

nit: Remove this

[schweitz]

respond to some of the issues Kiran raised

[schweitz]

add a mutable reference variant data structure to hide pointers

[kiranchandramohan]

Looks OK to me. It will be great if @tskeith can review.

[schweitz]

Add a bit of implementation to replace a "stub" comment that related to supporting Fortran beyond F77.

[schweitz]

Change was submitted as fbac9ce226d7a27e418fdeac72a0b3c9f2c48742

flang/include/flang/Lower/PFTBuilder.h

-//===-- include/flang/Lower/PFTBuilder.h ------------------------*- C++ -*-===//
+//===-- Lower/PFTBuilder.h -- PFT builder -----------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
+//
+// PFT (Pre-FIR Tree) interface.
+//
+//===----------------------------------------------------------------------===//
 
-#ifndef FORTRAN_LOWER_PFT_BUILDER_H_
-#define FORTRAN_LOWER_PFT_BUILDER_H_
+#ifndef FORTRAN_LOWER_PFTBUILDER_H
+#define FORTRAN_LOWER_PFTBUILDER_H
 
+#include "flang/Common/reference.h"
 #include "flang/Common/template.h"
 #include "flang/Parser/parse-tree.h"
-#include <memory>
-
-/// Build a light-weight tree over the parse-tree to help with lowering to FIR.
-/// It is named Pre-FIR Tree (PFT) to underline it has no other usage than
-/// helping lowering to FIR.
-/// The PFT will capture pointers back into the parse tree, so the parse tree
-/// data structure may <em>not</em> be changed between the construction of the
-/// PFT and all of its uses.
-///
-/// The PFT captures a structured view of the program.  The program is a list of
-/// units.  Function like units will contain lists of evaluations.  Evaluations
-/// are either statements or constructs, where a construct contains a list of
-/// evaluations. The resulting PFT structure can then be used to create FIR.
-
-namespace llvm {
-class raw_ostream;
+#include "llvm/ADT/DenseMap.h"
+#include "llvm/ADT/SmallSet.h"
+#include "llvm/Support/raw_ostream.h"
+
+namespace mlir {
+class Block;
 }
 
-namespace Fortran::lower {
+namespace Fortran {
+namespace semantics {
+class SemanticsContext;
+class Scope;
+} // namespace semantics
+namespace lower {
 namespace pft {
 
 struct Evaluation;
 struct Program;
 struct ModuleLikeUnit;
 struct FunctionLikeUnit;
 
 // TODO: A collection of Evaluations can obviously be any of the container
 // types; leaving this as a std::list _for now_ because we reserve the right to
 // insert PFT nodes in any order in O(1) time.
-using EvaluationCollection = std::list<Evaluation>;
+using EvaluationList = std::list<Evaluation>;
+using LabelEvalMap = llvm::DenseMap<Fortran::parser::Label, Evaluation *>;
 
-struct ParentType {
-  template <typename A>
-  ParentType(A &parent) : p{&parent} {}
-  const std::variant<Program *, ModuleLikeUnit *, FunctionLikeUnit *,
-                     Evaluation *>
-      p;
-};
-
-/// Flags to describe the impact of parse-trees nodes on the program
-/// control flow. These annotations to parse-tree nodes are later used to
-/// build the control flow graph when lowering to FIR.
-enum class CFGAnnotation {
-  None,            // Node does not impact control flow.
-  Goto,            // Node acts like a goto on the control flow.
-  CondGoto,        // Node acts like a conditional goto on the control flow.
-  IndGoto,         // Node acts like an indirect goto on the control flow.
-  IoSwitch,        // Node is an IO statement with ERR, END, or EOR specifier.
-  Switch,          // Node acts like a switch on the control flow.
-  Iterative,       // Node creates iterations in the control flow.
-  FirStructuredOp, // Node is a structured loop.
-  Return,          // Node triggers a return from the current procedure.
-  Terminate        // Node terminates the program.
-};
+/// Provide a variant like container that can hold references. It can hold
+/// constant or mutable references. It is used in the other classes to provide
+/// union of const references to parse-tree nodes.
+template <bool isConst, typename... A>
+class ReferenceVariantBase {
+public:
+  template <typename B>
+  using BaseType = std::conditional_t<isConst, const B, B>;
+  template <typename B>
+  using Ref = common::Reference<BaseType<B>>;
+
+  ReferenceVariantBase() = delete;
+  template <typename B>
+  ReferenceVariantBase(B &b) : u{Ref<B>{b}} {}
+
+  template <typename B>
+  constexpr BaseType<B> &get() const {
+    return std::get<Ref<B>> > (u).get();
+  }
+  template <typename B>
+  constexpr BaseType<B> *getIf() const {
+    auto *ptr = std::get_if<Ref<B>>(&u);
+    return ptr ? &ptr->get() : nullptr;
+  }
+  template <typename B>
+  constexpr bool isA() const {
+    return std::holds_alternative<Ref<B>>(u);
+  }
+  template <typename VISITOR>
+  constexpr auto visit(VISITOR &&visitor) const {
+    return std::visit(
+        common::visitors{[&visitor](auto ref) { return visitor(ref.get()); }},
+        u);
+  }
 
-/// Compiler-generated jump
-///
-/// This is used to convert implicit control-flow edges to explicit form in the
-/// decorated PFT
-struct CGJump {
-  CGJump(Evaluation &to) : target{to} {}
-  Evaluation &target;
+private:
+  std::variant<Ref<A>...> u;
 };
+template <typename... A>
+using ReferenceVariant = ReferenceVariantBase<true, A...>;
+template <typename... A>
+using MutableReferenceVariant = ReferenceVariantBase<false, A...>;
+
+/// ParentVariant is used to provide a reference to the unit a parse-tree node
+/// belongs to. It is a variant of non-nullable pointers.
+using ParentVariant = MutableReferenceVariant<Program, ModuleLikeUnit,
+                                              FunctionLikeUnit, Evaluation>;
 
 /// Classify the parse-tree nodes from ExecutablePartConstruct
 
 using ActionStmts = std::tuple<
     parser::AllocateStmt, parser::AssignmentStmt, parser::BackspaceStmt,
     parser::CallStmt, parser::CloseStmt, parser::ContinueStmt,
     parser::CycleStmt, parser::DeallocateStmt, parser::EndfileStmt,
     parser::EventPostStmt, parser::EventWaitStmt, parser::ExitStmt,
     parser::FailImageStmt, parser::FlushStmt, parser::FormTeamStmt,
     parser::GotoStmt, parser::IfStmt, parser::InquireStmt, parser::LockStmt,
     parser::NullifyStmt, parser::OpenStmt, parser::PointerAssignmentStmt,
     parser::PrintStmt, parser::ReadStmt, parser::ReturnStmt, parser::RewindStmt,
     parser::StopStmt, parser::SyncAllStmt, parser::SyncImagesStmt,
     parser::SyncMemoryStmt, parser::SyncTeamStmt, parser::UnlockStmt,
     parser::WaitStmt, parser::WhereStmt, parser::WriteStmt,
     parser::ComputedGotoStmt, parser::ForallStmt, parser::ArithmeticIfStmt,
     parser::AssignStmt, parser::AssignedGotoStmt, parser::PauseStmt>;
 
 using OtherStmts = std::tuple<parser::FormatStmt, parser::EntryStmt,
                               parser::DataStmt, parser::NamelistStmt>;
 
-using Constructs =
-    std::tuple<parser::AssociateConstruct, parser::BlockConstruct,
-               parser::CaseConstruct, parser::ChangeTeamConstruct,
-               parser::CriticalConstruct, parser::DoConstruct,
-               parser::IfConstruct, parser::SelectRankConstruct,
-               parser::SelectTypeConstruct, parser::WhereConstruct,
-               parser::ForallConstruct, parser::CompilerDirective,
-               parser::OpenMPConstruct, parser::OmpEndLoopDirective>;
-
 using ConstructStmts = std::tuple<
     parser::AssociateStmt, parser::EndAssociateStmt, parser::BlockStmt,
     parser::EndBlockStmt, parser::SelectCaseStmt, parser::CaseStmt,
     parser::EndSelectStmt, parser::ChangeTeamStmt, parser::EndChangeTeamStmt,
     parser::CriticalStmt, parser::EndCriticalStmt, parser::NonLabelDoStmt,
     parser::EndDoStmt, parser::IfThenStmt, parser::ElseIfStmt, parser::ElseStmt,
     parser::EndIfStmt, parser::SelectRankStmt, parser::SelectRankCaseStmt,
     parser::SelectTypeStmt, parser::TypeGuardStmt, parser::WhereConstructStmt,
     parser::MaskedElsewhereStmt, parser::ElsewhereStmt, parser::EndWhereStmt,
     parser::ForallConstructStmt, parser::EndForallStmt>;
 
+using Constructs =
+    std::tuple<parser::AssociateConstruct, parser::BlockConstruct,
+               parser::CaseConstruct, parser::ChangeTeamConstruct,
+               parser::CriticalConstruct, parser::DoConstruct,
+               parser::IfConstruct, parser::SelectRankConstruct,
+               parser::SelectTypeConstruct, parser::WhereConstruct,
+               parser::ForallConstruct>;
+
+using Directives =
+    std::tuple<parser::CompilerDirective, parser::OpenMPConstruct,
+               parser::OmpEndLoopDirective>;
+
 template <typename A>
-constexpr static bool isActionStmt{common::HasMember<A, ActionStmts>};
+static constexpr bool isActionStmt{common::HasMember<A, ActionStmts>};
 
 template <typename A>
-constexpr static bool isConstruct{common::HasMember<A, Constructs>};
+static constexpr bool isOtherStmt{common::HasMember<A, OtherStmts>};
 
 template <typename A>
-constexpr static bool isConstructStmt{common::HasMember<A, ConstructStmts>};
+static constexpr bool isConstructStmt{common::HasMember<A, ConstructStmts>};
 
 template <typename A>
-constexpr static bool isOtherStmt{common::HasMember<A, OtherStmts>};
+static constexpr bool isConstruct{common::HasMember<A, Constructs>};
 
 template <typename A>
-constexpr static bool isGenerated{std::is_same_v<A, CGJump>};
+static constexpr bool isDirective{common::HasMember<A, Directives>};
 
 template <typename A>
-constexpr static bool isFunctionLike{common::HasMember<
+static constexpr bool isIntermediateConstructStmt{common::HasMember<
+    A, std::tuple<parser::CaseStmt, parser::ElseIfStmt, parser::ElseStmt,
+                  parser::SelectRankCaseStmt, parser::TypeGuardStmt>>};
+
+template <typename A>
+static constexpr bool isNopConstructStmt{common::HasMember<
+    A, std::tuple<parser::EndAssociateStmt, parser::CaseStmt,
+                  parser::EndSelectStmt, parser::ElseIfStmt, parser::ElseStmt,
+                  parser::EndIfStmt, parser::SelectRankCaseStmt,
+                  parser::TypeGuardStmt>>};
+
+template <typename A>
+static constexpr bool isFunctionLike{common::HasMember<
     A, std::tuple<parser::MainProgram, parser::FunctionSubprogram,
                   parser::SubroutineSubprogram,
                   parser::SeparateModuleSubprogram>>};
 
-/// Function-like units can contains lists of evaluations.  These can be
-/// (simple) statements or constructs, where a construct contains its own
-/// evaluations.
-struct Evaluation {
-  using EvalTuple = common::CombineTuples<ActionStmts, OtherStmts, Constructs,
-                                          ConstructStmts>;
+using LabelSet = llvm::SmallSet<parser::Label, 5>;
+using SymbolRef = common::Reference<const semantics::Symbol>;
+using SymbolLabelMap = llvm::DenseMap<SymbolRef, LabelSet>;
 
-  /// Hide non-nullable pointers to the parse-tree node.
-  template <typename A>
-  using MakeRefType = const A *const;
-  using EvalVariant =
-      common::CombineVariants<common::MapTemplate<MakeRefType, EvalTuple>,
-                              std::variant<CGJump>>;
-  template <typename A>
-  constexpr auto visit(A visitor) const {
-    return std::visit(common::visitors{
-                          [&](const auto *p) { return visitor(*p); },
-                          [&](auto &r) { return visitor(r); },
-                      },
-                      u);
-  }
-  template <typename A>
-  constexpr const A *getIf() const {
-    if constexpr (!std::is_same_v<A, CGJump>) {
-      if (auto *ptr{std::get_if<MakeRefType<A>>(&u)}) {
-        return *ptr;
-      }
-    } else {
-      return std::get_if<CGJump>(&u);
-    }
-    return nullptr;
-  }
-  template <typename A>
-  constexpr bool isA() const {
-    if constexpr (!std::is_same_v<A, CGJump>) {
-      return std::holds_alternative<MakeRefType<A>>(u);
-    }
-    return std::holds_alternative<CGJump>(u);
-  }
+struct MakeReferenceVariantHelper {};
+template <typename... A>
+struct MakeReferenceVariantHelper<std::variant<A...>> {
+  using type = ReferenceVariant<A...>;
+};
+template <typename... A>
+struct MakeReferenceVariantHelper<std::tuple<A...>> {
+  using type = ReferenceVariant<A...>;
+};
+using MakeReferenceVariant = typename MakeReferenceVariantHelper<A>::type;
 
-  Evaluation() = delete;
-  Evaluation(const Evaluation &) = delete;
-  Evaluation(Evaluation &&) = default;
+using EvaluationTuple =
+    common::CombineTuples<ActionStmts, OtherStmts, ConstructStmts, Constructs,
+                          Directives>;
+/// Hide non-nullable pointers to the parse-tree node.
+/// Build type std::variant<const A* const, const B* const, ...>
+/// from EvaluationTuple type (std::tuple<A, B, ...>).
+using EvaluationVariant = MakeReferenceVariant<EvaluationTuple>;
+
+/// Function-like units contain lists of evaluations.  These can be simple
+/// statements or constructs, where a construct contains its own evaluations.
+struct Evaluation : EvaluationVariant {
 
   /// General ctor
   template <typename A>
-  Evaluation(const A &a, const ParentType &p, const parser::CharBlock &pos,
-             const std::optional<parser::Label> &lab)
-      : u{&a}, parent{p}, pos{pos}, lab{lab} {}
-
-  /// Compiler-generated jump
-  Evaluation(const CGJump &jump, const ParentType &p)
-      : u{jump}, parent{p}, cfg{CFGAnnotation::Goto} {}
+  Evaluation(const A &a, const ParentVariant &parentVariant,
+             const parser::CharBlock &position,
+             const std::optional<parser::Label> &label)
+      : EvaluationVariant{a},
+        parentVariant{parentVariant}, position{position}, label{label} {}
 
   /// Construct ctor
   template <typename A>
-  Evaluation(const A &a, const ParentType &parent) : u{&a}, parent{parent} {
-    static_assert(pft::isConstruct<A>, "must be a construct");
+  Evaluation(const A &a, const ParentVariant &parentVariant)
+      : EvaluationVariant{a}, parentVariant{parentVariant} {
+    static_assert(pft::isConstruct<A> || pft::isDirective<A>,
+                  "must be a construct or directive");
   }
 
-  constexpr bool isActionOrGenerated() const {
+  /// Evaluation classification predicates.
+  constexpr bool isActionStmt() const {
     return visit(common::visitors{
-        [](auto &r) {
-          using T = std::decay_t<decltype(r)>;
-          return isActionStmt<T> || isGenerated<T>;
-        },
-    });
+        [](auto &r) { return pft::isActionStmt<std::decay_t<decltype(r)>>; }});
   }
-
-  constexpr bool isStmt() const {
+  constexpr bool isOtherStmt() const {
+    return visit(common::visitors{
+        [](auto &r) { return pft::isOtherStmt<std::decay_t<decltype(r)>>; }});
+  }
+  constexpr bool isConstructStmt() const {
+    return visit(common::visitors{[](auto &r) {
+      return pft::isConstructStmt<std::decay_t<decltype(r)>>;
+    }});
+  }
+  constexpr bool isConstruct() const {
+    return visit(common::visitors{
+        [](auto &r) { return pft::isConstruct<std::decay_t<decltype(r)>>; }});
+  }
+  constexpr bool isDirective() const {
     return visit(common::visitors{
-        [](auto &r) {
-          using T = std::decay_t<decltype(r)>;
-          static constexpr bool isStmt{isActionStmt<T> || isOtherStmt<T> ||
-                                       isConstructStmt<T>};
-          static_assert(!(isStmt && pft::isConstruct<T>),
-                        "statement classification is inconsistent");
-          return isStmt;
-        },
-    });
-  }
-  constexpr bool isConstruct() const { return !isStmt(); }
-
-  /// Set the type of originating control flow type for this evaluation.
-  void setCFG(CFGAnnotation a, Evaluation *cstr) {
-    cfg = a;
-    setBranches(cstr);
-  }
-
-  /// Is this evaluation a control-flow origin? (The PFT must be annotated)
-  bool isControlOrigin() const { return cfg != CFGAnnotation::None; }
-
-  /// Is this evaluation a control-flow target? (The PFT must be annotated)
-  bool isControlTarget() const { return isTarget; }
-
-  /// Set the containsBranches flag iff this evaluation (a construct) contains
-  /// control flow
-  void setBranches() { containsBranches = true; }
-
-  EvaluationCollection *getConstructEvals() {
-    auto *evals{subs.get()};
-    if (isStmt() && !evals) {
-      return nullptr;
-    }
-    if (isConstruct() && evals) {
-      return evals;
-    }
-    llvm_unreachable("evaluation subs is inconsistent");
-    return nullptr;
-  }
-
-  /// Set that the construct `cstr` (if not a nullptr) has branches.
-  static void setBranches(Evaluation *cstr) {
-    if (cstr)
-      cstr->setBranches();
-  }
-
-  EvalVariant u;
-  ParentType parent;
-  parser::CharBlock pos;
-  std::optional<parser::Label> lab;
-  std::unique_ptr<EvaluationCollection> subs; // construct sub-statements
-  CFGAnnotation cfg{CFGAnnotation::None};
-  bool isTarget{false};         // this evaluation is a control target
-  bool containsBranches{false}; // construct contains branches
+        [](auto &r) { return pft::isDirective<std::decay_t<decltype(r)>>; }});
+  }
+  /// Return the predicate:  "This is a non-initial, non-terminal construct
+  /// statement."  For an IfConstruct, this is ElseIfStmt and ElseStmt.
+  constexpr bool isIntermediateConstructStmt() const {
+    return visit(common::visitors{[](auto &r) {
+      return pft::isIntermediateConstructStmt<std::decay_t<decltype(r)>>;
+    }});
+  }
+  constexpr bool isNopConstructStmt() const {
+    return visit(common::visitors{[](auto &r) {
+      return pft::isNopConstructStmt<std::decay_t<decltype(r)>>;
+    }});
+  }
+
+  /// Return FunctionLikeUnit to which this evaluation
+  /// belongs. Nullptr if it does not belong to such unit.
+  FunctionLikeUnit *getOwningProcedure() const;
+
+  bool lowerAsStructured() const;
+  bool lowerAsUnstructured() const;
+
+  // FIR generation looks primarily at PFT statement (leaf) nodes.  So members
+  // such as lexicalSuccessor and the various block fields are only applicable
+  // to statement nodes.  One exception is that an internal construct node is
+  // a convenient place for a constructExit link that applies to exits from any
+  // statement within the construct.  The controlSuccessor member is used for
+  // nonlexical successors, such as linking to a GOTO target.  For multiway
+  // branches, controlSuccessor is set to one of the targets (might as well be
+  // the first target).  Successor and exit links always target statements.
+  //
+  // An unstructured construct is one that contains some form of goto.  This
+  // is indicated by the isUnstructured member flag, which may be set on a
+  // statement and propagated to enclosing constructs.  This distinction allows
+  // a structured IF or DO statement to be materialized with custom structured
+  // FIR operations.  An unstructured statement is materialized as mlir
+  // operation sequences that include explicit branches.
+  //
+  // There are two mlir::Block members.  The block member is set for statements
+  // that begin a new block.  If a statement may have more than one associated
+  // block, this member must be the block that would be the target of a branch
+  // to the statement.  The prime example of a statement that may have multiple
+  // associated blocks is NonLabelDoStmt, which may have a loop preheader block
+  // for loop initialization code, and always has a header block that is the
+  // target of the loop back edge.  If the NonLabelDoStmt is a concurrent loop,
+  // there may be an arbitrary number of nested preheader, header, and mask
+  // blocks.  Any such additional blocks in the localBlocks member are local
+  // to a construct and cannot be the target of an unstructured branch.  For
+  // NonLabelDoStmt, the block member designates the preheader block, which may
+  // be absent if loop initialization code may be appended to a predecessor
+  // block.  The primary loop header block is localBlocks[0], with additional
+  // DO CONCURRENT blocks at localBlocks[1], etc.
+  //
+  // The printIndex member is only set for statements.  It is used for dumps
+  // and does not affect FIR generation.  It may also be helpful for debugging.
+
+  ParentVariant parentVariant;
+  parser::CharBlock position{};
+  std::optional<parser::Label> label{};
+  std::unique_ptr<EvaluationList> evaluationList; // nested evaluations
+  Evaluation *parentConstruct{nullptr};  // set for nodes below the top level
+  Evaluation *lexicalSuccessor{nullptr}; // set for ActionStmt, ConstructStmt
+  Evaluation *controlSuccessor{nullptr}; // set for some statements
+  Evaluation *constructExit{nullptr};    // set for constructs
+  bool isNewBlock{false};                // evaluation begins a new basic block
+  bool isUnstructured{false};        // evaluation has unstructured control flow
+  bool skip{false};                  // evaluation has been processed in advance
+  class mlir::Block *block{nullptr}; // isNewBlock block
+  llvm::SmallVector<mlir::Block *, 1> localBlocks{}; // construct local blocks
+  int printIndex{0}; // (ActionStmt, ConstructStmt) evaluation index for dumps
 };
 
+using ProgramVariant =
+    ReferenceVariant<parser::MainProgram, parser::FunctionSubprogram,
+                     parser::SubroutineSubprogram, parser::Module,
+                     parser::Submodule, parser::SeparateModuleSubprogram,
+                     parser::BlockData>;
 /// A program is a list of program units.
-/// These units can be function like, module like, or block data
-struct ProgramUnit {
+/// These units can be function like, module like, or block data.
+struct ProgramUnit : ProgramVariant {
   template <typename A>
-  ProgramUnit(const A &ptr, const ParentType &parent)
-      : p{&ptr}, parent{parent} {}
+  ProgramUnit(const A &p, const ParentVariant &parentVariant)
+      : ProgramVariant{p}, parentVariant{parentVariant} {}
   ProgramUnit(ProgramUnit &&) = default;
   ProgramUnit(const ProgramUnit &) = delete;
 
-  const std::variant<
-      const parser::MainProgram *, const parser::FunctionSubprogram *,
-      const parser::SubroutineSubprogram *, const parser::Module *,
-      const parser::Submodule *, const parser::SeparateModuleSubprogram *,
-      const parser::BlockData *>
-      p;
-  ParentType parent;
+  ParentVariant parentVariant;
+};
+
+/// A variable captures an object to be created per the declaration part of a
+/// function like unit.
+///
+/// Properties can be applied by lowering. For example, a local array that is
+/// known to be very large may be transformed into a heap allocated entity by
+/// lowering. That decision would be tracked in its Variable instance.
+struct Variable {
+  explicit Variable(const Fortran::semantics::Symbol &sym, bool global = false,
+                    int depth = 0)
+      : sym{&sym}, depth{depth}, global{global} {}
+
+  const Fortran::semantics::Symbol &getSymbol() const { return *sym; }
+  
+  bool isGlobal() const { return global; }
+  bool isHeapAlloc() const { return heapAlloc; }
+  bool isPointer() const { return pointer; }
+  bool isTarget() const { return target; }
+  int getDepth() const { return depth; }
+  
+  void setHeapAlloc(bool to = true) { heapAlloc = to; }
+  void setPointer(bool to = true) { pointer = to; }
+  void setTarget(bool to = true) { target = to; }
+
+private:
+  const Fortran::semantics::Symbol *sym;
+  int depth;
+  bool global;
+  bool heapAlloc{false}; // variable needs deallocation on exit
+  bool pointer{false};
+  bool target{false};
 };
 
-/// Function-like units have similar structure. They all can contain executable
-/// statements as well as other function-like units (internal procedures and
-/// function statements).
+/// Function-like units may contain evaluations (executable statements) and
+/// nested function-like units (internal procedures and function statements).
 struct FunctionLikeUnit : public ProgramUnit {
   // wrapper statements for function-like syntactic structures
   using FunctionStatement =
-      std::variant<const parser::Statement<parser::ProgramStmt> *,
-                   const parser::Statement<parser::EndProgramStmt> *,
-                   const parser::Statement<parser::FunctionStmt> *,
-                   const parser::Statement<parser::EndFunctionStmt> *,
-                   const parser::Statement<parser::SubroutineStmt> *,
-                   const parser::Statement<parser::EndSubroutineStmt> *,
-                   const parser::Statement<parser::MpSubprogramStmt> *,
-                   const parser::Statement<parser::EndMpSubprogramStmt> *>;
-
-  FunctionLikeUnit(const parser::MainProgram &f, const ParentType &parent);
-  FunctionLikeUnit(const parser::FunctionSubprogram &f,
-                   const ParentType &parent);
-  FunctionLikeUnit(const parser::SubroutineSubprogram &f,
-                   const ParentType &parent);
-  FunctionLikeUnit(const parser::SeparateModuleSubprogram &f,
-                   const ParentType &parent);
+      ReferenceVariant<parser::Statement<parser::ProgramStmt>,
+                       parser::Statement<parser::EndProgramStmt>,
+                       parser::Statement<parser::FunctionStmt>,
+                       parser::Statement<parser::EndFunctionStmt>,
+                       parser::Statement<parser::SubroutineStmt>,
+                       parser::Statement<parser::EndSubroutineStmt>,
+                       parser::Statement<parser::MpSubprogramStmt>,
+                       parser::Statement<parser::EndMpSubprogramStmt>>;
+
+  FunctionLikeUnit(
+      const parser::MainProgram &f, const ParentVariant &parentVariant,
+      const Fortran::semantics::SemanticsContext &semanticsContext);
+  FunctionLikeUnit(
+      const parser::FunctionSubprogram &f, const ParentVariant &parentVariant,
+      const Fortran::semantics::SemanticsContext &semanticsContext);
+  FunctionLikeUnit(
+      const parser::SubroutineSubprogram &f, const ParentVariant &parentVariant,
+      const Fortran::semantics::SemanticsContext &semanticsContext);
+  FunctionLikeUnit(
+      const parser::SeparateModuleSubprogram &f,
+      const ParentVariant &parentVariant,
+      const Fortran::semantics::SemanticsContext &semanticsContext);
   FunctionLikeUnit(FunctionLikeUnit &&) = default;
   FunctionLikeUnit(const FunctionLikeUnit &) = delete;
 
-  bool isMainProgram() {
-    return std::holds_alternative<
-        const parser::Statement<parser::EndProgramStmt> *>(endStmt);
+  void processSymbolTable(const Fortran::semantics::Scope &);
+
+  std::vector<Variable> getOrderedSymbolTable() { return varList[0]; }
+
+  bool isMainProgram() const {
+    return endStmt.isA<parser::Statement<parser::EndProgramStmt>>();
   }
-  const parser::FunctionStmt *getFunction() {
-    return getA<parser::FunctionStmt>();
+
+  /// Get the starting source location for this function like unit
+  parser::CharBlock getStartingSourceLoc() {
+    if (beginStmt)
+      return stmtSourceLoc(*beginStmt);
+    if (!evaluationList.empty())
+      return evaluationList.front().position;
+    return stmtSourceLoc(endStmt);
   }
-  const parser::SubroutineStmt *getSubroutine() {
-    return getA<parser::SubroutineStmt>();
+
+  /// Returns reference to the subprogram symbol of this FunctionLikeUnit.
+  /// Dies if the FunctionLikeUnit is not a subprogram.
+  const semantics::Symbol &getSubprogramSymbol() const {
+    assert(symbol && "not inside a procedure");
+    return *symbol;
   }
-  const parser::MpSubprogramStmt *getMPSubp() {
-    return getA<parser::MpSubprogramStmt>();
+
+  /// Helper to get location from FunctionLikeUnit begin/end statements.
+  static parser::CharBlock stmtSourceLoc(const FunctionStatement &stmt) {
+    return stmt.visit(common::visitors{[](const auto &x) { return x.source; }});
   }
 
   /// Anonymous programs do not have a begin statement
   std::optional<FunctionStatement> beginStmt;
   FunctionStatement endStmt;
-  EvaluationCollection evals;        // statements
-  std::list<FunctionLikeUnit> funcs; // internal procedures
-
-private:
-  template <typename A>
-  const A *getA() {
-    if (beginStmt) {
-      if (auto p =
-              std::get_if<const parser::Statement<A> *>(&beginStmt.value()))
-        return &(*p)->statement;
-    }
-    return nullptr;
-  }
+  EvaluationList evaluationList;
+  LabelEvalMap labelEvaluationMap;
+  SymbolLabelMap assignSymbolLabelMap;
+  std::list<FunctionLikeUnit> nestedFunctions;
+  /// Symbol associated to this FunctionLikeUnit.
+  /// Null if the FunctionLikeUnit is an anonymous program.
+  /// The symbol has MainProgramDetails for named programs, otherwise it has
+  /// SubprogramDetails.
+  const semantics::Symbol *symbol{nullptr};
+  /// Terminal basic block (if any)
+  mlir::Block *finalBlock{};
+  std::vector<std::vector<Variable>> varList;
 };
 
-/// Module-like units have similar structure. They all can contain a list of
-/// function-like units.
+/// Module-like units contain a list of function-like units.
 struct ModuleLikeUnit : public ProgramUnit {
   // wrapper statements for module-like syntactic structures
   using ModuleStatement =
-      std::variant<const parser::Statement<parser::ModuleStmt> *,
-                   const parser::Statement<parser::EndModuleStmt> *,
-                   const parser::Statement<parser::SubmoduleStmt> *,
-                   const parser::Statement<parser::EndSubmoduleStmt> *>;
-
-  ModuleLikeUnit(const parser::Module &m, const ParentType &parent);
-  ModuleLikeUnit(const parser::Submodule &m, const ParentType &parent);
+      ReferenceVariant<parser::Statement<parser::ModuleStmt>,
+                       parser::Statement<parser::EndModuleStmt>,
+                       parser::Statement<parser::SubmoduleStmt>,
+                       parser::Statement<parser::EndSubmoduleStmt>>;
+
+  ModuleLikeUnit(const parser::Module &m, const ParentVariant &parentVariant);
+  ModuleLikeUnit(const parser::Submodule &m,
+                 const ParentVariant &parentVariant);
   ~ModuleLikeUnit() = default;
   ModuleLikeUnit(ModuleLikeUnit &&) = default;
   ModuleLikeUnit(const ModuleLikeUnit &) = delete;
 
   ModuleStatement beginStmt;
   ModuleStatement endStmt;
-  std::list<FunctionLikeUnit> funcs;
+  std::list<FunctionLikeUnit> nestedFunctions;
 };
 
 struct BlockDataUnit : public ProgramUnit {
-  BlockDataUnit(const parser::BlockData &bd, const ParentType &parent);
+  BlockDataUnit(const parser::BlockData &bd,
+                const ParentVariant &parentVariant);
   BlockDataUnit(BlockDataUnit &&) = default;
   BlockDataUnit(const BlockDataUnit &) = delete;
 };
 
-/// A Program is the top-level PFT
+/// A Program is the top-level root of the PFT.
 struct Program {
   using Units = std::variant<FunctionLikeUnit, ModuleLikeUnit, BlockDataUnit>;
 
   Program() = default;
   Program(Program &&) = default;
   Program(const Program &) = delete;
 
   std::list<Units> &getUnits() { return units; }
 
+  /// LLVM dump method on a Program.
+  void dump();
+
 private:
   std::list<Units> units;
 };
 
 } // namespace pft
 
-/// Create an PFT from the parse tree
-std::unique_ptr<pft::Program> createPFT(const parser::Program &root);
-
-/// Decorate the PFT with control flow annotations
+/// Create a PFT (Pre-FIR Tree) from the parse tree.
 ///
-/// The PFT must be decorated with control-flow annotations to prepare it for
-/// use in generating a CFG-like structure.
-void annotateControl(pft::Program &);
+/// A PFT is a light weight tree over the parse tree that is used to create FIR.
+/// The PFT captures pointers back into the parse tree, so the parse tree must
+/// not be changed between the construction of the PFT and its last use.  The
+/// PFT captures a structured view of a program.  A program is a list of units.
+/// A function like unit contains a list of evaluations.  An evaluation is
+/// either a statement, or a construct with a nested list of evaluations.
+std::unique_ptr<pft::Program>
+createPFT(const parser::Program &root,
+          const Fortran::semantics::SemanticsContext &semanticsContext);
 
-void dumpPFT(llvm::raw_ostream &o, pft::Program &);
+/// Dumper for displaying a PFT.
+void dumpPFT(llvm::raw_ostream &outputStream, pft::Program &pft);
 
-} // namespace Fortran::lower
+} // namespace lower
+} // namespace Fortran
 
-#endif // FORTRAN_LOWER_PFT_BUILDER_H_
+#endif // FORTRAN_LOWER_PFTBUILDER_H

flang/include/flang/Lower/Utils.h

+//===-- Lower/Utils.h -- utilities ------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_UTILS_H
+#define FORTRAN_LOWER_UTILS_H
+
+#include "flang/Common/indirection.h"
+#include "flang/Parser/char-block.h"
+#include "llvm/ADT/StringRef.h"
+
+/// Convert an F18 CharBlock to an LLVM StringRef
+inline llvm::StringRef toStringRef(const Fortran::parser::CharBlock &cb) {
+  return {cb.begin(), cb.size()};
+}
+
+/// Template helper to remove Fortran::common::Indirection wrappers.
+template <typename A>
+const A &removeIndirection(const A &a) {
+  return a;
+}
+template <typename A>
+const A &removeIndirection(const Fortran::common::Indirection<A> &a) {
+  return a.value();
+}
+
+#endif // FORTRAN_LOWER_UTILS_H

flang/include/flang/Semantics/symbol.h

 //===-- include/flang/Semantics/symbol.h ------------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_SEMANTICS_SYMBOL_H_
 #define FORTRAN_SEMANTICS_SYMBOL_H_
 
 #include "type.h"
 #include "flang/Common/Fortran.h"
 #include "flang/Common/enum-set.h"
 #include "flang/Common/reference.h"
+#include "llvm/ADT/DenseMapInfo.h"
 #include <array>
 #include <list>
 #include <optional>
 #include <set>
 #include <vector>
 
 namespace llvm {
 class raw_ostream;

 
 inline bool operator<(SymbolRef x, SymbolRef y) { return *x < *y; }
 inline bool operator<(MutableSymbolRef x, MutableSymbolRef y) {
   return *x < *y;
 }
 using SymbolSet = std::set<SymbolRef>;
 
 } // namespace Fortran::semantics
+
+// Define required  info so that SymbolRef can be used inside llvm::DenseMap.
+namespace llvm {
+template <> struct DenseMapInfo<Fortran::semantics::SymbolRef> {
+  static inline Fortran::semantics::SymbolRef getEmptyKey() {
+    auto ptr = DenseMapInfo<const Fortran::semantics::Symbol *>::getEmptyKey();
+    return *reinterpret_cast<Fortran::semantics::SymbolRef *>(&ptr);
+  }
+
+  static inline Fortran::semantics::SymbolRef getTombstoneKey() {
+    auto ptr =
+        DenseMapInfo<const Fortran::semantics::Symbol *>::getTombstoneKey();
+    return *reinterpret_cast<Fortran::semantics::SymbolRef *>(&ptr);
+  }
+
+  static unsigned getHashValue(const Fortran::semantics::SymbolRef &sym) {
+    return DenseMapInfo<const Fortran::semantics::Symbol *>::getHashValue(
+        &sym.get());
+  }
+
+  static bool isEqual(const Fortran::semantics::SymbolRef &LHS,
+      const Fortran::semantics::SymbolRef &RHS) {
+    return LHS == RHS;
+  }
+};
+} // namespace llvm
 #endif // FORTRAN_SEMANTICS_SYMBOL_H_

flang/lib/Lower/PFTBuilder.cpp

-//===-- lib/Lower/PFTBuilder.cc -------------------------------------------===//
+//===-- PFTBuilder.cc -----------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/PFTBuilder.h"
+#include "flang/Lower/Utils.h"
 #include "flang/Parser/dump-parse-tree.h"
 #include "flang/Parser/parse-tree-visitor.h"
-#include "llvm/ADT/DenseMap.h"
-#include <algorithm>
-#include <cassert>
-#include <utility>
+#include "flang/Semantics/semantics.h"
+#include "flang/Semantics/tools.h"
+#include "llvm/Support/CommandLine.h"
+
+static llvm::cl::opt<bool> clDisableStructuredFir(
+    "no-structured-fir", llvm::cl::desc("disable generation of structured FIR"),
+    llvm::cl::init(false), llvm::cl::Hidden);
 
-namespace Fortran::lower {
-namespace {
+using namespace Fortran;
 
-/// Helpers to unveil parser node inside parser::Statement<>,
-/// parser::UnlabeledStatement, and common::Indirection<>
+namespace {
+/// Helpers to unveil parser node inside Fortran::parser::Statement<>,
+/// Fortran::parser::UnlabeledStatement, and Fortran::common::Indirection<>
 template <typename A>
 struct RemoveIndirectionHelper {
   using Type = A;
-  static constexpr const Type &unwrap(const A &a) { return a; }
 };
 template <typename A>
 struct RemoveIndirectionHelper<common::Indirection<A>> {
   using Type = A;
-  static constexpr const Type &unwrap(const common::Indirection<A> &a) {
-    return a.value();
-  }
 };
 
 template <typename A>
-const auto &removeIndirection(const A &a) {
-  return RemoveIndirectionHelper<A>::unwrap(a);
-}
-
-template <typename A>
 struct UnwrapStmt {
   static constexpr bool isStmt{false};
 };
 template <typename A>
 struct UnwrapStmt<parser::Statement<A>> {
   static constexpr bool isStmt{true};
   using Type = typename RemoveIndirectionHelper<A>::Type;
   constexpr UnwrapStmt(const parser::Statement<A> &a)
-      : unwrapped{removeIndirection(a.statement)}, pos{a.source}, lab{a.label} {
-  }
+      : unwrapped{removeIndirection(a.statement)}, position{a.source},
+        label{a.label} {}
   const Type &unwrapped;
-  parser::CharBlock pos;
-  std::optional<parser::Label> lab;
+  parser::CharBlock position;
+  std::optional<parser::Label> label;
 };
 template <typename A>
 struct UnwrapStmt<parser::UnlabeledStatement<A>> {
   static constexpr bool isStmt{true};
   using Type = typename RemoveIndirectionHelper<A>::Type;
   constexpr UnwrapStmt(const parser::UnlabeledStatement<A> &a)
-      : unwrapped{removeIndirection(a.statement)}, pos{a.source} {}
+      : unwrapped{removeIndirection(a.statement)}, position{a.source} {}
   const Type &unwrapped;
-  parser::CharBlock pos;
-  std::optional<parser::Label> lab;
+  parser::CharBlock position;
+  std::optional<parser::Label> label;
 };
 
 /// The instantiation of a parse tree visitor (Pre and Post) is extremely
-/// expensive in terms of compile and link time, so one goal here is to limit
-/// the bridge to one such instantiation.
+/// expensive in terms of compile and link time.  So one goal here is to
+/// limit the bridge to one such instantiation.
 class PFTBuilder {
 public:
-  PFTBuilder() : pgm{new pft::Program}, parents{*pgm.get()} {}
+  PFTBuilder(const semantics::SemanticsContext &semanticsContext)
+      : pgm{std::make_unique<lower::pft::Program>()},
+        parentVariantStack{*pgm.get()}, semanticsContext{semanticsContext} {}
 
   /// Get the result
-  std::unique_ptr<pft::Program> result() { return std::move(pgm); }
+  std::unique_ptr<lower::pft::Program> result() { return std::move(pgm); }
 
   template <typename A>
   constexpr bool Pre(const A &a) {
-    bool visit{true};
-    if constexpr (pft::isFunctionLike<A>) {
-      return enterFunc(a);
-    } else if constexpr (pft::isConstruct<A>) {
-      return enterConstruct(a);
+    if constexpr (lower::pft::isFunctionLike<A>) {
+      return enterFunction(a, semanticsContext);
+    } else if constexpr (lower::pft::isConstruct<A> ||
+                         lower::pft::isDirective<A>) {
+      return enterConstructOrDirective(a);
     } else if constexpr (UnwrapStmt<A>::isStmt) {
       using T = typename UnwrapStmt<A>::Type;
       // Node "a" being visited has one of the following types:
       // Statement<T>, Statement<Indirection<T>, UnlabeledStatement<T>,
       // or UnlabeledStatement<Indirection<T>>
       auto stmt{UnwrapStmt<A>(a)};
-      if constexpr (pft::isConstructStmt<T> || pft::isOtherStmt<T>) {
-        addEval(pft::Evaluation{stmt.unwrapped, parents.back(), stmt.pos,
-                                stmt.lab});
-        visit = false;
+      if constexpr (lower::pft::isConstructStmt<T> ||
+                    lower::pft::isOtherStmt<T>) {
+        addEvaluation(lower::pft::Evaluation{stmt.unwrapped,
+                                             parentVariantStack.back(),
+                                             stmt.position, stmt.label});
+        return false;
       } else if constexpr (std::is_same_v<T, parser::ActionStmt>) {
-        addEval(makeEvalAction(stmt.unwrapped, stmt.pos, stmt.lab));
-        visit = false;
+        addEvaluation(
+            makeEvaluationAction(stmt.unwrapped, stmt.position, stmt.label));
+        return true;
       }
     }
-    return visit;
+    return true;
   }
 
   template <typename A>
   constexpr void Post(const A &) {
-    if constexpr (pft::isFunctionLike<A>) {
-      exitFunc();
-    } else if constexpr (pft::isConstruct<A>) {
-      exitConstruct();
+    if constexpr (lower::pft::isFunctionLike<A>) {
+      exitFunction();
+    } else if constexpr (lower::pft::isConstruct<A> ||
+                         lower::pft::isDirective<A>) {
+      exitConstructOrDirective();
     }
   }
 
   // Module like
   bool Pre(const parser::Module &node) { return enterModule(node); }
   bool Pre(const parser::Submodule &node) { return enterModule(node); }
 
   void Post(const parser::Module &) { exitModule(); }
   void Post(const parser::Submodule &) { exitModule(); }
 
   // Block data
   bool Pre(const parser::BlockData &node) {
-    addUnit(pft::BlockDataUnit{node, parents.back()});
+    addUnit(lower::pft::BlockDataUnit{node, parentVariantStack.back()});
     return false;
   }
 
   // Get rid of production wrapper
   bool Pre(const parser::UnlabeledStatement<parser::ForallAssignmentStmt>
                &statement) {
-    addEval(std::visit(
+    addEvaluation(std::visit(
         [&](const auto &x) {
-          return pft::Evaluation{x, parents.back(), statement.source, {}};
+          return lower::pft::Evaluation{
+              x, parentVariantStack.back(), statement.source, {}};
         },
         statement.statement.u));
     return false;
   }
   bool Pre(const parser::Statement<parser::ForallAssignmentStmt> &statement) {
-    addEval(std::visit(
+    addEvaluation(std::visit(
         [&](const auto &x) {
-          return pft::Evaluation{x, parents.back(), statement.source,
-                                 statement.label};
+          return lower::pft::Evaluation{x, parentVariantStack.back(),
+                                        statement.source, statement.label};
         },
         statement.statement.u));
     return false;
   }
   bool Pre(const parser::WhereBodyConstruct &whereBody) {
     return std::visit(
         common::visitors{
             [&](const parser::Statement<parser::AssignmentStmt> &stmt) {
               // Not caught as other AssignmentStmt because it is not
               // wrapped in a parser::ActionStmt.
-              addEval(pft::Evaluation{stmt.statement, parents.back(),
+              addEvaluation(lower::pft::Evaluation{stmt.statement,
+                                                   parentVariantStack.back(),
                                                    stmt.source, stmt.label});
               return false;
             },
             [&](const auto &) { return true; },
         },
         whereBody.u);
   }
 
 private:
-  // ActionStmt has a couple of non-conforming cases, which get handled
-  // explicitly here.  The other cases use an Indirection, which we discard in
-  // the PFT.
-  pft::Evaluation makeEvalAction(const parser::ActionStmt &statement,
-                                 parser::CharBlock pos,
-                                 std::optional<parser::Label> lab) {
-    return std::visit(
-        common::visitors{
-            [&](const auto &x) {
-              return pft::Evaluation{removeIndirection(x), parents.back(), pos,
-                                     lab};
-            },
-        },
-        statement.u);
-  }
-
-  // When we enter a function-like structure, we want to build a new unit and
-  // set the builder's cursors to point to it.
+  /// Initialize a new module-like unit and make it the builder's focus.
   template <typename A>
-  bool enterFunc(const A &func) {
-    auto &unit = addFunc(pft::FunctionLikeUnit{func, parents.back()});
-    funclist = &unit.funcs;
-    pushEval(&unit.evals);
-    parents.emplace_back(unit);
+  bool enterModule(const A &func) {
+    auto &unit =
+        addUnit(lower::pft::ModuleLikeUnit{func, parentVariantStack.back()});
+    functionList = &unit.nestedFunctions;
+    parentVariantStack.emplace_back(unit);
     return true;
   }
-  /// Make funclist to point to current parent function list if it exists.
-  void setFunctListToParentFuncs() {
-    if (!parents.empty()) {
-      std::visit(common::visitors{
-                     [&](pft::FunctionLikeUnit *p) { funclist = &p->funcs; },
-                     [&](pft::ModuleLikeUnit *p) { funclist = &p->funcs; },
-                     [&](auto *) { funclist = nullptr; },
-                 },
-                 parents.back().p);
-    }
-  }
 
-  void exitFunc() {
-    popEval();
-    parents.pop_back();
-    setFunctListToParentFuncs();
+  void exitModule() {
+    parentVariantStack.pop_back();
+    resetFunctionList();
   }
 
-  // When we enter a construct structure, we want to build a new construct and
-  // set the builder's evaluation cursor to point to it.
+  /// Initialize a new function-like unit and make it the builder's focus.
   template <typename A>
-  bool enterConstruct(const A &construct) {
-    auto &con = addEval(pft::Evaluation{construct, parents.back()});
-    con.subs.reset(new pft::EvaluationCollection);
-    pushEval(con.subs.get());
-    parents.emplace_back(con);
+  bool enterFunction(const A &func,
+                     const semantics::SemanticsContext &semanticsContext) {
+    auto &unit = addFunction(lower::pft::FunctionLikeUnit{
+        func, parentVariantStack.back(), semanticsContext});
+    labelEvaluationMap = &unit.labelEvaluationMap;
+    assignSymbolLabelMap = &unit.assignSymbolLabelMap;
+    functionList = &unit.nestedFunctions;
+    pushEvaluationList(&unit.evaluationList);
+    parentVariantStack.emplace_back(unit);
     return true;
   }
 
-  void exitConstruct() {
-    popEval();
-    parents.pop_back();
+  void exitFunction() {
+    // Guarantee that there is a branch target after the last user statement.
+    static const parser::ContinueStmt endTarget{};
+    addEvaluation(
+        lower::pft::Evaluation{endTarget, parentVariantStack.back(), {}, {}});
+    lastLexicalEvaluation = nullptr;
+    analyzeBranches(nullptr, *evaluationListStack.back()); // add branch links
+    popEvaluationList();
+    labelEvaluationMap = nullptr;
+    assignSymbolLabelMap = nullptr;
+    parentVariantStack.pop_back();
+    resetFunctionList();
   }
 
-  // When we enter a module structure, we want to build a new module and
-  // set the builder's function cursor to point to it.
+  /// Initialize a new construct and make it the builder's focus.
   template <typename A>
-  bool enterModule(const A &func) {
-    auto &unit = addUnit(pft::ModuleLikeUnit{func, parents.back()});
-    funclist = &unit.funcs;
-    parents.emplace_back(unit);
+  bool enterConstructOrDirective(const A &construct) {
+    auto &eval = addEvaluation(
+        lower::pft::Evaluation{construct, parentVariantStack.back()});
+    eval.evaluationList.reset(new lower::pft::EvaluationList);
+    pushEvaluationList(eval.evaluationList.get());
+    parentVariantStack.emplace_back(eval);
+    constructAndDirectiveStack.emplace_back(&eval);
     return true;
   }
 
-  void exitModule() {
-    parents.pop_back();
-    setFunctListToParentFuncs();
+  void exitConstructOrDirective() {
+    popEvaluationList();
+    parentVariantStack.pop_back();
+    constructAndDirectiveStack.pop_back();
+  }
+
+  /// Reset functionList to an enclosing function's functionList.
+  void resetFunctionList() {
+    if (!parentVariantStack.empty()) {
+      parentVariantStack.back().visit(common::visitors{
+          [&](lower::pft::FunctionLikeUnit &p) {
+            functionList = &p.nestedFunctions;
+          },
+          [&](lower::pft::ModuleLikeUnit &p) {
+            functionList = &p.nestedFunctions;
+          },
+          [&](auto &) { functionList = nullptr; },
+      });
+    }
   }
 
   template <typename A>
   A &addUnit(A &&unit) {
     pgm->getUnits().emplace_back(std::move(unit));
     return std::get<A>(pgm->getUnits().back());
   }
 
   template <typename A>
-  A &addFunc(A &&func) {
-    if (funclist) {
-      funclist->emplace_back(std::move(func));
-      return funclist->back();
+  A &addFunction(A &&func) {
+    if (functionList) {
+      functionList->emplace_back(std::move(func));
+      return functionList->back();
     }
     return addUnit(std::move(func));
   }
 
-  /// move the Evaluation to the end of the current list
-  pft::Evaluation &addEval(pft::Evaluation &&eval) {
-    assert(funclist && "not in a function");
-    assert(evallist.size() > 0);
-    evallist.back()->emplace_back(std::move(eval));
-    return evallist.back()->back();
+  // ActionStmt has a couple of non-conforming cases, explicitly handled here.
+  // The other cases use an Indirection, which are discarded in the PFT.
+  lower::pft::Evaluation
+  makeEvaluationAction(const parser::ActionStmt &statement,
+                       parser::CharBlock position,
+                       std::optional<parser::Label> label) {
+    return std::visit(
+        common::visitors{
+            [&](const auto &x) {
+              return lower::pft::Evaluation{removeIndirection(x),
+                                            parentVariantStack.back(), position,
+                                            label};
+            },
+        },
+        statement.u);
+  }
+
+  /// Append an Evaluation to the end of the current list.
+  lower::pft::Evaluation &addEvaluation(lower::pft::Evaluation &&eval) {
+    assert(functionList && "not in a function");
+    assert(evaluationListStack.size() > 0);
+    if (constructAndDirectiveStack.size() > 0) {
+      eval.parentConstruct = constructAndDirectiveStack.back();
+    }
+    evaluationListStack.back()->emplace_back(std::move(eval));
+    lower::pft::Evaluation *p = &evaluationListStack.back()->back();
+    if (p->isActionStmt() || p->isConstructStmt()) {
+      if (lastLexicalEvaluation) {
+        lastLexicalEvaluation->lexicalSuccessor = p;
+        p->printIndex = lastLexicalEvaluation->printIndex + 1;
+      } else {
+        p->printIndex = 1;
+      }
+      lastLexicalEvaluation = p;
+    }
+    if (p->label.has_value()) {
+      labelEvaluationMap->try_emplace(*p->label, p);
+    }
+    return evaluationListStack.back()->back();
   }
 
   /// push a new list on the stack of Evaluation lists
-  void pushEval(pft::EvaluationCollection *eval) {
-    assert(funclist && "not in a function");
+  void pushEvaluationList(lower::pft::EvaluationList *eval) {
+    assert(functionList && "not in a function");
     assert(eval && eval->empty() && "evaluation list isn't correct");
-    evallist.emplace_back(eval);
+    evaluationListStack.emplace_back(eval);
   }
 
   /// pop the current list and return to the last Evaluation list
-  void popEval() {
-    assert(funclist && "not in a function");
-    evallist.pop_back();
+  void popEvaluationList() {
+    assert(functionList && "not in a function");
+    evaluationListStack.pop_back();
   }
 
-  std::unique_ptr<pft::Program> pgm;
-  /// funclist points to FunctionLikeUnit::funcs list (resp.
-  /// ModuleLikeUnit::funcs) when building a FunctionLikeUnit (resp.
-  /// ModuleLikeUnit) to store internal procedures (resp. module procedures).
-  /// Otherwise (e.g. when building the top level Program), it is null.
-  std::list<pft::FunctionLikeUnit> *funclist{nullptr};
-  /// evallist is a stack of pointer to FunctionLikeUnit::evals (or
-  /// Evaluation::subs) that are being build.
-  std::vector<pft::EvaluationCollection *> evallist;
-  std::vector<pft::ParentType> parents;
-};
+  /// Mark I/O statement ERR, EOR, and END specifier branch targets.
+  template <typename A>
+  void analyzeIoBranches(lower::pft::Evaluation &eval, const A &stmt) {
+    auto processIfLabel{[&](const auto &specs) {
+      using LabelNodes =
+          std::tuple<parser::ErrLabel, parser::EorLabel, parser::EndLabel>;
+      for (const auto &spec : specs) {
+        const auto *label = std::visit(
+            [](const auto &label) -> const parser::Label * {
+              using B = std::decay_t<decltype(label)>;
+              if constexpr (common::HasMember<B, LabelNodes>) {
+                return &label.v;
+              }
+              return nullptr;
+            },
+            spec.u);
+
+        if (label)
+          markBranchTarget(eval, *label);
+      }
+    }};
+
+    using OtherIOStmts =
+        std::tuple<parser::BackspaceStmt, parser::CloseStmt,
+                   parser::EndfileStmt, parser::FlushStmt, parser::OpenStmt,
+                   parser::RewindStmt, parser::WaitStmt>;
 
-template <typename Label, typename A>
-constexpr bool hasLabel(const A &stmt) {
-  auto isLabel{
-      [](const auto &v) { return std::holds_alternative<Label>(v.u); }};
     if constexpr (std::is_same_v<A, parser::ReadStmt> ||
                   std::is_same_v<A, parser::WriteStmt>) {
-    return std::any_of(std::begin(stmt.controls), std::end(stmt.controls),
-                       isLabel);
+      processIfLabel(stmt.controls);
+    } else if constexpr (std::is_same_v<A, parser::InquireStmt>) {
+      processIfLabel(std::get<std::list<parser::InquireSpec>>(stmt.u));
+    } else if constexpr (common::HasMember<A, OtherIOStmts>) {
+      processIfLabel(stmt.v);
+    } else {
+      // Always crash if this is instantiated
+      static_assert(!std::is_same_v<A, parser::ReadStmt>,
+                    "Unexpected IO statement");
+    }
   }
-  if constexpr (std::is_same_v<A, parser::WaitStmt>) {
-    return std::any_of(std::begin(stmt.v), std::end(stmt.v), isLabel);
+
+  /// Set the exit of a construct, possibly from multiple enclosing constructs.
+  void setConstructExit(lower::pft::Evaluation &eval) {
+    eval.constructExit = eval.evaluationList->back().lexicalSuccessor;
+    if (eval.constructExit && eval.constructExit->isNopConstructStmt()) {
+      eval.constructExit = eval.constructExit->parentConstruct->constructExit;
     }
-  if constexpr (std::is_same_v<Label, parser::ErrLabel>) {
-    if constexpr (common::HasMember<
-                      A, std::tuple<parser::OpenStmt, parser::CloseStmt,
-                                    parser::BackspaceStmt, parser::EndfileStmt,
-                                    parser::RewindStmt, parser::FlushStmt>>)
-      return std::any_of(std::begin(stmt.v), std::end(stmt.v), isLabel);
-    if constexpr (std::is_same_v<A, parser::InquireStmt>) {
-      const auto &specifiers{std::get<std::list<parser::InquireSpec>>(stmt.u)};
-      return std::any_of(std::begin(specifiers), std::end(specifiers), isLabel);
-    }
+    assert(eval.constructExit && "missing construct exit");
+
+  void markBranchTarget(lower::pft::Evaluation &sourceEvaluation,
+                        lower::pft::Evaluation &targetEvaluation) {
+    sourceEvaluation.isUnstructured = true;
+    if (!sourceEvaluation.controlSuccessor) {
+      sourceEvaluation.controlSuccessor = &targetEvaluation;
     }
-  return false;
+    targetEvaluation.isNewBlock = true;
+  }
+  void markBranchTarget(lower::pft::Evaluation &sourceEvaluation,
+                        parser::Label label) {
+    assert(label && "missing branch target label");
+    lower::pft::Evaluation *targetEvaluation{
+        labelEvaluationMap->find(label)->second};
+    assert(targetEvaluation && "missing branch target evaluation");
+    markBranchTarget(sourceEvaluation, *targetEvaluation);
   }
 
-bool hasAltReturns(const parser::CallStmt &callStmt) {
-  const auto &args{std::get<std::list<parser::ActualArgSpec>>(callStmt.v.t)};
-  for (const auto &arg : args) {
-    const auto &actual{std::get<parser::ActualArg>(arg.t)};
-    if (std::holds_alternative<parser::AltReturnSpec>(actual.u))
-      return true;
+  /// Return the first non-nop successor of an evaluation, possibly exiting
+  /// from one or more enclosing constructs.
+  lower::pft::Evaluation *exitSuccessor(lower::pft::Evaluation &eval) {
+    lower::pft::Evaluation *successor{eval.lexicalSuccessor};
+    if (successor && successor->isNopConstructStmt()) {
+      successor = successor->parentConstruct->constructExit;
     }
-  return false;
+    assert(successor && "missing exit successor");
+    return successor;
+  }
+
+  /// Mark the exit successor of an Evaluation as a new block.
+  void markSuccessorAsNewBlock(lower::pft::Evaluation &eval) {
+    exitSuccessor(eval)->isNewBlock = true;
   }
 
-/// Determine if `callStmt` has alternate returns and if so set `e` to be the
-/// origin of a switch-like control flow
-///
-/// \param cstr points to the current construct. It may be null at the top-level
-/// of a FunctionLikeUnit.
-void altRet(pft::Evaluation &evaluation, const parser::CallStmt &callStmt,
-            pft::Evaluation *cstr) {
-  if (hasAltReturns(callStmt))
-    evaluation.setCFG(pft::CFGAnnotation::Switch, cstr);
-}
-
-/// \param cstr points to the current construct. It may be null at the top-level
-/// of a FunctionLikeUnit.
-void annotateEvalListCFG(pft::EvaluationCollection &evaluationCollection,
-                         pft::Evaluation *cstr) {
-  bool nextIsTarget = false;
-  for (auto &eval : evaluationCollection) {
-    eval.isTarget = nextIsTarget;
-    nextIsTarget = false;
-    if (auto *subs{eval.getConstructEvals()}) {
-      annotateEvalListCFG(*subs, &eval);
-      // assume that the entry and exit are both possible branch targets
-      nextIsTarget = true;
-    }
+  template <typename A>
+  inline std::string getConstructName(const A &stmt) {
+    using MaybeConstructNameWrapper =
+        std::tuple<parser::BlockStmt, parser::CycleStmt, parser::ElseStmt,
+                   parser::ElsewhereStmt, parser::EndAssociateStmt,
+                   parser::EndBlockStmt, parser::EndCriticalStmt,
+                   parser::EndDoStmt, parser::EndForallStmt, parser::EndIfStmt,
+                   parser::EndSelectStmt, parser::EndWhereStmt,
+                   parser::ExitStmt>;
+    if constexpr (common::HasMember<A, MaybeConstructNameWrapper>) {
+      if (stmt.v)
+        return stmt.v->ToString();
+    }
+
+    using MaybeConstructNameInTuple = std::tuple<
+        parser::AssociateStmt, parser::CaseStmt, parser::ChangeTeamStmt,
+        parser::CriticalStmt, parser::ElseIfStmt, parser::EndChangeTeamStmt,
+        parser::ForallConstructStmt, parser::IfThenStmt, parser::LabelDoStmt,
+        parser::MaskedElsewhereStmt, parser::NonLabelDoStmt,
+        parser::SelectCaseStmt, parser::SelectRankCaseStmt,
+        parser::TypeGuardStmt, parser::WhereConstructStmt>;
+
+    if constexpr (common::HasMember<A, MaybeConstructNameInTuple>) {
+      if (auto name{std::get<std::optional<parser::Name>>(stmt.t)})
+        return name->ToString();
+    }
+
+    // These statements have several std::optional<parser::Name>
+    if constexpr (std::is_same_v<A, parser::SelectRankStmt> ||
+                  std::is_same_v<A, parser::SelectTypeStmt>) {
+      if (auto name{std::get<0>(stmt.t)}) {
+        return name->ToString();
+      }
+    }
+    return {};
 
-    if (eval.isActionOrGenerated() && eval.lab.has_value())
-      eval.isTarget = true;
+  /// \p parentConstruct can be null if this statement is at the highest
+  /// level of a program.
+  template <typename A>
+  void insertConstructName(const A &stmt,
+                           lower::pft::Evaluation *parentConstruct) {
+    std::string name{getConstructName(stmt)};
+    if (!name.empty()) {
+      constructNameMap[name] = parentConstruct;
+    }
+  }
+
+  /// Insert branch links for a list of Evaluations.
+  /// \p parentConstruct can be null if the evaluationList contains the
+  /// top-level statements of a program.
+  void analyzeBranches(lower::pft::Evaluation *parentConstruct,
+                       std::list<lower::pft::Evaluation> &evaluationList) {
+    lower::pft::Evaluation *lastConstructStmtEvaluation{nullptr};
+    lower::pft::Evaluation *lastIfStmtEvaluation{nullptr};
+    for (auto &eval : evaluationList) {
       eval.visit(common::visitors{
-        [&](const parser::CallStmt &statement) {
-          altRet(eval, statement, cstr);
-        },
-        [&](const parser::CycleStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Goto, cstr);
-        },
-        [&](const parser::ExitStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Goto, cstr);
-        },
-        [&](const parser::FailImageStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Terminate, cstr);
-        },
-        [&](const parser::GotoStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Goto, cstr);
+          // Action statements
+          [&](const parser::CallStmt &s) {
+            // Look for alternate return specifiers.
+            const auto &args{std::get<std::list<parser::ActualArgSpec>>(s.v.t)};
+            for (const auto &arg : args) {
+              const auto &actual{std::get<parser::ActualArg>(arg.t)};
+              if (const auto *altReturn{
+                      std::get_if<parser::AltReturnSpec>(&actual.u)}) {
+                markBranchTarget(eval, altReturn->v);
+              }
+            }
           },
-        [&](const parser::IfStmt &) {
-          eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
+          [&](const parser::CycleStmt &s) {
+            std::string name{getConstructName(s)};
+            lower::pft::Evaluation *construct{name.empty()
+                                                  ? doConstructStack.back()
+                                                  : constructNameMap[name]};
+            assert(construct && "missing CYCLE construct");
+            markBranchTarget(eval, construct->evaluationList->back());
+          },
+          [&](const parser::ExitStmt &s) {
+            std::string name{getConstructName(s)};
+            lower::pft::Evaluation *construct{name.empty()
+                                                  ? doConstructStack.back()
+                                                  : constructNameMap[name]};
+            assert(construct && "missing EXIT construct");
+            markBranchTarget(eval, *construct->constructExit);
           },
+          [&](const parser::GotoStmt &s) { markBranchTarget(eval, s.v); },
+          [&](const parser::IfStmt &) { lastIfStmtEvaluation = &eval; },
           [&](const parser::ReturnStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Return, cstr);
+            eval.isUnstructured = true;
+            if (eval.lexicalSuccessor->lexicalSuccessor)
+              markSuccessorAsNewBlock(eval);
           },
           [&](const parser::StopStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Terminate, cstr);
-        },
-        [&](const parser::ArithmeticIfStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Switch, cstr);
+            eval.isUnstructured = true;
+            if (eval.lexicalSuccessor->lexicalSuccessor)
+              markSuccessorAsNewBlock(eval);
+          },
+          [&](const parser::ComputedGotoStmt &s) {
+            for (auto &label : std::get<std::list<parser::Label>>(s.t)) {
+              markBranchTarget(eval, label);
+            }
+          },
+          [&](const parser::ArithmeticIfStmt &s) {
+            markBranchTarget(eval, std::get<1>(s.t));
+            markBranchTarget(eval, std::get<2>(s.t));
+            markBranchTarget(eval, std::get<3>(s.t));
+            if (semantics::ExprHasTypeCategory(
+                    *semantics::GetExpr(std::get<parser::Expr>(s.t)),
+                    common::TypeCategory::Real)) {
+              // Real expression evaluation uses an additional local block.
+              eval.localBlocks.emplace_back(nullptr);
+            }
+          },
+          [&](const parser::AssignStmt &s) { // legacy label assignment
+            auto &label = std::get<parser::Label>(s.t);
+            const auto *sym = std::get<parser::Name>(s.t).symbol;
+            assert(sym && "missing AssignStmt symbol");
+            lower::pft::Evaluation *target{
+                labelEvaluationMap->find(label)->second};
+            assert(target && "missing branch target evaluation");
+            if (!target->isA<parser::FormatStmt>()) {
+              target->isNewBlock = true;
+            }
+            auto iter = assignSymbolLabelMap->find(*sym);
+            if (iter == assignSymbolLabelMap->end()) {
+              lower::pft::LabelSet labelSet{};
+              labelSet.insert(label);
+              assignSymbolLabelMap->try_emplace(*sym, labelSet);
+            } else {
+              iter->second.insert(label);
+            }
           },
           [&](const parser::AssignedGotoStmt &) {
-          eval.setCFG(pft::CFGAnnotation::IndGoto, cstr);
-        },
-        [&](const parser::ComputedGotoStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Switch, cstr);
+            // Although this statement is a branch, it doesn't have any
+            // explicit control successors.  So the code at the end of the
+            // loop won't mark the exit successor.  Do that here.
+            markSuccessorAsNewBlock(eval);
           },
-        [&](const parser::WhereStmt &) {
-          // fir.loop + fir.where around the next stmt
-          eval.isTarget = true;
-          eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
+
+          // Construct statements
+          [&](const parser::AssociateStmt &s) {
+            insertConstructName(s, parentConstruct);
           },
-        [&](const parser::ForallStmt &) {
-          // fir.loop around the next stmt
-          eval.isTarget = true;
-          eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
-        },
-        [&](pft::CGJump &) { eval.setCFG(pft::CFGAnnotation::Goto, cstr); },
-        [&](const parser::SelectCaseStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Switch, cstr);
-        },
-        [&](const parser::NonLabelDoStmt &) {
-          eval.isTarget = true;
-          eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
+          [&](const parser::BlockStmt &s) {
+            insertConstructName(s, parentConstruct);
+          },
+          [&](const parser::SelectCaseStmt &s) {
+            insertConstructName(s, parentConstruct);
+            lastConstructStmtEvaluation = &eval;
+          },
+          [&](const parser::CaseStmt &) {
+            eval.isNewBlock = true;
+            lastConstructStmtEvaluation->controlSuccessor = &eval;
+            lastConstructStmtEvaluation = &eval;
+          },
+          [&](const parser::EndSelectStmt &) {
+            eval.lexicalSuccessor->isNewBlock = true;
+            lastConstructStmtEvaluation = nullptr;
+          },
+          [&](const parser::ChangeTeamStmt &s) {
+            insertConstructName(s, parentConstruct);
+          },
+          [&](const parser::CriticalStmt &s) {
+            insertConstructName(s, parentConstruct);
+          },
+          [&](const parser::NonLabelDoStmt &s) {
+            insertConstructName(s, parentConstruct);
+            doConstructStack.push_back(parentConstruct);
+            auto &control{std::get<std::optional<parser::LoopControl>>(s.t)};
+            // eval.block is the loop preheader block, which will be set
+            // elsewhere if the NonLabelDoStmt is itself a target.
+            // eval.localBlocks[0] is the loop header block.
+            eval.localBlocks.emplace_back(nullptr);
+            if (!control.has_value()) {
+              eval.isUnstructured = true; // infinite loop
+              return;
+            }
+            eval.lexicalSuccessor->isNewBlock = true;
+            eval.controlSuccessor = &evaluationList.back();
+            if (std::holds_alternative<parser::ScalarLogicalExpr>(control->u)) {
+              eval.isUnstructured = true; // while loop
+            }
+            // Defer additional processing for an unstructured concurrent loop
+            // to the EndDoStmt, when the loop is known to be unstructured.
           },
           [&](const parser::EndDoStmt &) {
-          eval.isTarget = true;
-          eval.setCFG(pft::CFGAnnotation::Goto, cstr);
-        },
-        [&](const parser::IfThenStmt &) {
-          eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
+            lower::pft::Evaluation &doEval{evaluationList.front()};
+            eval.controlSuccessor = &doEval;
+            doConstructStack.pop_back();
+            if (parentConstruct->lowerAsStructured()) {
+              return;
+            }
+            // Now that the loop is known to be unstructured, finish concurrent
+            // loop processing, using NonLabelDoStmt information.
+            parentConstruct->constructExit->isNewBlock = true;
+            const auto &doStmt{doEval.getIf<parser::NonLabelDoStmt>()};
+            assert(doStmt && "missing NonLabelDoStmt");
+            auto &control{
+                std::get<std::optional<parser::LoopControl>>(doStmt->t)};
+            if (!control.has_value()) {
+              return; // infinite loop
+            }
+            const auto *concurrent{
+                std::get_if<parser::LoopControl::Concurrent>(&control->u)};
+            if (!concurrent) {
+              return;
+            }
+            // Unstructured concurrent loop.  NonLabelDoStmt code accounts
+            // for one concurrent loop dimension.  Reserve preheader,
+            // header, and latch blocks for the remaining dimensions, and
+            // one block for a mask expression.
+            const auto &header{
+                std::get<parser::ConcurrentHeader>(concurrent->t)};
+            auto dims{std::get<std::list<parser::ConcurrentControl>>(header.t)
+                          .size()};
+            for (; dims > 1; --dims) {
+              doEval.localBlocks.emplace_back(nullptr); // preheader
+              doEval.localBlocks.emplace_back(nullptr); // header
+              eval.localBlocks.emplace_back(nullptr);   // latch
+            }
+            if (std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)) {
+              doEval.localBlocks.emplace_back(nullptr); // mask
+            }
+          },
+          [&](const parser::IfThenStmt &s) {
+            insertConstructName(s, parentConstruct);
+            eval.lexicalSuccessor->isNewBlock = true;
+            lastConstructStmtEvaluation = &eval;
           },
           [&](const parser::ElseIfStmt &) {
-          eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
-        },
-        [&](const parser::SelectRankStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Switch, cstr);
+            eval.isNewBlock = true;
+            eval.lexicalSuccessor->isNewBlock = true;
+            lastConstructStmtEvaluation->controlSuccessor = &eval;
+            lastConstructStmtEvaluation = &eval;
           },
-        [&](const parser::SelectTypeStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Switch, cstr);
-        },
-        [&](const parser::WhereConstruct &) {
-          // mark the WHERE as if it were a DO loop
-          eval.isTarget = true;
-          eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
-        },
-        [&](const parser::WhereConstructStmt &) {
-          eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
-        },
-        [&](const parser::MaskedElsewhereStmt &) {
-          eval.isTarget = true;
-          eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
+          [&](const parser::ElseStmt &) {
+            eval.isNewBlock = true;
+            lastConstructStmtEvaluation->controlSuccessor = &eval;
+            lastConstructStmtEvaluation = nullptr;
+          },
+          [&](const parser::EndIfStmt &) {
+            if (parentConstruct->lowerAsUnstructured()) {
+              parentConstruct->constructExit->isNewBlock = true;
+            }
+            if (lastConstructStmtEvaluation) {
+              lastConstructStmtEvaluation->controlSuccessor =
+                  parentConstruct->constructExit;
+              lastConstructStmtEvaluation = nullptr;
+            }
           },
-        [&](const parser::ForallConstructStmt &) {
-          eval.isTarget = true;
-          eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
+          [&](const parser::SelectRankStmt &s) {
+            insertConstructName(s, parentConstruct);
+          },
+          [&](const parser::SelectRankCaseStmt &) { eval.isNewBlock = true; },
+          [&](const parser::SelectTypeStmt &s) {
+            insertConstructName(s, parentConstruct);
+          },
+          [&](const parser::TypeGuardStmt &) { eval.isNewBlock = true; },
+
+          // Constructs - set (unstructured) construct exit targets
+          [&](const parser::AssociateConstruct &) { setConstructExit(eval); },
+          [&](const parser::BlockConstruct &) {
+            // EndBlockStmt may have code.
+            eval.constructExit = &eval.evaluationList->back();
+          },
+          [&](const parser::CaseConstruct &) {
+            setConstructExit(eval);
+            eval.isUnstructured = true;
+          },
+          [&](const parser::ChangeTeamConstruct &) {
+            // EndChangeTeamStmt may have code.
+            eval.constructExit = &eval.evaluationList->back();
+          },
+          [&](const parser::CriticalConstruct &) {
+            // EndCriticalStmt may have code.
+            eval.constructExit = &eval.evaluationList->back();
+          },
+          [&](const parser::DoConstruct &) { setConstructExit(eval); },
+          [&](const parser::IfConstruct &) { setConstructExit(eval); },
+          [&](const parser::SelectRankConstruct &) {
+            setConstructExit(eval);
+            eval.isUnstructured = true;
+          },
+          [&](const parser::SelectTypeConstruct &) {
+            setConstructExit(eval);
+            eval.isUnstructured = true;
           },
 
           [&](const auto &stmt) {
-          // Handle statements with similar impact on control flow
+            using A = std::decay_t<decltype(stmt)>;
             using IoStmts = std::tuple<parser::BackspaceStmt, parser::CloseStmt,
                                        parser::EndfileStmt, parser::FlushStmt,
                                        parser::InquireStmt, parser::OpenStmt,
                                        parser::ReadStmt, parser::RewindStmt,
                                        parser::WaitStmt, parser::WriteStmt>;
-
-          using TargetStmts =
-              std::tuple<parser::EndAssociateStmt, parser::EndBlockStmt,
-                         parser::CaseStmt, parser::EndSelectStmt,
-                         parser::EndChangeTeamStmt, parser::EndCriticalStmt,
-                         parser::ElseStmt, parser::EndIfStmt,
-                         parser::SelectRankCaseStmt, parser::TypeGuardStmt,
-                         parser::ElsewhereStmt, parser::EndWhereStmt,
-                         parser::EndForallStmt>;
-
-          using DoNothingConstructStmts =
-              std::tuple<parser::BlockStmt, parser::AssociateStmt,
-                         parser::CriticalStmt, parser::ChangeTeamStmt>;
-
-          using A = std::decay_t<decltype(stmt)>;
             if constexpr (common::HasMember<A, IoStmts>) {
-            if (hasLabel<parser::ErrLabel>(stmt) ||
-                hasLabel<parser::EorLabel>(stmt) ||
-                hasLabel<parser::EndLabel>(stmt))
-              eval.setCFG(pft::CFGAnnotation::IoSwitch, cstr);
-          } else if constexpr (common::HasMember<A, TargetStmts>) {
-            eval.isTarget = true;
-          } else if constexpr (common::HasMember<A, DoNothingConstructStmts>) {
-            // Explicitly do nothing for these construct statements
-          } else {
-            static_assert(!pft::isConstructStmt<A>,
-                          "All ConstructStmts impact on the control flow "
-                          "should be explicitly handled");
+              analyzeIoBranches(eval, stmt);
             }
-          /* else do nothing */
+
+            /* do nothing */
           },
       });
+
+      // Analyze construct evaluations.
+      if (eval.evaluationList) {
+        analyzeBranches(&eval, *eval.evaluationList);
       }
+
+      // Insert branch links for an unstructured IF statement.
+      if (lastIfStmtEvaluation && lastIfStmtEvaluation != &eval) {
+        // eval is the action substatement of an IfStmt.
+        if (eval.lowerAsUnstructured()) {
+          eval.isNewBlock = true;
+          markSuccessorAsNewBlock(eval);
+          lastIfStmtEvaluation->isUnstructured = true;
+        }
+        lastIfStmtEvaluation->controlSuccessor = exitSuccessor(eval);
+        lastIfStmtEvaluation = nullptr;
       }
 
-/// Annotate the PFT with CFG source decorations (see CFGAnnotation) and mark
-/// potential branch targets
-inline void annotateFuncCFG(pft::FunctionLikeUnit &functionLikeUnit) {
-  annotateEvalListCFG(functionLikeUnit.evals, nullptr);
-  for (auto &internalFunc : functionLikeUnit.funcs)
-    annotateFuncCFG(internalFunc);
+      // Set the successor of the last statement in an IF or SELECT block.
+      if (!eval.controlSuccessor && eval.lexicalSuccessor &&
+          eval.lexicalSuccessor->isIntermediateConstructStmt()) {
+        eval.controlSuccessor = parentConstruct->constructExit;
+        eval.lexicalSuccessor->isNewBlock = true;
       }
 
+      // Propagate isUnstructured flag to enclosing construct.
+      if (parentConstruct && eval.isUnstructured) {
+        parentConstruct->isUnstructured = true;
+      }
+
+      // The lexical successor of a branch starts a new block.
+      if (eval.controlSuccessor && eval.isActionStmt() &&
+          eval.lowerAsUnstructured()) {
+        markSuccessorAsNewBlock(eval);
+      }
+    }
+  }
+
+  std::unique_ptr<lower::pft::Program> pgm;
+  std::vector<lower::pft::ParentVariant> parentVariantStack;
+  const semantics::SemanticsContext &semanticsContext;
+
+  /// functionList points to the internal or module procedure function list
+  /// of a FunctionLikeUnit or a ModuleLikeUnit.  It may be null.
+  std::list<lower::pft::FunctionLikeUnit> *functionList{nullptr};
+  std::vector<lower::pft::Evaluation *> constructAndDirectiveStack{};
+  std::vector<lower::pft::Evaluation *> doConstructStack{};
+  /// evaluationListStack is the current nested construct evaluationList state.
+  std::vector<lower::pft::EvaluationList *> evaluationListStack{};
+  llvm::DenseMap<parser::Label, lower::pft::Evaluation *> *labelEvaluationMap{
+      nullptr};
+  lower::pft::SymbolLabelMap *assignSymbolLabelMap{nullptr};
+  std::map<std::string, lower::pft::Evaluation *> constructNameMap{};
+  lower::pft::Evaluation *lastLexicalEvaluation{nullptr};
+};
+
 class PFTDumper {
 public:
-  void dumpPFT(llvm::raw_ostream &outputStream, pft::Program &pft) {
+  void dumpPFT(llvm::raw_ostream &outputStream, lower::pft::Program &pft) {
     for (auto &unit : pft.getUnits()) {
       std::visit(common::visitors{
-                     [&](pft::BlockDataUnit &unit) {
+                     [&](lower::pft::BlockDataUnit &unit) {
                        outputStream << getNodeIndex(unit) << " ";
                        outputStream << "BlockData: ";
                        outputStream << "\nEndBlockData\n\n";
                      },
-                     [&](pft::FunctionLikeUnit &func) {
+                     [&](lower::pft::FunctionLikeUnit &func) {
                        dumpFunctionLikeUnit(outputStream, func);
                      },
-                     [&](pft::ModuleLikeUnit &unit) {
+                     [&](lower::pft::ModuleLikeUnit &unit) {
                        dumpModuleLikeUnit(outputStream, unit);
                      },
                  },
                  unit);
     }
-    resetIndexes();
   }
 
-  llvm::StringRef evalName(pft::Evaluation &eval) {
+  llvm::StringRef evaluationName(lower::pft::Evaluation &eval) {
     return eval.visit(common::visitors{
-        [](const pft::CGJump) { return "CGJump"; },
         [](const auto &parseTreeNode) {
           return parser::ParseTreeDumper::GetNodeName(parseTreeNode);
         },
     });
   }
 
-  void dumpEvalList(llvm::raw_ostream &outputStream,
-                    pft::EvaluationCollection &evaluationCollection,
+  void dumpEvaluationList(llvm::raw_ostream &outputStream,
+                          lower::pft::EvaluationList &evaluationList,
                           int indent = 1) {
     static const std::string white{"                                      ++"};
     std::string indentString{white.substr(0, indent * 2)};
-    for (pft::Evaluation &eval : evaluationCollection) {
-      outputStream << indentString << getNodeIndex(eval) << " ";
-      llvm::StringRef name{evalName(eval)};
-      if (auto *subs{eval.getConstructEvals()}) {
-        outputStream << "<<" << name << ">>";
-        outputStream << "\n";
-        dumpEvalList(outputStream, *subs, indent + 1);
-        outputStream << indentString << "<<End" << name << ">>\n";
-      } else {
-        outputStream << name;
-        outputStream << ": " << eval.pos.ToString() + "\n";
+    for (lower::pft::Evaluation &eval : evaluationList) {
+      llvm::StringRef name{evaluationName(eval)};
+      std::string bang{eval.isUnstructured ? "!" : ""};
+      if (eval.isConstruct() || eval.isDirective()) {
+        outputStream << indentString << "<<" << name << bang << ">>";
+        if (eval.constructExit) {
+          outputStream << " -> " << eval.constructExit->printIndex;
+        }
+        outputStream << '\n';
+        dumpEvaluationList(outputStream, *eval.evaluationList, indent + 1);
+        outputStream << indentString << "<<End " << name << bang << ">>\n";
+        continue;
+      }
+      outputStream << indentString;
+      if (eval.printIndex) {
+        outputStream << eval.printIndex << ' ';
+      }
+      if (eval.isNewBlock) {
+        outputStream << '^';
+      }
+      if (eval.localBlocks.size()) {
+        outputStream << '*';
+      }
+      outputStream << name << bang;
+      if (eval.isActionStmt() || eval.isConstructStmt()) {
+        if (eval.controlSuccessor) {
+          outputStream << " -> " << eval.controlSuccessor->printIndex;
         }
       }
+      if (eval.position.size()) {
+        outputStream << ": " << eval.position.ToString();
+      }
+      outputStream << '\n';
+    }
   }
 
   void dumpFunctionLikeUnit(llvm::raw_ostream &outputStream,
-                            pft::FunctionLikeUnit &functionLikeUnit) {
+                            lower::pft::FunctionLikeUnit &functionLikeUnit) {
     outputStream << getNodeIndex(functionLikeUnit) << " ";
     llvm::StringRef unitKind{};
     std::string name{};
     std::string header{};
     if (functionLikeUnit.beginStmt) {
-      std::visit(
-          common::visitors{
-              [&](const parser::Statement<parser::ProgramStmt> *statement) {
-                unitKind = "Program";
-                name = statement->statement.v.ToString();
-              },
-              [&](const parser::Statement<parser::FunctionStmt> *statement) {
-                unitKind = "Function";
-                name =
-                    std::get<parser::Name>(statement->statement.t).ToString();
-                header = statement->source.ToString();
-              },
-              [&](const parser::Statement<parser::SubroutineStmt> *statement) {
-                unitKind = "Subroutine";
-                name =
-                    std::get<parser::Name>(statement->statement.t).ToString();
-                header = statement->source.ToString();
-              },
-              [&](const parser::Statement<parser::MpSubprogramStmt>
-                      *statement) {
-                unitKind = "MpSubprogram";
-                name = statement->statement.v.ToString();
-                header = statement->source.ToString();
-              },
-              [&](auto *) {},
+      functionLikeUnit.beginStmt->visit(common::visitors{
+          [&](const parser::Statement<parser::ProgramStmt> &statement) {
+            name = statement.statement.v.ToString();
+          [&](const parser::Statement<parser::FunctionStmt> &statement) {
+            name = std::get<parser::Name>(statement.statement.t).ToString();
+            header = statement.source.ToString();
+          [&](const parser::Statement<parser::SubroutineStmt> &statement) {
+            name = std::get<parser::Name>(statement.statement.t).ToString();
+            header = statement.source.ToString();
+          [&](const parser::Statement<parser::MpSubprogramStmt> &statement) {
+            name = statement.statement.v.ToString();
+            header = statement.source.ToString();
           },
-          *functionLikeUnit.beginStmt);
+          [&](const auto &) {},
+      });
     } else {
       unitKind = "Program";
       name = "<anonymous>";
     }
     outputStream << unitKind << ' ' << name;
     if (header.size())
       outputStream << ": " << header;
     outputStream << '\n';
-    dumpEvalList(outputStream, functionLikeUnit.evals);
-    if (!functionLikeUnit.funcs.empty()) {
+    dumpEvaluationList(outputStream, functionLikeUnit.evaluationList);
+    if (!functionLikeUnit.nestedFunctions.empty()) {
       outputStream << "\nContains\n";
-      for (auto &func : functionLikeUnit.funcs)
+      for (auto &func : functionLikeUnit.nestedFunctions)
         dumpFunctionLikeUnit(outputStream, func);
       outputStream << "EndContains\n";
     }
     outputStream << "End" << unitKind << ' ' << name << "\n\n";
   }
 
   void dumpModuleLikeUnit(llvm::raw_ostream &outputStream,
-                          pft::ModuleLikeUnit &moduleLikeUnit) {
+                          lower::pft::ModuleLikeUnit &moduleLikeUnit) {
     outputStream << getNodeIndex(moduleLikeUnit) << " ";
     outputStream << "ModuleLike: ";
     outputStream << "\nContains\n";
-    for (auto &func : moduleLikeUnit.funcs)
+    for (auto &func : moduleLikeUnit.nestedFunctions)
       dumpFunctionLikeUnit(outputStream, func);
     outputStream << "EndContains\nEndModuleLike\n\n";
   }
 
   template <typename T>
   std::size_t getNodeIndex(const T &node) {
     auto addr{static_cast<const void *>(&node)};
     auto it{nodeIndexes.find(addr)};
     if (it != nodeIndexes.end()) {
       return it->second;
     }
     nodeIndexes.try_emplace(addr, nextIndex);
     return nextIndex++;
   }
-  std::size_t getNodeIndex(const pft::Program &) { return 0; }
-
-  void resetIndexes() {
-    nodeIndexes.clear();
-    nextIndex = 1;
-  }
+  std::size_t getNodeIndex(const lower::pft::Program &) { return 0; }
 
 private:
   llvm::DenseMap<const void *, std::size_t> nodeIndexes;
   std::size_t nextIndex{1}; // 0 is the root
 };
 
+} // namespace
+
 template <typename A, typename T>
-pft::FunctionLikeUnit::FunctionStatement getFunctionStmt(const T &func) {
-  return pft::FunctionLikeUnit::FunctionStatement{
-      &std::get<parser::Statement<A>>(func.t)};
+static lower::pft::FunctionLikeUnit::FunctionStatement
+getFunctionStmt(const T &func) {
+  return std::get<parser::Statement<A>>(func.t);
 }
 template <typename A, typename T>
-pft::ModuleLikeUnit::ModuleStatement getModuleStmt(const T &mod) {
-  return pft::ModuleLikeUnit::ModuleStatement{
-      &std::get<parser::Statement<A>>(mod.t)};
+static lower::pft::ModuleLikeUnit::ModuleStatement getModuleStmt(const T &mod) {
+  return std::get<parser::Statement<A>>(mod.t);
+}
+
+static const semantics::Symbol *getSymbol(
+    std::optional<lower::pft::FunctionLikeUnit::FunctionStatement> &beginStmt) {
+  if (!beginStmt)
+    return nullptr;
+
+  const auto *symbol = beginStmt->visit(common::visitors{
+      [](const parser::Statement<parser::ProgramStmt> &stmt)
+          -> const semantics::Symbol * { return stmt.statement.v.symbol; },
+      [](const parser::Statement<parser::FunctionStmt> &stmt)
+          -> const semantics::Symbol * {
+        return std::get<parser::Name>(stmt.statement.t).symbol;
+      },
+      [](const parser::Statement<parser::SubroutineStmt> &stmt)
+          -> const semantics::Symbol * {
+        return std::get<parser::Name>(stmt.statement.t).symbol;
+      },
+      [](const parser::Statement<parser::MpSubprogramStmt> &stmt)
+          -> const semantics::Symbol * { return stmt.statement.v.symbol; },
+      [](const auto &) -> const semantics::Symbol * {
+        llvm_unreachable("unknown FunctionLike beginStmt");
+        return nullptr;
+      }});
+  assert(symbol && "parser::Name must have resolved symbol");
+  return symbol;
+}
+
+bool Fortran::lower::pft::Evaluation::lowerAsStructured() const {
+  return !lowerAsUnstructured();
+}
+
+bool Fortran::lower::pft::Evaluation::lowerAsUnstructured() const {
+  return isUnstructured || clDisableStructuredFir;
+}
+
+lower::pft::FunctionLikeUnit *
+Fortran::lower::pft::Evaluation::getOwningProcedure() const {
+  return parentVariant.visit(common::visitors{
+      [](lower::pft::FunctionLikeUnit &c) { return &c; },
+      [&](lower::pft::Evaluation &c) { return c.getOwningProcedure(); },
+      [](auto &) -> lower::pft::FunctionLikeUnit * { return nullptr; },
+  });
+}
+
+namespace {
+/// This helper class is for sorting the symbols in the symbol table. We want
+/// the symbols in an order such that a symbol will be visited after those it
+/// depends upon. Otherwise this sort is stable and preserves the order of the
+/// symbol table, which is sorted by name.
+struct SymbolDependenceDepth {
+  explicit SymbolDependenceDepth(
+      std::vector<std::vector<lower::pft::Variable>> &vars)
+      : vars{vars} {}
+
+  // Recursively visit each symbol to determine the height of its dependence on
+  // other symbols.
+  int analyze(const semantics::Symbol &sym) {
+    auto done = seen.insert(&sym);
+    if (!done.second)
+      return 0;
+    if (semantics::IsProcedure(sym)) {
+      // TODO: add declaration?
+      return 0;
+    }
+    if (sym.has<semantics::UseDetails>() ||
+        sym.has<semantics::HostAssocDetails>() ||
+        sym.has<semantics::NamelistDetails>() ||
+        sym.has<semantics::MiscDetails>()) {
+      // FIXME: do we want to do anything with any of these?
+      return 0;
+    }
+
+    // Symbol must be something lowering will have to allocate.
+    bool global = semantics::IsSaved(sym);
+    int depth = 0;
+    const auto *symTy = sym.GetType();
+    assert(symTy && "symbol must have a type");
+
+    // check CHARACTER's length
+    if (symTy->category() == semantics::DeclTypeSpec::Character)
+      if (auto e = symTy->characterTypeSpec().length().GetExplicit())
+        for (const auto &s : evaluate::CollectSymbols(*e))
+          depth = std::max(analyze(s) + 1, depth);
+
+    if (const auto *details = sym.detailsIf<semantics::ObjectEntityDetails>()) {
+      auto doExplicit = [&](const auto &bound) {
+        if (bound.isExplicit()) {
+          semantics::SomeExpr e{*bound.GetExplicit()};
+          for (const auto &s : evaluate::CollectSymbols(e))
+            depth = std::max(analyze(s) + 1, depth);
+        }
+      };
+      // handle any symbols in array bound declarations
+      for (const auto &subs : details->shape()) {
+        doExplicit(subs.lbound());
+        doExplicit(subs.ubound());
+      }
+      // handle any symbols in coarray bound declarations
+      for (const auto &subs : details->coshape()) {
+        doExplicit(subs.lbound());
+        doExplicit(subs.ubound());
+      }
+      // handle any symbols in initialization expressions
+      if (auto e = details->init()) {
+        // A PARAMETER may not be marked as implicitly SAVE, so set the flag.
+        global = true;
+        for (const auto &s : evaluate::CollectSymbols(*e))
+          depth = std::max(analyze(s) + 1, depth);
+      }
+    }
+    adjustSize(depth + 1);
+    vars[depth].emplace_back(sym, global, depth);
+    if (Fortran::semantics::IsAllocatable(sym))
+      vars[depth].back().setHeapAlloc();
+    if (Fortran::semantics::IsPointer(sym))
+      vars[depth].back().setPointer();
+    if (sym.attrs().test(Fortran::semantics::Attr::TARGET))
+      vars[depth].back().setTarget();
+    return depth;
+  }
+
+  // Save the final list of symbols as a single vector and free the rest.
+  void finalize() {
+    for (int i = 1, end = vars.size(); i < end; ++i)
+      vars[0].insert(vars[0].end(), vars[i].begin(), vars[i].end());
+    vars.resize(1);
   }
 
+private:
+  // Make sure the table is of appropriate size.
+  void adjustSize(std::size_t size) {
+    if (vars.size() < size)
+      vars.resize(size);
+  }
+
+  llvm::SmallSet<const semantics::Symbol *, 32> seen;
+  std::vector<std::vector<lower::pft::Variable>> &vars;
+};
 } // namespace
 
-pft::FunctionLikeUnit::FunctionLikeUnit(const parser::MainProgram &func,
-                                        const pft::ParentType &parent)
-    : ProgramUnit{func, parent} {
-  auto &ps{
+void Fortran::lower::pft::FunctionLikeUnit::processSymbolTable(
+    const semantics::Scope &scope) {
+  SymbolDependenceDepth sdd{varList};
+  for (const auto &iter : scope)
+    sdd.analyze(iter.second.get());
+  sdd.finalize();
+}
+
+Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
+    const parser::MainProgram &func, const lower::pft::ParentVariant &parent,
+    const semantics::SemanticsContext &semanticsContext)
+    : ProgramUnit{func, parent}, endStmt{
+                                     getFunctionStmt<parser::EndProgramStmt>(
+                                         func)} {
+  const auto &ps{
       std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(func.t)};
   if (ps.has_value()) {
-    const parser::Statement<parser::ProgramStmt> &statement{ps.value()};
-    beginStmt = &statement;
+    beginStmt = ps.value();
+    symbol = getSymbol(beginStmt);
+    processSymbolTable(*symbol->scope());
+  } else {
+    processSymbolTable(semanticsContext.FindScope(
+        std::get<parser::Statement<parser::EndProgramStmt>>(func.t).source));
   }
-  endStmt = getFunctionStmt<parser::EndProgramStmt>(func);
 }
 
-pft::FunctionLikeUnit::FunctionLikeUnit(const parser::FunctionSubprogram &func,
-                                        const pft::ParentType &parent)
+Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
+    const parser::FunctionSubprogram &func,
+    const lower::pft::ParentVariant &parent,
+    const semantics::SemanticsContext &)
     : ProgramUnit{func, parent},
       beginStmt{getFunctionStmt<parser::FunctionStmt>(func)},
-      endStmt{getFunctionStmt<parser::EndFunctionStmt>(func)} {}
+      endStmt{getFunctionStmt<parser::EndFunctionStmt>(func)}, symbol{getSymbol(
+                                                                   beginStmt)} {
+  processSymbolTable(*symbol->scope());
+}
 
-pft::FunctionLikeUnit::FunctionLikeUnit(
-    const parser::SubroutineSubprogram &func, const pft::ParentType &parent)
+Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
+    const parser::SubroutineSubprogram &func,
+    const lower::pft::ParentVariant &parent,
+    const semantics::SemanticsContext &)
     : ProgramUnit{func, parent},
       beginStmt{getFunctionStmt<parser::SubroutineStmt>(func)},
-      endStmt{getFunctionStmt<parser::EndSubroutineStmt>(func)} {}
+      endStmt{getFunctionStmt<parser::EndSubroutineStmt>(func)},
+      symbol{getSymbol(beginStmt)} {
+  processSymbolTable(*symbol->scope());
+}
 
-pft::FunctionLikeUnit::FunctionLikeUnit(
-    const parser::SeparateModuleSubprogram &func, const pft::ParentType &parent)
+Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
+    const parser::SeparateModuleSubprogram &func,
+    const lower::pft::ParentVariant &parent,
+    const semantics::SemanticsContext &)
     : ProgramUnit{func, parent},
       beginStmt{getFunctionStmt<parser::MpSubprogramStmt>(func)},
-      endStmt{getFunctionStmt<parser::EndMpSubprogramStmt>(func)} {}
+      endStmt{getFunctionStmt<parser::EndMpSubprogramStmt>(func)},
+      symbol{getSymbol(beginStmt)} {
+  processSymbolTable(*symbol->scope());
+}
 
-pft::ModuleLikeUnit::ModuleLikeUnit(const parser::Module &m,
-                                    const pft::ParentType &parent)
+Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit(
+    const parser::Module &m, const lower::pft::ParentVariant &parent)
     : ProgramUnit{m, parent}, beginStmt{getModuleStmt<parser::ModuleStmt>(m)},
       endStmt{getModuleStmt<parser::EndModuleStmt>(m)} {}
 
-pft::ModuleLikeUnit::ModuleLikeUnit(const parser::Submodule &m,
-                                    const pft::ParentType &parent)
+Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit(
+    const parser::Submodule &m, const lower::pft::ParentVariant &parent)
     : ProgramUnit{m, parent}, beginStmt{getModuleStmt<parser::SubmoduleStmt>(
                                   m)},
       endStmt{getModuleStmt<parser::EndSubmoduleStmt>(m)} {}
 
-pft::BlockDataUnit::BlockDataUnit(const parser::BlockData &bd,
-                                  const pft::ParentType &parent)
+Fortran::lower::pft::BlockDataUnit::BlockDataUnit(
+    const parser::BlockData &bd, const lower::pft::ParentVariant &parent)
     : ProgramUnit{bd, parent} {}
 
-std::unique_ptr<pft::Program> createPFT(const parser::Program &root) {
-  PFTBuilder walker;
+std::unique_ptr<lower::pft::Program>
+Fortran::lower::createPFT(const parser::Program &root,
+                          const semantics::SemanticsContext &semanticsContext) {
+  PFTBuilder walker(semanticsContext);
   Walk(root, walker);
   return walker.result();
 }
 
-void annotateControl(pft::Program &pft) {
-  for (auto &unit : pft.getUnits()) {
-    std::visit(common::visitors{
-                   [](pft::BlockDataUnit &) {},
-                   [](pft::FunctionLikeUnit &func) { annotateFuncCFG(func); },
-                   [](pft::ModuleLikeUnit &unit) {
-                     for (auto &func : unit.funcs)
-                       annotateFuncCFG(func);
-                   },
-               },
-               unit);
-  }
-}
-
-/// Dump a PFT.
-void dumpPFT(llvm::raw_ostream &outputStream, pft::Program &pft) {
+void Fortran::lower::dumpPFT(llvm::raw_ostream &outputStream,
+                             lower::pft::Program &pft) {
   PFTDumper{}.dumpPFT(outputStream, pft);
 }
 
-} // namespace Fortran::lower
+void Fortran::lower::pft::Program::dump() { dumpPFT(llvm::errs(), *this); }

flang/test/Lower/pre-fir-tree01.f90

do i=1,5
     print *, "hey"
     ! CHECK: <<DoConstruct>>
     ! CHECK: NonLabelDoStmt
     do j=1,5
       ! CHECK: PrintStmt
       print *, "hello", i, j
     ! CHECK: EndDoStmt
     end do
-    ! CHECK: <<EndDoConstruct>>
+    ! CHECK: <<End DoConstruct>>
   ! CHECK: EndDoStmt
   end do
-  ! CHECK: <<EndDoConstruct>>
+  ! CHECK: <<End DoConstruct>>
 end subroutine
 ! CHECK: EndSubroutine foo
 
 ! CHECK: BlockData
 block data
   integer, parameter :: n = 100
   integer, dimension(n) :: a, b, c
   common /arrays/ a, b, c
if (xdim > 100) then
       ! CHECK: PrintStmt
       print *, "test: ", xdim
     ! CHECK: ElseStmt
     else
       ! CHECK: WriteStmt
       write (*, 11) "test: ", xdim, pressure
     ! CHECK: EndIfStmt
     end if
-    ! CHECK: <<EndIfConstruct>>
+    ! CHECK: <<End IfConstruct>>
   end procedure
 end submodule
 ! CHECK: EndModuleLike
 
 ! CHECK: BlockData
 block data named_block
  integer i, j, k
  common /indexes/ i, j, k

flang/test/Lower/pre-fir-tree02.f90

do i=1,5
     print *, "hey"
     ! CHECK: <<DoConstruct>>
     ! CHECK: NonLabelDoStmt
     do j=1,5
       ! CHECK: PrintStmt
       print *, "hello", i, j
     ! CHECK: EndDoStmt
     end do
-    ! CHECK: <<EndDoConstruct>>
+    ! CHECK: <<End DoConstruct>>
   ! CHECK: EndDoStmt
   end do
-  ! CHECK: <<EndDoConstruct>>
+  ! CHECK: <<End DoConstruct>>
 
   ! CHECK: <<AssociateConstruct>>
   ! CHECK: AssociateStmt
   associate (k => i + j)
     ! CHECK: AllocateStmt
     allocate(x(k))
   ! CHECK: EndAssociateStmt
   end associate
-  ! CHECK: <<EndAssociateConstruct>>
+  ! CHECK: <<End AssociateConstruct>>
 
-  ! CHECK: <<BlockConstruct>>
+  ! CHECK: <<BlockConstruct!>>
   ! CHECK: BlockStmt
   block
     integer :: k, l
     real, pointer :: p(:)
     ! CHECK: PointerAssignmentStmt
     p => x
     ! CHECK: AssignmentStmt
     k = size(p)
     ! CHECK: AssignmentStmt
     l = 1
-    ! CHECK: <<CaseConstruct>>
+    ! CHECK: <<CaseConstruct!>>
     ! CHECK: SelectCaseStmt
     select case (k)
       ! CHECK: CaseStmt
       case (:0)
         ! CHECK: NullifyStmt
         nullify(p)
       ! CHECK: CaseStmt
       case (1)
         ! CHECK: <<IfConstruct>>
         ! CHECK: IfThenStmt
         if (p(1)>0.) then
           ! CHECK: PrintStmt
           print *, "+"
         ! CHECK: ElseIfStmt
         else if (p(1)==0.) then
           ! CHECK: PrintStmt
           print *, "0."
         ! CHECK: ElseStmt
         else
           ! CHECK: PrintStmt
           print *, "-"
         ! CHECK: EndIfStmt
         end if
-        ! CHECK: <<EndIfConstruct>>
+        ! CHECK: <<End IfConstruct>>
         ! CHECK: CaseStmt
       case (2:10)
       ! CHECK: CaseStmt
       case default
         ! Note: label-do-loop are canonicalized into do constructs
-        ! CHECK: <<DoConstruct>>
+        ! CHECK: <<DoConstruct!>>
         ! CHECK: NonLabelDoStmt
         do 22 while(l<=k)
           ! CHECK: IfStmt
           if (p(l)<0.) p(l)=cos(p(l))
           ! CHECK: CallStmt
 22        call incr(l)
         ! CHECK: EndDoStmt
-       ! CHECK: <<EndDoConstruct>>
+       ! CHECK: <<End DoConstruct!>>
       ! CHECK: CaseStmt
       case (100:)
     ! CHECK: EndSelectStmt
     end select
-  ! CHECK: <<EndCaseConstruct>>
+  ! CHECK: <<End CaseConstruct!>>
   ! CHECK: EndBlockStmt
   end block
-  ! CHECK: <<EndBlockConstruct>>
+  ! CHECK: <<End BlockConstruct!>>
 
   ! CHECK-NOT: WhereConstruct
   ! CHECK: WhereStmt
   where (x > 1.) x = x/2.
 
   ! CHECK: <<WhereConstruct>>
   ! CHECK: WhereConstructStmt
   where (x == 0.)
     ! CHECK: AssignmentStmt
     x = 0.01
   ! CHECK: MaskedElsewhereStmt
   elsewhere (x < 0.5)
     ! CHECK: AssignmentStmt
     x = x*2.
     ! CHECK: <<WhereConstruct>>
     where (y > 0.4)
       ! CHECK: AssignmentStmt
       y = y/2.
     end where
-    ! CHECK: <<EndWhereConstruct>>
+    ! CHECK: <<End WhereConstruct>>
   ! CHECK: ElsewhereStmt
   elsewhere
     ! CHECK: AssignmentStmt
     x = x + 1.
   ! CHECK: EndWhereStmt
   end where
-  ! CHECK: <<EndWhereConstruct>>
+  ! CHECK: <<End WhereConstruct>>
 
   ! CHECK-NOT: ForAllConstruct
   ! CHECK: ForallStmt
   forall (i = 1:5) x(i) = y(i)
 
   ! CHECK: <<ForallConstruct>>
   ! CHECK: ForallConstructStmt
   forall (i = 1:5)
     ! CHECK: AssignmentStmt
     x(i) = x(i) + y(10*i)
   ! CHECK: EndForallStmt
   end forall
-  ! CHECK: <<EndForallConstruct>>
+  ! CHECK: <<End ForallConstruct>>
 
   ! CHECK: DeallocateStmt
   deallocate(x)
 end
 
 ! CHECK: ModuleLike
 module test
   type :: a_type
     integer :: x
   end type
   type, extends(a_type) :: b_type
     integer :: y
   end type
 contains
   ! CHECK: Function foo
   function foo(x)
     real x(..)
     integer :: foo
-    ! CHECK: <<SelectRankConstruct>>
+    ! CHECK: <<SelectRankConstruct!>>
     ! CHECK: SelectRankStmt
     select rank(x)
       ! CHECK: SelectRankCaseStmt
       rank (0)
         ! CHECK: AssignmentStmt
         foo = 0
       ! CHECK: SelectRankCaseStmt
       rank (*)
         ! CHECK: AssignmentStmt
         foo = -1
       ! CHECK: SelectRankCaseStmt
       rank (1)
         ! CHECK: AssignmentStmt
         foo = 1
       ! CHECK: SelectRankCaseStmt
       rank default
         ! CHECK: AssignmentStmt
         foo = 2
     ! CHECK: EndSelectStmt
     end select
-    ! CHECK: <<EndSelectRankConstruct>>
+    ! CHECK: <<End SelectRankConstruct!>>
   end function
 
   ! CHECK: Function bar
   function bar(x)
     class(*) :: x
-    ! CHECK: <<SelectTypeConstruct>>
+    ! CHECK: <<SelectTypeConstruct!>>
     ! CHECK: SelectTypeStmt
     select type(x)
       ! CHECK: TypeGuardStmt
       type is (integer)
         ! CHECK: AssignmentStmt
         bar = 0
       ! CHECK: TypeGuardStmt
       class is (a_type)
         ! CHECK: AssignmentStmt
         bar = 1
         ! CHECK: ReturnStmt
         return
       ! CHECK: TypeGuardStmt
       class default
         ! CHECK: AssignmentStmt
         bar = -1
     ! CHECK: EndSelectStmt
     end select
-    ! CHECK: <<EndSelectTypeConstruct>>
+    ! CHECK: <<End SelectTypeConstruct!>>
   end function
 
   ! CHECK: Subroutine sub
   subroutine sub(a)
     real(4):: a
     ! CompilerDirective
     ! CHECK: <<CompilerDirective>>
     !DIR$ IGNORE_TKR a
   end subroutine
 
 
 end module
 
 ! CHECK: Subroutine altreturn
 subroutine altreturn(i, j, *, *)
-  ! CHECK: <<IfConstruct>>
+  ! CHECK: <<IfConstruct!>>
   if (i>j) then
     ! CHECK: ReturnStmt
     return 1
   else
     ! CHECK: ReturnStmt
     return 2
   end if
-  ! CHECK: <<EndIfConstruct>>
+  ! CHECK: <<End IfConstruct!>>
 end subroutine
 
 
 ! Remaining TODO
 
 ! CHECK: Subroutine iostmts
 subroutine iostmts(filename, a, b, c)
   character(*) :: filename
   integer :: length
   logical :: file_is_opened
   real, a, b ,c
   ! CHECK: InquireStmt
   inquire(file=filename, opened=file_is_opened)
   ! CHECK: <<IfConstruct>>
   if (file_is_opened) then
     ! CHECK: OpenStmt
     open(10, FILE=filename)
   end if
-  ! CHECK: <<EndIfConstruct>>
+  ! CHECK: <<End IfConstruct>>
   ! CHECK: ReadStmt
   read(10, *) length
   ! CHECK: RewindStmt
   rewind 10
   ! CHECK: NamelistStmt
   namelist /nlist/ a, b, c
   ! CHECK: WriteStmt
   write(10, NML=nlist)

 ! WILLCHECK: AssignedGotoStmt
 !66  go to label (5, 6)
 
 ! CHECK: ComputedGotoStmt
   go to (5, 6), 1 + mod(i, 2)
 5 j = j + 1
 6 i = i + j/2
 
-  ! CHECK: <<DoConstruct>>
+  ! CHECK: <<DoConstruct!>>
   do1: do k=1,10
-    ! CHECK: <<DoConstruct>>
+    ! CHECK: <<DoConstruct!>>
     do2: do l=5,20
       ! CHECK: CycleStmt
       cycle do1
       ! CHECK: ExitStmt
       exit do2
     end do do2
-    ! CHECK: <<EndDoConstruct>>
+    ! CHECK: <<End DoConstruct!>>
   end do do1
-  ! CHECK: <<EndDoConstruct>>
+  ! CHECK: <<End DoConstruct!>>
 
   ! CHECK: PauseStmt
   pause 7
   ! CHECK: StopStmt
   stop
 end subroutine
 
 

flang/test/Lower/pre-fir-tree03.f90

!$omp parallel
     !$omp do
     ! CHECK: <<DoConstruct>>
     ! CHECK: LabelDoStmt
     do i=1,100
       ! CHECK: PrintStmt
       print *, "in omp do"
     ! CHECK: EndDoStmt
     end do
-    ! CHECK: <<EndDoConstruct>>
+    ! CHECK: <<End DoConstruct>>
     ! CHECK: OmpEndLoopDirective
     !$omp end do
-    ! CHECK: <<EndOpenMPConstruct>>
+    ! CHECK: <<End OpenMPConstruct>>
 
     ! CHECK: PrintStmt
     print *, "not in omp do"
 
     ! CHECK: <<OpenMPConstruct>>
     !$omp do
     ! CHECK: <<DoConstruct>>
     ! CHECK: LabelDoStmt
     do i=1,100
       ! CHECK: PrintStmt
       print *, "in omp do"
     ! CHECK: EndDoStmt
     end do
-    ! CHECK: <<EndDoConstruct>>
-    ! CHECK: <<EndOpenMPConstruct>>
+    ! CHECK: <<End DoConstruct>>
+    ! CHECK: <<End OpenMPConstruct>>
     ! CHECK-NOT: OmpEndLoopDirective
     ! CHECK: PrintStmt
     print *, "no in omp do"
   !$omp end parallel
-    ! CHECK: <<EndOpenMPConstruct>>
+    ! CHECK: <<End OpenMPConstruct>>
 
   ! CHECK: PrintStmt
   print *, "sequential again"
 
   ! CHECK: <<OpenMPConstruct>>
   !$omp task
     ! CHECK: PrintStmt
     print *, "in task"
   !$omp end task
-  ! CHECK: <<EndOpenMPConstruct>>
+  ! CHECK: <<End OpenMPConstruct>>
 
   ! CHECK: PrintStmt
   print *, "sequential again"
 end program

flang/test/Lower/pre-fir-tree04.f90

Subroutine test_coarray
   real :: y[10,*]
   integer :: counter[*]
   logical :: is_master
   ! CHECK: <<ChangeTeamConstruct>>
   change team(t, x[5,*] => y)
     ! CHECK: AssignmentStmt
     x = x[4, 1]
   end team
-  ! CHECK: <<EndChangeTeamConstruct>>
+  ! CHECK: <<End ChangeTeamConstruct>>
   ! CHECK: FormTeamStmt
   form team(1, t)
 
   ! CHECK: <<IfConstruct>>
   if (this_image() == 1) then
     ! CHECK: EventPostStmt
     event post (done)
   else
     ! CHECK: EventWaitStmt
     event wait (done)
   end if
-  ! CHECK: <<EndIfConstruct>>
+  ! CHECK: <<End IfConstruct>>
 
   ! CHECK: <<CriticalConstruct>>
   critical
     ! CHECK: AssignmentStmt
     counter[1] = counter[1] + 1
   end critical
-  ! CHECK: <<EndCriticalConstruct>>
+  ! CHECK: <<End CriticalConstruct>>
 
   ! CHECK: LockStmt
   lock(alock)
   ! CHECK: PrintStmt
   print *, "I have the lock"
   ! CHECK: UnlockStmt
   unlock(alock)
 
   ! CHECK: SyncAllStmt
   sync all
   ! CHECK: SyncMemoryStmt
   sync memory
   ! CHECK: SyncTeamStmt
   sync team(t)
 
   ! CHECK: <<IfConstruct>>
   if (this_image() == 1) then
     ! CHECK: SyncImagesStmt
     sync images(*)
   else
     ! CHECK: SyncImagesStmt
     sync images(1)
   end if
-  ! CHECK: <<EndIfConstruct>>
+  ! CHECK: <<End IfConstruct>>
 
   ! CHECK: <<IfConstruct>>
   if (y<0.) then
     ! CHECK: FailImageStmt
    fail image
   end if
-  ! CHECK: <<EndIfConstruct>>
+  ! CHECK: <<End IfConstruct>>
 end

flang/tools/f18/f18.cpp

std::string CompileFortran(std::string path, Fortran::parser::Options options,
   if (driver.dumpUnparse) {
     Unparse(llvm::outs(), parseTree, driver.encoding, true /*capitalize*/,
         options.features.IsEnabled(
             Fortran::common::LanguageFeature::BackslashEscapes),
         nullptr /* action before each statement */, &asFortran);
     return {};
   }
   if (driver.dumpPreFirTree) {
-    if (auto ast{Fortran::lower::createPFT(parseTree)}) {
-      Fortran::lower::annotateControl(*ast);
+    if (auto ast{Fortran::lower::createPFT(parseTree, semanticsContext)}) {
       Fortran::lower::dumpPFT(llvm::outs(), *ast);
     } else {
       llvm::errs() << "Pre FIR Tree is NULL.\n";
       exitStatus = EXIT_FAILURE;
     }
   }
   if (driver.parseOnly) {
     return {};