Index: flang/include/flang/Lower/PFTBuilder.h
===================================================================
--- flang/include/flang/Lower/PFTBuilder.h
+++ flang/include/flang/Lower/PFTBuilder.h
@@ -1,35 +1,35 @@
-//===-- 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.
+#include "llvm/ADT/DenseMap.h"
+#include "llvm/ADT/SmallSet.h"
+#include "llvm/Support/raw_ostream.h"
 
-namespace llvm {
-class raw_ostream;
+namespace mlir {
+class Block;
 }
 
-namespace Fortran::lower {
+namespace Fortran {
+namespace semantics {
+class SemanticsContext;
+class Scope;
+} // namespace semantics
+namespace lower {
 namespace pft {
 
 struct Evaluation;
@@ -40,40 +40,56 @@
 // 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>;
-
-struct ParentType {
-  template <typename A>
-  ParentType(A &parent) : p{&parent} {}
-  const std::variant<Program *, ModuleLikeUnit *, FunctionLikeUnit *,
-                     Evaluation *>
-      p;
-};
+using EvaluationList = std::list<Evaluation>;
+using LabelEvalMap = llvm::DenseMap<Fortran::parser::Label, Evaluation *>;
+
+/// 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);
+  }
 
-/// 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.
+private:
+  std::variant<Ref<A>...> u;
 };
+template <typename... A>
+using ReferenceVariant = ReferenceVariantBase<true, A...>;
+template <typename... A>
+using MutableReferenceVariant = ReferenceVariantBase<false, A...>;
 
-/// 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;
-};
+/// 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
 
@@ -95,15 +111,6 @@
 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,
@@ -115,257 +122,342 @@
     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>
+static constexpr bool isActionStmt{common::HasMember<A, ActionStmts>};
+
+template <typename A>
+static constexpr bool isOtherStmt{common::HasMember<A, OtherStmts>};
+
 template <typename A>
-constexpr static bool isActionStmt{common::HasMember<A, ActionStmts>};
+static constexpr bool isConstructStmt{common::HasMember<A, ConstructStmts>};
 
 template <typename A>
-constexpr static bool isConstruct{common::HasMember<A, Constructs>};
+static constexpr bool isConstruct{common::HasMember<A, Constructs>};
 
 template <typename A>
-constexpr static bool isConstructStmt{common::HasMember<A, ConstructStmts>};
+static constexpr bool isDirective{common::HasMember<A, Directives>};
 
 template <typename A>
-constexpr static bool isOtherStmt{common::HasMember<A, OtherStmts>};
+static constexpr bool isIntermediateConstructStmt{common::HasMember<
+    A, std::tuple<parser::CaseStmt, parser::ElseIfStmt, parser::ElseStmt,
+                  parser::SelectRankCaseStmt, parser::TypeGuardStmt>>};
 
 template <typename A>
-constexpr static bool isGenerated{std::is_same_v<A, CGJump>};
+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>
-constexpr static bool isFunctionLike{common::HasMember<
+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);
-  }
+template <typename A>
+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...>;
+};
+template <typename 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) {
-          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;
-        },
-    });
+        [](auto &r) { return pft::isOtherStmt<std::decay_t<decltype(r)>>; }});
   }
-  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);
+  constexpr bool isConstructStmt() const {
+    return visit(common::visitors{[](auto &r) {
+      return pft::isConstructStmt<std::decay_t<decltype(r)>>;
+    }});
   }
-
-  /// 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;
+  constexpr bool isConstruct() const {
+    return visit(common::visitors{
+        [](auto &r) { return pft::isConstruct<std::decay_t<decltype(r)>>; }});
   }
-
-  /// Set that the construct `cstr` (if not a nullptr) has branches.
-  static void setBranches(Evaluation *cstr) {
-    if (cstr)
-      cstr->setBranches();
+  constexpr bool isDirective() const {
+    return visit(common::visitors{
+        [](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)>>;
+    }});
   }
 
-  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
+  /// 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>;
 
