PFTBuilder.h

//===-- 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
//
//===----------------------------------------------------------------------===//
//
// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
//
//===----------------------------------------------------------------------===//
//
// PFT (Pre-FIR Tree) interface.
//
//===----------------------------------------------------------------------===//
 
#ifndef FORTRAN_LOWER_PFTBUILDER_H
#define FORTRAN_LOWER_PFTBUILDER_H
 
#include "flang/Common/reference.h"
#include "flang/Common/template.h"
#include "flang/Lower/HostAssociations.h"
#include "flang/Lower/PFTDefs.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Semantics/attr.h"
#include "flang/Semantics/scope.h"
#include "flang/Semantics/semantics.h"
#include "flang/Semantics/symbol.h"
#include "llvm/Support/ErrorHandling.h"
#include "llvm/Support/raw_ostream.h"
#include <algorithm>
 
namespace Fortran::lower::pft {
 
struct CompilerDirectiveUnit;
struct Evaluation;
struct FunctionLikeUnit;
struct ModuleLikeUnit;
struct Program;
 
using ContainedUnit = std::variant<CompilerDirectiveUnit, FunctionLikeUnit>;
using ContainedUnitList = std::list<ContainedUnit>;
using EvaluationList = std::list<Evaluation>;

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;
  ReferenceVariantBase(std::variant<Ref<A>...> b) : u(b) {}
  template <typename T>
  ReferenceVariantBase(Ref<T> b) : u(b) {}
 
  template <typename B>
  constexpr BaseType<B> &get() const {
    return std::get<Ref<B>>(u).get();
  }
  template <typename B>
  constexpr BaseType<B> &getStatement() const {
    return std::get<Ref<parser::Statement<B>>>(u).get().statement;
  }
  template <typename B>
  constexpr BaseType<B> *getIf() const {
    const Ref<B> *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 Fortran::common::visit(
        common::visitors{[&visitor](auto ref) { return visitor(ref.get()); }},
        u);
  }
 
private:
  std::variant<Ref<A>...> u;
};
template <typename... A>
using ReferenceVariant = ReferenceVariantBase<true, A...>;
template <typename... A>
using MutableReferenceVariant = ReferenceVariantBase<false, A...>;

using PftNode = MutableReferenceVariant<Program, ModuleLikeUnit,
                                        FunctionLikeUnit, Evaluation>;

 
using ActionStmts = std::tuple<
    parser::AllocateStmt, parser::AssignmentStmt, parser::BackspaceStmt,
    parser::CallStmt, parser::CloseStmt, parser::ContinueStmt,
    parser::CycleStmt, parser::DeallocateStmt, parser::EndfileStmt,
    parser::EventPostStmt, parser::EventWaitStmt, parser::ExitStmt,
    parser::FailImageStmt, parser::FlushStmt, parser::FormTeamStmt,
    parser::GotoStmt, parser::IfStmt, parser::InquireStmt, parser::LockStmt,
    parser::NotifyWaitStmt, parser::NullifyStmt, parser::OpenStmt,
    parser::PointerAssignmentStmt, parser::PrintStmt, parser::ReadStmt,
    parser::ReturnStmt, parser::RewindStmt, parser::StopStmt,
    parser::SyncAllStmt, parser::SyncImagesStmt, parser::SyncMemoryStmt,
    parser::SyncTeamStmt, parser::UnlockStmt, parser::WaitStmt,
    parser::WhereStmt, parser::WriteStmt, parser::ComputedGotoStmt,
    parser::ForallStmt, parser::ArithmeticIfStmt, parser::AssignStmt,
    parser::AssignedGotoStmt, parser::PauseStmt>;
 
using OtherStmts = std::tuple<parser::EntryStmt, parser::FormatStmt>;
 