@@ -375,23 +467,31 @@
 
   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 &);
-
-void dumpPFT(llvm::raw_ostream &o, pft::Program &);
-
-} // namespace Fortran::lower
-
-#endif // FORTRAN_LOWER_PFT_BUILDER_H_
+/// 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);
+
+/// Dumper for displaying a PFT.
+void dumpPFT(llvm::raw_ostream &outputStream, pft::Program &pft);
+
+} // namespace lower
+} // namespace Fortran
+
+#endif // FORTRAN_LOWER_PFTBUILDER_H
Index: flang/include/flang/Lower/Utils.h
===================================================================
--- /dev/null
+++ flang/include/flang/Lower/Utils.h
@@ -0,0 +1,31 @@
+//===-- 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
Index: flang/include/flang/Semantics/symbol.h
===================================================================
--- flang/include/flang/Semantics/symbol.h
+++ flang/include/flang/Semantics/symbol.h
@@ -13,6 +13,7 @@
 #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>
@@ -760,4 +761,30 @@
 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_
Index: flang/lib/Lower/PFTBuilder.cpp
===================================================================
--- flang/lib/Lower/PFTBuilder.cpp
+++ flang/lib/Lower/PFTBuilder.cpp
@@ -1,4 +1,4 @@
-//===-- 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.
@@ -7,37 +7,32 @@
 //===----------------------------------------------------------------------===//
 
 #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"
 
-namespace Fortran::lower {
-namespace {
+static llvm::cl::opt<bool> clDisableStructuredFir(
+    "no-structured-fir", llvm::cl::desc("disable generation of structured FIR"),
+    llvm::cl::init(false), llvm::cl::Hidden);
+
+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};
 };
@@ -46,64 +41,70 @@
   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();
     }
   }
 
@@ -116,25 +117,26 @@
 
   // 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;
@@ -145,8 +147,9 @@
             [&](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(),
-                                      stmt.source, stmt.label});
+              addEvaluation(lower::pft::Evaluation{stmt.statement,
+                                                   parentVariantStack.back(),
+                                                   stmt.source, stmt.label});
               return false;
             },
             [&](const auto &) { return true; },
@@ -155,79 +158,80 @@
   }
 
 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>
@@ -237,330 +241,608 @@
   }
 
   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();
-  }
-
-  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;
-};
+  void popEvaluationList() {
+    assert(functionList && "not in a function");
+    evaluationListStack.pop_back();
+  }
+
+  /// 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);
-  }
-  if constexpr (std::is_same_v<A, parser::WaitStmt>) {
-    return std::any_of(std::begin(stmt.v), std::end(stmt.v), isLabel);
-  }
-  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);
+    if constexpr (std::is_same_v<A, parser::ReadStmt> ||
+                  std::is_same_v<A, parser::WriteStmt>) {
+      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");
     }
   }
-  return false;
-}
 
-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;
+  /// 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;
+    }
+    assert(eval.constructExit && "missing construct exit");
   }
-  return false;
-}
 
-/// 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);
-}
+  void markBranchTarget(lower::pft::Evaluation &sourceEvaluation,
+                        lower::pft::Evaluation &targetEvaluation) {
+    sourceEvaluation.isUnstructured = true;
+    if (!sourceEvaluation.controlSuccessor) {
+      sourceEvaluation.controlSuccessor = &targetEvaluation;
+    }
+    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);
+  }
 
-/// \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;
+  /// 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;
     }
+    assert(successor && "missing exit successor");
+    return successor;
+  }
 