using ConstructStmts = std::tuple<
    parser::AssociateStmt, parser::EndAssociateStmt, parser::BlockStmt,
    parser::EndBlockStmt, parser::SelectCaseStmt, parser::CaseStmt,
    parser::EndSelectStmt, parser::ChangeTeamStmt, parser::EndChangeTeamStmt,
    parser::CriticalStmt, parser::EndCriticalStmt, parser::NonLabelDoStmt,
    parser::EndDoStmt, parser::IfThenStmt, parser::ElseIfStmt, parser::ElseStmt,
    parser::EndIfStmt, parser::SelectRankStmt, parser::SelectRankCaseStmt,
    parser::SelectTypeStmt, parser::TypeGuardStmt, parser::WhereConstructStmt,
    parser::MaskedElsewhereStmt, parser::ElsewhereStmt, parser::EndWhereStmt,
    parser::ForallConstructStmt, parser::EndForallStmt>;
 
using EndStmts =
    std::tuple<parser::EndProgramStmt, parser::EndFunctionStmt,
               parser::EndSubroutineStmt, parser::EndMpSubprogramStmt>;
 
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::OpenACCConstruct,
               parser::OpenACCRoutineConstruct,
               parser::OpenACCDeclarativeConstruct, parser::OpenMPConstruct,
               parser::OpenMPDeclarativeConstruct,
               parser::CUFKernelDoConstruct>;
 
using DeclConstructs = std::tuple<parser::OpenMPDeclarativeConstruct,
                                  parser::OpenACCDeclarativeConstruct>;
 
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>
static constexpr bool isConstructStmt{common::HasMember<A, ConstructStmts>};
 
template <typename A>
static constexpr bool isEndStmt{common::HasMember<A, EndStmts>};
 
template <typename A>
static constexpr bool isConstruct{common::HasMember<A, Constructs>};
 
template <typename A>
static constexpr bool isDirective{common::HasMember<A, Directives>};
 
template <typename A>
static constexpr bool isDeclConstruct{common::HasMember<A, DeclConstructs>};
 
template <typename A>
static constexpr bool isIntermediateConstructStmt{common::HasMember<
    A, std::tuple<parser::CaseStmt, parser::ElseIfStmt, parser::ElseStmt,
                  parser::SelectRankCaseStmt, parser::TypeGuardStmt>>};
 
template <typename A>
static constexpr bool isNopConstructStmt{common::HasMember<
    A, std::tuple<parser::CaseStmt, parser::ElseIfStmt, parser::ElseStmt,
                  parser::EndIfStmt, parser::SelectRankCaseStmt,
                  parser::TypeGuardStmt>>};
 
template <typename A>
static constexpr bool isExecutableDirective{common::HasMember<
    A, std::tuple<parser::CompilerDirective, parser::OpenACCConstruct,
                  parser::OpenMPConstruct, parser::CUFKernelDoConstruct>>};
 
template <typename A>
static constexpr bool isOpenMPDirective{
    common::HasMember<A, std::tuple<parser::OpenMPConstruct,
                                    parser::OpenMPDeclarativeConstruct>>};
 
template <typename A>
static constexpr bool isFunctionLike{common::HasMember<
    A, std::tuple<parser::MainProgram, parser::FunctionSubprogram,
                  parser::SubroutineSubprogram,
                  parser::SeparateModuleSubprogram>>};
 
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;
 
using EvaluationTuple =
    common::CombineTuples<ActionStmts, OtherStmts, ConstructStmts, EndStmts,
                          Constructs, Directives>;
using EvaluationVariant = MakeReferenceVariant<EvaluationTuple>;

struct Evaluation : EvaluationVariant {

  template <typename A>
  Evaluation(const A &a, const PftNode &parent,
             const parser::CharBlock &position,
             const std::optional<parser::Label> &label)
      : EvaluationVariant{a}, parent{parent}, position{position}, label{label} {
  }

  template <typename A>
  Evaluation(const A &a, const PftNode &parent)
      : EvaluationVariant{a}, parent{parent} {
    static_assert(pft::isConstruct<A> || pft::isDirective<A>,
                  "must be a construct or directive");
  }

  constexpr bool isActionStmt() const {
    return visit(common::visitors{
        [](auto &r) { return pft::isActionStmt<std::decay_t<decltype(r)>>; }});
  }
  constexpr bool isOtherStmt() const {
    return visit(common::visitors{
        [](auto &r) { return pft::isOtherStmt<std::decay_t<decltype(r)>>; }});
  }
  constexpr bool isConstructStmt() const {
    return visit(common::visitors{[](auto &r) {
      return pft::isConstructStmt<std::decay_t<decltype(r)>>;
    }});
  }
  constexpr bool isEndStmt() const {
    return visit(common::visitors{
        [](auto &r) { return pft::isEndStmt<std::decay_t<decltype(r)>>; }});
  }
  constexpr bool isConstruct() const {
    return visit(common::visitors{
        [](auto &r) { return pft::isConstruct<std::decay_t<decltype(r)>>; }});
  }
  constexpr bool isDirective() const {
    return visit(common::visitors{
        [](auto &r) { return pft::isDirective<std::decay_t<decltype(r)>>; }});
  }
  constexpr bool isNopConstructStmt() const {
    return visit(common::visitors{[](auto &r) {
      return pft::isNopConstructStmt<std::decay_t<decltype(r)>>;
    }});
  }
  constexpr bool isExecutableDirective() const {
    return visit(common::visitors{[](auto &r) {
      return pft::isExecutableDirective<std::decay_t<decltype(r)>>;
    }});
  }
  constexpr bool isOpenMPDirective() const {
    return visit(common::visitors{[](auto &r) {
      return pft::isOpenMPDirective<std::decay_t<decltype(r)>>;
    }});
  }

  constexpr bool isIntermediateConstructStmt() const {
    return visit(common::visitors{[](auto &r) {
      return pft::isIntermediateConstructStmt<std::decay_t<decltype(r)>>;
    }});
  }
 
  LLVM_DUMP_METHOD void dump() const;

  Evaluation &nonNopSuccessor() const {
    Evaluation *successor = lexicalSuccessor;
    if (successor && successor->isNopConstructStmt())
      successor = successor->parentConstruct->constructExit;
    assert(successor && "missing successor");
    return *successor;
  }

  bool hasNestedEvaluations() const {
    return evaluationList && !evaluationList->empty();
  }

  EvaluationList &getNestedEvaluations() {
    assert(evaluationList && "no nested evaluations");
    return *evaluationList;
  }
 
  Evaluation &getFirstNestedEvaluation() {
    assert(hasNestedEvaluations() && "no nested evaluations");
    return evaluationList->front();
  }
 
  Evaluation &getLastNestedEvaluation() {
    assert(hasNestedEvaluations() && "no nested evaluations");
    return evaluationList->back();
  }

  FunctionLikeUnit *getOwningProcedure() const;

  enum class ControlFlow {
    Structured,
    StructuredWithUnstructuredInternals,
    Unstructured,
  };

  void markControlFlow(ControlFlow kind) {
    controlFlow = std::max(controlFlow, kind);
  }
 
  void markUnstructured() { markControlFlow(ControlFlow::Unstructured); }

  void weakenControlFlow(ControlFlow kind) {
    controlFlow = std::min(controlFlow, kind);
  }

  bool isUnstructured() const {
    return controlFlow == ControlFlow::Unstructured;
  }
 
  bool hasUnstructuredInternals() const {
    return controlFlow == ControlFlow::StructuredWithUnstructuredInternals;
  }

  bool lowerBodyAsWrappedRegion() const;
 
  bool lowerAsStructured() const;
  bool lowerAsUnstructured() const;
  bool forceAsUnstructured() const;
 
  // FIR generation looks primarily at PFT ActionStmt and ConstructStmt leaf
  // nodes. Members such as lexicalSuccessor and block are applicable only
  // to these nodes, plus some directives. The controlSuccessor member is
  // used for nonlexical successors, such as linking to a GOTO target. For
  // multiway branches (computed GO TO, arithmetic IF), it is set to the
  // first target and any additional targets are recorded in
  // extraControlSuccessors so analyses that need to see every branch target
  // (e.g. wrappability of an unstructured construct) can enumerate them all.
  // Successor and exit links always target statements or directives. An
  // internal Construct node has a constructExit link that applies to exits
  // from anywhere within the construct.
  //
  // An unstructured construct is one that contains some form of goto. This
  // is indicated by the controlFlow member, 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.
  //
  // The block member is set for statements that begin a new block. This
  // block is the target of any branch to the statement. Statements may have
  // additional (unstructured) "local" blocks, but such blocks cannot be the
  // target of any explicit branch. The primary example of an (unstructured)
  // statement that may have multiple associated blocks is NonLabelDoStmt,
  // which may have a loop preheader block for loop initialization code (the
  // block member), and always has a "local" header block that is the target
  // of the loop back edge. If the NonLabelDoStmt is a concurrent loop, it
  // may be associated with an arbitrary number of nested preheader, header,
  // and mask blocks.
  //
  // The printIndex member is only set for statements. It is used for dumps
  // (and debugging) and does not affect FIR generation.
 