-    if (eval.isActionOrGenerated() && eval.lab.has_value())
-      eval.isTarget = true;
-    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);
-        },
-        [&](const parser::IfStmt &) {
-          eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
-        },
-        [&](const parser::ReturnStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Return, cstr);
-        },
-        [&](const parser::StopStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Terminate, cstr);
-        },
-        [&](const parser::ArithmeticIfStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Switch, cstr);
-        },
-        [&](const parser::AssignedGotoStmt &) {
-          eval.setCFG(pft::CFGAnnotation::IndGoto, cstr);
-        },
-        [&](const parser::ComputedGotoStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Switch, cstr);
-        },
-        [&](const parser::WhereStmt &) {
-          // fir.loop + fir.where around the next stmt
-          eval.isTarget = true;
-          eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
-        },
-        [&](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::EndDoStmt &) {
-          eval.isTarget = true;
-          eval.setCFG(pft::CFGAnnotation::Goto, cstr);
-        },
-        [&](const parser::IfThenStmt &) {
-          eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
-        },
-        [&](const parser::ElseIfStmt &) {
-          eval.setCFG(pft::CFGAnnotation::CondGoto, cstr);
-        },
-        [&](const parser::SelectRankStmt &) {
-          eval.setCFG(pft::CFGAnnotation::Switch, cstr);
-        },
-        [&](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::ForallConstructStmt &) {
-          eval.isTarget = true;
-          eval.setCFG(pft::CFGAnnotation::Iterative, cstr);
-        },
+  /// Mark the exit successor of an Evaluation as a new block.
+  void markSuccessorAsNewBlock(lower::pft::Evaluation &eval) {
+    exitSuccessor(eval)->isNewBlock = true;
+  }
 
-        [&](const auto &stmt) {
-          // Handle statements with similar impact on control flow
-          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");
-          }
-          /* else do nothing */
-        },
-    });
+  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 {};
   }
-}
 