  PftNode parent;
  parser::CharBlock position{};
  std::optional<parser::Label> label{};
  std::unique_ptr<EvaluationList> evaluationList; // nested evaluations
  // associated compiler directives
  llvm::SmallVector<const parser::CompilerDirective *, 1> dirs;
  Evaluation *parentConstruct{nullptr};  // set for nodes below the top level
  Evaluation *lexicalSuccessor{nullptr}; // set for leaf nodes, some directives
  Evaluation *controlSuccessor{nullptr}; // set for some leaf nodes
  // Additional branch targets for multiway branches (computed GO TO,
  // arithmetic IF). Empty for single-target branches; the first target is in
  // controlSuccessor and the remaining ones are stored here in source order.
  llvm::SmallVector<Evaluation *, 0> extraControlSuccessors;
  Evaluation *constructExit{nullptr};    // set for constructs
  bool isNewBlock{false};                // evaluation begins a new basic block
  ControlFlow controlFlow{ControlFlow::Structured};
  bool negateCondition{false}; // If[Then]Stmt condition must be negated
  bool activeConstruct{false}; // temporarily set for some constructs
  // The enclosing evaluation-list traversal should skip this evaluation once
  // because directive lowering already consumed it.
  bool skipNextLowering{false};
  mlir::Block *block{nullptr}; // isNewBlock block (ActionStmt, ConstructStmt)
  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, parser::CompilerDirective,
                     parser::OpenACCRoutineConstruct>;
struct ProgramUnit : ProgramVariant {
  template <typename A>
  ProgramUnit(const A &p, const PftNode &parent)
      : ProgramVariant{p}, parent{parent} {}
  ProgramUnit(ProgramUnit &&) = default;
  ProgramUnit(const ProgramUnit &) = delete;
 
  PftNode parent;
};

struct Variable {
  struct Nominal {
    Nominal(const semantics::Symbol *symbol, int depth, bool global)
        : symbol{symbol}, depth{depth}, global{global} {}
    const semantics::Symbol *symbol{};
 
    bool isGlobal() const { return global; }
 
    int depth{};
    bool global{};
    bool heapAlloc{}; // variable needs deallocation on exit
    bool pointer{};
    bool target{};
    bool aliaser{}; // participates in EQUIVALENCE union
    std::size_t aliasOffset{};
  };

  using Interval = std::tuple<std::size_t, std::size_t>;

  struct AggregateStore {
    AggregateStore(Interval &&interval,
                   const Fortran::semantics::Symbol &namingSym,
                   bool isGlobal = false)
        : interval{std::move(interval)}, namingSymbol{&namingSym},
          isGlobalAggregate{isGlobal} {}
    AggregateStore(const semantics::Symbol &initialValueSym,
                   const semantics::Symbol &namingSym, bool isGlobal = false)
        : interval{initialValueSym.offset(), initialValueSym.size()},
          namingSymbol{&namingSym}, initialValueSymbol{&initialValueSym},
          isGlobalAggregate{isGlobal} {};
 
    bool isGlobal() const { return isGlobalAggregate; }
    std::size_t getOffset() const { return std::get<0>(interval); }
    const semantics::Symbol *getInitialValueSymbol() const {
      return initialValueSymbol;
    }

    const semantics::Symbol &getNamingSymbol() const { return *namingSymbol; }
    const semantics::Scope &getOwningScope() const {
      return getNamingSymbol().owner();
    }

    Interval interval{};
    const semantics::Symbol *namingSymbol;
    const semantics::Symbol *initialValueSymbol = nullptr;
    bool isGlobalAggregate;
  };
 
  explicit Variable(const Fortran::semantics::Symbol &sym, bool global = false,
                    int depth = 0)
      : var{Nominal(&sym, depth, global)} {}
  explicit Variable(AggregateStore &&istore) : var{std::move(istore)} {}

  const Fortran::semantics::Symbol &getSymbol() const {
    assert(hasSymbol() && "variable is not nominal");
    return *std::get<Nominal>(var).symbol;
  }

  bool isRuntimeTypeInfoData() const;

  const AggregateStore &getAggregateStore() const {
    assert(isAggregateStore());
    return std::get<AggregateStore>(var);
  }

  const Interval &getInterval() const {
    assert(isAggregateStore());
    return std::get<AggregateStore>(var).interval;
  }

  bool hasSymbol() const { return std::holds_alternative<Nominal>(var); }

  bool isAggregateStore() const {
    return std::holds_alternative<AggregateStore>(var);
  }

  bool isGlobal() const {
    return Fortran::common::visit([](const auto &x) { return x.isGlobal(); },
                                  var);
  }

  bool isModuleOrSubmoduleVariable() const {
    const semantics::Scope *scope = getOwningScope();
    return scope && scope->kind() == Fortran::semantics::Scope::Kind::Module;
  }
 
  const Fortran::semantics::Scope *getOwningScope() const {
    return Fortran::common::visit(
        common::visitors{
            [](const Nominal &x) { return &x.symbol->GetUltimate().owner(); },
            [](const AggregateStore &agg) { return &agg.getOwningScope(); }},
        var);
  }
 
  bool isHeapAlloc() const {
    if (auto *s = std::get_if<Nominal>(&var))
      return s->heapAlloc;
    return false;
  }
  bool isPointer() const {
    if (auto *s = std::get_if<Nominal>(&var))
      return s->pointer;
    return false;
  }
  bool isTarget() const {
    if (auto *s = std::get_if<Nominal>(&var))
      return s->target;
    return false;
  }

  bool isAlias() const {
    if (auto *s = std::get_if<Nominal>(&var))
      return s->aliaser;
    return false;
  }
  std::size_t getAliasOffset() const {
    if (auto *s = std::get_if<Nominal>(&var))
      return s->aliasOffset;
    return 0;
  }
  void setAlias(std::size_t offset) {
    if (auto *s = std::get_if<Nominal>(&var)) {
      s->aliaser = true;
      s->aliasOffset = offset;
    } else {
      llvm_unreachable("not a nominal var");
    }
  }
 
  void setHeapAlloc(bool to = true) {
    if (auto *s = std::get_if<Nominal>(&var))
      s->heapAlloc = to;
    else
      llvm_unreachable("not a nominal var");
  }
  void setPointer(bool to = true) {
    if (auto *s = std::get_if<Nominal>(&var))
      s->pointer = to;
    else
      llvm_unreachable("not a nominal var");
  }
  void setTarget(bool to = true) {
    if (auto *s = std::get_if<Nominal>(&var))
      s->target = to;
    else
      llvm_unreachable("not a nominal var");
  }

  int getDepth() const {
    if (auto *s = std::get_if<Nominal>(&var))
      return s->depth;
    return 0;
  }
 
  LLVM_DUMP_METHOD void dump() const;
 
private:
  std::variant<Nominal, AggregateStore> var;
};
 
using VariableList = std::vector<Variable>;
using ScopeVariableListMap =
    std::map<const Fortran::semantics::Scope *, VariableList>;

const VariableList &getScopeVariableList(const Fortran::semantics::Scope &scope,
                                         ScopeVariableListMap &map);

VariableList getScopeVariableList(const Fortran::semantics::Scope &scope);

VariableList getDependentVariableList(const Fortran::semantics::Symbol &);
 
struct FunctionLikeUnit;
VariableList getHostModuleVariableList(const FunctionLikeUnit &funit);
 
void dump(VariableList &, std::string s = {}); // `s` is an optional dump label

struct FunctionLikeUnit : public ProgramUnit {
  // wrapper statements for function-like syntactic structures
  using FunctionStatement =
      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 PftNode &parent,
      const Fortran::semantics::SemanticsContext &semanticsContext);
  FunctionLikeUnit(
      const parser::FunctionSubprogram &f, const PftNode &parent,
      const Fortran::semantics::SemanticsContext &semanticsContext);
  FunctionLikeUnit(
      const parser::SubroutineSubprogram &f, const PftNode &parent,
      const Fortran::semantics::SemanticsContext &semanticsContext);
  FunctionLikeUnit(
      const parser::SeparateModuleSubprogram &f, const PftNode &parent,
      const Fortran::semantics::SemanticsContext &semanticsContext);
  FunctionLikeUnit(FunctionLikeUnit &&) = default;
  FunctionLikeUnit(const FunctionLikeUnit &) = delete;
 