-/// 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);
-}
+  /// \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{
+          // 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::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.isUnstructured = true;
+            if (eval.lexicalSuccessor->lexicalSuccessor)
+              markSuccessorAsNewBlock(eval);
+          },
+          [&](const parser::StopStmt &) {
+            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 &) {
+            // 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);
+          },
+
+          // Construct statements
+          [&](const parser::AssociateStmt &s) {
+            insertConstructName(s, parentConstruct);
+          },
+          [&](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 &) {
+            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.isNewBlock = true;
+            eval.lexicalSuccessor->isNewBlock = true;
+            lastConstructStmtEvaluation->controlSuccessor = &eval;
+            lastConstructStmtEvaluation = &eval;
+          },
+          [&](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::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) {
+            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>;
+            if constexpr (common::HasMember<A, IoStmts>) {
+              analyzeIoBranches(eval, stmt);
+            }
+
+            /* 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;
+      }
+
+      // 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,
-                    int indent = 1) {
+  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);
+      functionLikeUnit.beginStmt->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();
+          },
+          [&](const auto &) {},
+      });
     } else {
       unitKind = "Program";
       name = "<anonymous>";
@@ -569,10 +851,10 @@
     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";
     }
@@ -580,11 +862,11 @@
   }
 
   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";
   }
@@ -599,99 +881,249 @@
     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); }
Index: flang/test/Lower/pre-fir-tree01.f90
===================================================================
--- flang/test/Lower/pre-fir-tree01.f90
+++ flang/test/Lower/pre-fir-tree01.f90
@@ -16,10 +16,10 @@
       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
 
@@ -102,7 +102,7 @@
       write (*, 11) "test: ", xdim, pressure
     ! CHECK: EndIfStmt
     end if
-    ! CHECK: <<EndIfConstruct>>
+    ! CHECK: <<End IfConstruct>>
   end procedure
 end submodule
 ! CHECK: EndModuleLike
Index: flang/test/Lower/pre-fir-tree02.f90
===================================================================
--- flang/test/Lower/pre-fir-tree02.f90
+++ flang/test/Lower/pre-fir-tree02.f90
@@ -27,10 +27,10 @@
       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
@@ -39,9 +39,9 @@
     allocate(x(k))
   ! CHECK: EndAssociateStmt
   end associate
-  ! CHECK: <<EndAssociateConstruct>>
+  ! CHECK: <<End AssociateConstruct>>
 
-  ! CHECK: <<BlockConstruct>>
+  ! CHECK: <<BlockConstruct!>>
   ! CHECK: BlockStmt
   block
     integer :: k, l
@@ -52,7 +52,7 @@
     k = size(p)
     ! CHECK: AssignmentStmt
     l = 1
-    ! CHECK: <<CaseConstruct>>
+    ! CHECK: <<CaseConstruct!>>
     ! CHECK: SelectCaseStmt
     select case (k)
       ! CHECK: CaseStmt
@@ -76,13 +76,13 @@
           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
@@ -90,15 +90,15 @@
           ! 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
@@ -118,14 +118,14 @@
       ! 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
@@ -138,7 +138,7 @@
     x(i) = x(i) + y(10*i)
   ! CHECK: EndForallStmt
   end forall
-  ! CHECK: <<EndForallConstruct>>
+  ! CHECK: <<End ForallConstruct>>
 
   ! CHECK: DeallocateStmt
   deallocate(x)
@@ -157,7 +157,7 @@
   function foo(x)
     real x(..)
     integer :: foo
-    ! CHECK: <<SelectRankConstruct>>
+    ! CHECK: <<SelectRankConstruct!>>
     ! CHECK: SelectRankStmt
     select rank(x)
       ! CHECK: SelectRankCaseStmt
@@ -178,13 +178,13 @@
         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
@@ -203,7 +203,7 @@
         bar = -1
     ! CHECK: EndSelectStmt
     end select
-    ! CHECK: <<EndSelectTypeConstruct>>
+    ! CHECK: <<End SelectTypeConstruct!>>
   end function
 
   ! CHECK: Subroutine sub
@@ -219,7 +219,7 @@
 
 ! CHECK: Subroutine altreturn
 subroutine altreturn(i, j, *, *)
-  ! CHECK: <<IfConstruct>>
+  ! CHECK: <<IfConstruct!>>
   if (i>j) then
     ! CHECK: ReturnStmt
     return 1
@@ -227,7 +227,7 @@
     ! CHECK: ReturnStmt
     return 2
   end if
-  ! CHECK: <<EndIfConstruct>>
+  ! CHECK: <<End IfConstruct!>>
 end subroutine
 
 
@@ -246,7 +246,7 @@
     ! CHECK: OpenStmt
     open(10, FILE=filename)
   end if
-  ! CHECK: <<EndIfConstruct>>
+  ! CHECK: <<End IfConstruct>>
   ! CHECK: ReadStmt
   read(10, *) length
   ! CHECK: RewindStmt
@@ -297,18 +297,18 @@
 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
Index: flang/test/Lower/pre-fir-tree03.f90
===================================================================
--- flang/test/Lower/pre-fir-tree03.f90
+++ flang/test/Lower/pre-fir-tree03.f90
@@ -20,10 +20,10 @@
       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"
@@ -37,13 +37,13 @@
       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"
@@ -53,7 +53,7 @@
     ! CHECK: PrintStmt
     print *, "in task"
   !$omp end task
-  ! CHECK: <<EndOpenMPConstruct>>
+  ! CHECK: <<End OpenMPConstruct>>
 
   ! CHECK: PrintStmt
   print *, "sequential again"
Index: flang/test/Lower/pre-fir-tree04.f90
===================================================================
--- flang/test/Lower/pre-fir-tree04.f90
+++ flang/test/Lower/pre-fir-tree04.f90
@@ -16,7 +16,7 @@
     ! CHECK: AssignmentStmt
     x = x[4, 1]
   end team
-  ! CHECK: <<EndChangeTeamConstruct>>
+  ! CHECK: <<End ChangeTeamConstruct>>
   ! CHECK: FormTeamStmt
   form team(1, t)
 
@@ -28,14 +28,14 @@
     ! 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)
@@ -59,12 +59,12 @@
     ! 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
Index: flang/tools/f18/f18.cpp
===================================================================
--- flang/tools/f18/f18.cpp
+++ flang/tools/f18/f18.cpp
@@ -315,8 +315,7 @@
     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";