  bool isMainProgram() const {
    return endStmt.isA<parser::Statement<parser::EndProgramStmt>>();
  }

  parser::CharBlock getStartingSourceLoc() const;
 
  void setActiveEntry(int entryIndex) {
    assert(entryIndex >= 0 && entryIndex < (int)entryPointList.size() &&
           "invalid entry point index");
    activeEntry = entryIndex;
  }

  const semantics::Symbol &getSubprogramSymbol() const {
    const semantics::Symbol *symbol = entryPointList[activeEntry].first;
    if (!symbol)
      llvm::report_fatal_error(
          "not inside a procedure; do not call on main program.");
    return *symbol;
  }

  const semantics::Symbol *getMainProgramSymbol() const {
    if (!isMainProgram()) {
      llvm::report_fatal_error("call only on main program.");
    }
    return entryPointList[activeEntry].first;
  }

  Evaluation *getEntryEval() const {
    return entryPointList[activeEntry].second;
  }
 
  //===--------------------------------------------------------------------===//
  // Host associations
  //===--------------------------------------------------------------------===//
 
  void setHostAssociatedSymbols(
      const llvm::SetVector<const semantics::Symbol *> &symbols) {
    hostAssociations.addSymbolsToBind(symbols, getScope());
  }

  HostAssociations &parentHostAssoc();

  bool parentHasTupleHostAssoc();

  bool parentHasHostAssoc();

  HostAssociations &getHostAssoc() { return hostAssociations; }
  const HostAssociations &getHostAssoc() const { return hostAssociations; };
 
  LLVM_DUMP_METHOD void dump() const;

  const Fortran::semantics::Scope &getScope() const { return *scope; }

  std::optional<FunctionStatement> beginStmt;
  FunctionStatement endStmt;
  const semantics::Scope *scope;
  LabelEvalMap labelEvaluationMap;
  SymbolLabelMap assignSymbolLabelMap;
  IncomingBranchMap incomingBranches;
  ContainedUnitList containedUnitList;
  EvaluationList evaluationList;
  llvm::SmallVector<std::pair<const semantics::Symbol *, Evaluation *>, 1>
      entryPointList{std::pair{nullptr, nullptr}};
  int activeEntry = 0;
  const semantics::Symbol *primaryResult{nullptr};
  bool hasIeeeAccess{false};
  bool mayModifyHaltingMode{false};
  bool mayModifyRoundingMode{false};
  bool mayModifyUnderflowMode{false};
  mlir::Block *finalBlock{};
  HostAssociations hostAssociations;
  std::list<Fortran::semantics::PreservedUseStmt> preservedUseStmts;
};

struct ModuleLikeUnit : public ProgramUnit {
  // wrapper statements for module-like syntactic structures
  using ModuleStatement =
      ReferenceVariant<parser::Statement<parser::ModuleStmt>,
                       parser::Statement<parser::EndModuleStmt>,
                       parser::Statement<parser::SubmoduleStmt>,
                       parser::Statement<parser::EndSubmoduleStmt>>;
 
  ModuleLikeUnit(const parser::Module &m, const PftNode &parent);
  ModuleLikeUnit(const parser::Submodule &m, const PftNode &parent);
  ~ModuleLikeUnit() = default;
  ModuleLikeUnit(ModuleLikeUnit &&) = default;
  ModuleLikeUnit(const ModuleLikeUnit &) = delete;
 
  LLVM_DUMP_METHOD void dump() const;

  parser::CharBlock getStartingSourceLoc() const;

  const Fortran::semantics::Scope &getScope() const;
 
  ModuleStatement beginStmt;
  ModuleStatement endStmt;
  ContainedUnitList containedUnitList;
  EvaluationList evaluationList;
  std::list<Fortran::semantics::PreservedUseStmt> preservedUseStmts;
};

struct BlockDataUnit : public ProgramUnit {
  BlockDataUnit(const parser::BlockData &bd, const PftNode &parent,
                const Fortran::semantics::SemanticsContext &semanticsContext);
  BlockDataUnit(BlockDataUnit &&) = default;
  BlockDataUnit(const BlockDataUnit &) = delete;
 
  LLVM_DUMP_METHOD void dump() const;
 
  const Fortran::semantics::Scope &symTab; // symbol table
};
 
// Top level compiler directives
struct CompilerDirectiveUnit : public ProgramUnit {
  CompilerDirectiveUnit(const parser::CompilerDirective &directive,
                        const PftNode &parent)
      : ProgramUnit{directive, parent} {};
  CompilerDirectiveUnit(CompilerDirectiveUnit &&) = default;
  CompilerDirectiveUnit(const CompilerDirectiveUnit &) = delete;
};
 
// Top level OpenACC routine directives
struct OpenACCDirectiveUnit : public ProgramUnit {
  OpenACCDirectiveUnit(const parser::OpenACCRoutineConstruct &directive,
                       const PftNode &parent)
      : ProgramUnit{directive, parent}, routine{directive} {};
  OpenACCDirectiveUnit(OpenACCDirectiveUnit &&) = default;
  OpenACCDirectiveUnit(const OpenACCDirectiveUnit &) = delete;
  const parser::OpenACCRoutineConstruct &routine;
};

struct Program {
  using Units = std::variant<FunctionLikeUnit, ModuleLikeUnit, BlockDataUnit,
                             CompilerDirectiveUnit, OpenACCDirectiveUnit>;
 
  Program(semantics::CommonBlockList &&commonBlocks)
      : commonBlocks{std::move(commonBlocks)} {}
  Program(Program &&) = default;
  Program(const Program &) = delete;
 
  const std::list<Units> &getUnits() const { return units; }
  std::list<Units> &getUnits() { return units; }
  const semantics::CommonBlockList &getCommonBlocks() const {
    return commonBlocks;
  }
  ScopeVariableListMap &getScopeVariableListMap() {
    return scopeVariableListMap;
  }

  LLVM_DUMP_METHOD void dump() const;
 
private:
  std::list<Units> units;
  semantics::CommonBlockList commonBlocks;
  ScopeVariableListMap scopeVariableListMap; // module and submodule scopes
};

template <typename T>
parser::CharBlock stmtSourceLoc(const T &stmt) {
  return stmt.visit(common::visitors{[](const auto &x) { return x.source; }});
}

template <typename ParentType, typename A>
ParentType *getAncestor(A &node) {
  if (auto *seekedParent = node.parent.template getIf<ParentType>())
    return seekedParent;
  return node.parent.visit(common::visitors{
      [](Program &p) -> ParentType * { return nullptr; },
      [](auto &p) -> ParentType * { return getAncestor<ParentType>(p); }});
}

template <typename A>
ScopeVariableListMap &getScopeVariableListMap(A &node) {
  Program *pftRoot = getAncestor<Program>(node);
  assert(pftRoot && "pft must have a root");
  return pftRoot->getScopeVariableListMap();
}

void visitAllSymbols(const FunctionLikeUnit &funit,
                     std::function<void(const semantics::Symbol &)> callBack);

void visitAllSymbols(const Evaluation &eval,
                     std::function<void(const semantics::Symbol &)> callBack);

bool isWrappableConstruct(const Evaluation &eval,
                          const semantics::SemanticsContext &semaCtx);
 
} // namespace Fortran::lower::pft
 
namespace Fortran::lower {
class LoweringOptions;

std::unique_ptr<pft::Program>
createPFT(const parser::Program &root,
          const Fortran::semantics::SemanticsContext &semanticsContext,
          const LoweringOptions &loweringOptions);

void dumpPFT(llvm::raw_ostream &outputStream, const pft::Program &pft);
} // namespace Fortran::lower
 
#endif // FORTRAN_LOWER_PFTBUILDER_H