brintos

brintos / llvm-project-archived public Read only

0
0
Text · 38.3 KiB · 558aad1 Raw
851 lines · cpp
1//===- ConvertArrayConstructor.cpp -- Array Constructor ---------*- C++ -*-===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8 9#include "flang/Lower/ConvertArrayConstructor.h"10#include "flang/Evaluate/expression.h"11#include "flang/Lower/AbstractConverter.h"12#include "flang/Lower/ConvertExprToHLFIR.h"13#include "flang/Lower/ConvertType.h"14#include "flang/Lower/StatementContext.h"15#include "flang/Lower/SymbolMap.h"16#include "flang/Optimizer/Builder/HLFIRTools.h"17#include "flang/Optimizer/Builder/Runtime/ArrayConstructor.h"18#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"19#include "flang/Optimizer/Builder/TemporaryStorage.h"20#include "flang/Optimizer/Builder/Todo.h"21#include "flang/Optimizer/HLFIR/HLFIROps.h"22 23namespace {24/// Check if we are inside a WHERE construct's masked expression region.25/// Array constructors inside WHERE statements must be evaluated exactly once26/// without mask control, similar to non-elemental function calls.27 28static bool isInWhereMaskedExpression(fir::FirOpBuilder &builder) {29  mlir::Operation *op = builder.getRegion().getParentOp();30  return op && op->getParentOfType<hlfir::WhereOp>();31}32 33} // namespace34 35// Array constructors are lowered with three different strategies.36// All strategies are not possible with all array constructors.37//38// - Strategy 1: runtime approach (RuntimeTempStrategy).39//   This strategy works will all array constructors, but will create more40//   complex code that is harder to optimize. An allocatable temp is created,41//   it may be unallocated if the array constructor length parameters or extent42//   could not be computed. Then, the runtime is called to push lowered43//   ac-value (array constructor elements) into the allocatable. The runtime44//   will allocate or reallocate as needed while values are being pushed.45//   In the end, the allocatable contain a temporary with all the array46//   constructor evaluated elements.47//48// - Strategy 2: inlined temporary approach (InlinedTempStrategyImpl)49//   This strategy can only be used if the array constructor extent and length50//   parameters can be pre-computed without evaluating any ac-value, and if all51//   of the ac-value are scalars (at least for now).52//   A temporary is allocated inline in one go, and an index pointing at the53//   current ac-value position in the array constructor element sequence is54//   maintained and used to store ac-value as they are being lowered.55//56// - Strategy 3: "function of the indices" approach (AsElementalStrategy)57//   This strategy can only be used if the array constructor extent and length58//   parameters can be pre-computed and, if the array constructor is of the59//   form "[(scalar_expr, ac-implied-do-control)]". In this case, it is lowered60//   into an hlfir.elemental without creating any temporary in lowering. This61//   form should maximize the chance of array temporary elision when assigning62//   the array constructor, potentially reshaped, to an array variable.63//64//   The array constructor lowering looks like:65//   ```66//     strategy = selectArrayCtorLoweringStrategy(array-ctor-expr);67//     for (ac-value : array-ctor-expr)68//       if (ac-value is expression) {69//         strategy.pushValue(ac-value);70//       } else if (ac-value is implied-do) {71//         strategy.startImpliedDo(lower, upper, stride);72//         strategy.startImpliedDoScope();73//         // lower nested values74//         ...75//         strategy.endImpliedDoScope();76//       }77//     result = strategy.finishArrayCtorLowering();78//   ```79 80//===----------------------------------------------------------------------===//81//   Definition of the lowering strategies. Each lowering strategy is defined82//   as a class that implements "pushValue", "startImpliedDo" and83//   "finishArrayCtorLowering". A strategy may optionally override84//   "startImpliedDoScope" and "endImpliedDoScope" virtual methods85//   of its base class StrategyBase.86//===----------------------------------------------------------------------===//87 88namespace {89/// Class provides common implementation of scope push/pop methods90/// that update StatementContext scopes and SymMap bindings.91/// They might be overridden by the lowering strategies, e.g.92/// see AsElementalStrategy.93class StrategyBase {94public:95  StrategyBase(Fortran::lower::StatementContext &stmtCtx,96               Fortran::lower::SymMap &symMap)97      : stmtCtx{stmtCtx}, symMap{symMap} {};98  virtual ~StrategyBase() = default;99 100  virtual void startImpliedDoScope(llvm::StringRef doName,101                                   mlir::Value indexValue) {102    symMap.pushImpliedDoBinding(doName, indexValue);103    stmtCtx.pushScope();104  }105 106  virtual void endImpliedDoScope() {107    stmtCtx.finalizeAndPop();108    symMap.popImpliedDoBinding();109  }110 111protected:112  Fortran::lower::StatementContext &stmtCtx;113  Fortran::lower::SymMap &symMap;114};115 116/// Class that implements the "inlined temp strategy" to lower array117/// constructors. It must be provided a boolean to indicate if the array118/// constructor has any implied-do-loop.119template <bool hasLoops>120class InlinedTempStrategyImpl : public StrategyBase,121                                public fir::factory::HomogeneousScalarStack {122  /// Name that will be given to the temporary allocation and hlfir.declare in123  /// the IR.124  static constexpr char tempName[] = ".tmp.arrayctor";125 126public:127  /// Start lowering an array constructor according to the inline strategy.128  /// The temporary is created right away.129  InlinedTempStrategyImpl(mlir::Location loc, fir::FirOpBuilder &builder,130                          Fortran::lower::StatementContext &stmtCtx,131                          Fortran::lower::SymMap &symMap,132                          fir::SequenceType declaredType, mlir::Value extent,133                          llvm::ArrayRef<mlir::Value> lengths)134      : StrategyBase{stmtCtx, symMap},135        fir::factory::HomogeneousScalarStack{136            loc,      builder, declaredType,137            extent,   lengths, /*allocateOnHeap=*/true,138            hasLoops, tempName} {}139 140  /// Push a lowered ac-value into the current insertion point and141  /// increment the insertion point.142  using fir::factory::HomogeneousScalarStack::pushValue;143 144  /// Start a fir.do_loop with the control from an implied-do and return145  /// the loop induction variable that is the ac-do-variable value.146  /// Only usable if the counter is able to track the position through loops.147  mlir::Value startImpliedDo(mlir::Location loc, fir::FirOpBuilder &builder,148                             mlir::Value lower, mlir::Value upper,149                             mlir::Value stride) {150    if constexpr (!hasLoops)151      fir::emitFatalError(loc, "array constructor lowering is inconsistent");152    auto loop = fir::DoLoopOp::create(builder, loc, lower, upper, stride,153                                      /*unordered=*/false,154                                      /*finalCount=*/false);155    builder.setInsertionPointToStart(loop.getBody());156    return loop.getInductionVar();157  }158 159  /// Move the temporary to an hlfir.expr value (array constructors are not160  /// variables and cannot be further modified).161  hlfir::Entity finishArrayCtorLowering(mlir::Location loc,162                                        fir::FirOpBuilder &builder) {163    return moveStackAsArrayExpr(loc, builder);164  }165};166 167/// Semantic analysis expression rewrites unroll implied do loop with168/// compile time constant bounds (even if huge). So using a minimalistic169/// counter greatly reduces the generated IR for simple but big array170/// constructors [(i,i=1,constant-expr)] that are expected to be quite171/// common.172using LooplessInlinedTempStrategy = InlinedTempStrategyImpl</*hasLoops=*/false>;173/// A generic memory based counter that can deal with all cases of174/// "inlined temp strategy". The counter value is stored in a temp175/// from which it is loaded, incremented, and stored every time an176/// ac-value is pushed.177using InlinedTempStrategy = InlinedTempStrategyImpl</*hasLoops=*/true>;178 179/// Class that implements the "as function of the indices" lowering strategy.180/// It will lower [(scalar_expr(i), i=l,u,s)] to:181/// ```182///   %extent = max((%u-%l+1)/%s, 0)183///   %shape = fir.shape %extent184///   %elem = hlfir.elemental %shape {185///     ^bb0(%pos:index):186///      %i = %l+(%i-1)*%s187///      %value = scalar_expr(%i)188///       hlfir.yield_element %value189///    }190/// ```191/// That way, no temporary is created in lowering, and if the array constructor192/// is part of a more complex elemental expression, or an assignment, it will be193/// trivial to "inline" it in the expression or assignment loops if allowed by194/// alias analysis.195/// This lowering is however only possible for the form of array constructors as196/// in the illustration above. It could be extended to deeper independent197/// implied-do nest and wrapped in an hlfir.reshape to a rank 1 array. But this198/// op does not exist yet, so this is left for the future if it appears199/// profitable.200class AsElementalStrategy : public StrategyBase {201public:202  /// The constructor only gathers the operands to create the hlfir.elemental.203  AsElementalStrategy(mlir::Location loc, fir::FirOpBuilder &builder,204                      Fortran::lower::StatementContext &stmtCtx,205                      Fortran::lower::SymMap &symMap,206                      fir::SequenceType declaredType, mlir::Value extent,207                      llvm::ArrayRef<mlir::Value> lengths)208      : StrategyBase{stmtCtx, symMap}, shape{builder.genShape(loc, {extent})},209        lengthParams{lengths}, exprType{getExprType(declaredType)} {}210 211  static hlfir::ExprType getExprType(fir::SequenceType declaredType) {212    // Note: 7.8 point 4: the dynamic type of an array constructor is its static213    // type, it is not polymorphic.214    return hlfir::ExprType::get(declaredType.getContext(),215                                declaredType.getShape(),216                                declaredType.getEleTy(),217                                /*isPolymorphic=*/false);218  }219 220  /// Create the hlfir.elemental and compute the ac-implied-do-index value221  /// given the lower bound and stride (compute "%i" in the illustration above).222  mlir::Value startImpliedDo(mlir::Location loc, fir::FirOpBuilder &builder,223                             mlir::Value lower, mlir::Value upper,224                             mlir::Value stride) {225    assert(!elementalOp && "expected only one implied-do");226    mlir::Value one =227        builder.createIntegerConstant(loc, builder.getIndexType(), 1);228    elementalOp = hlfir::ElementalOp::create(builder, loc, exprType, shape,229                                             /*mold=*/nullptr, lengthParams,230                                             /*isUnordered=*/true);231    builder.setInsertionPointToStart(elementalOp.getBody());232    // implied-do-index = lower+((i-1)*stride)233    mlir::Value diff = mlir::arith::SubIOp::create(234        builder, loc, elementalOp.getIndices()[0], one);235    mlir::Value mul = mlir::arith::MulIOp::create(builder, loc, diff, stride);236    mlir::Value add = mlir::arith::AddIOp::create(builder, loc, lower, mul);237    return add;238  }239 240  /// Create the elemental hlfir.yield_element with the scalar ac-value.241  void pushValue(mlir::Location loc, fir::FirOpBuilder &builder,242                 hlfir::Entity value) {243    assert(value.isScalar() && "cannot use hlfir.elemental with array values");244    assert(elementalOp && "array constructor must contain an outer implied-do");245    mlir::Value elementResult = value;246    if (fir::isa_trivial(elementResult.getType()))247      elementResult =248          builder.createConvert(loc, exprType.getElementType(), elementResult);249 250    // The clean-ups associated with the implied-do body operations251    // must be initiated before the YieldElementOp, so we have to pop the scope252    // right now.253    stmtCtx.finalizeAndPop();254 255    // This is a hacky way to get rid of the DestroyOp clean-up256    // associated with the final ac-value result if it is hlfir.expr.257    // Example:258    //   ... = (/(REPEAT(REPEAT(CHAR(i),2),2),i=1,n)/)259    // Each intrinsic call lowering will produce hlfir.expr result260    // with the associated clean-up, but only the last of them261    // is wrong. It is wrong because the value is used in hlfir.yield_element,262    // so it cannot be destroyed.263    mlir::Operation *destroyOp = nullptr;264    for (mlir::Operation *useOp : elementResult.getUsers())265      if (mlir::isa<hlfir::DestroyOp>(useOp)) {266        if (destroyOp)267          fir::emitFatalError(loc,268                              "multiple DestroyOp's for ac-value expression");269        destroyOp = useOp;270      }271 272    if (destroyOp)273      destroyOp->erase();274 275    hlfir::YieldElementOp::create(builder, loc, elementResult);276  }277 278  // Override the default, because the context scope must be popped in279  // pushValue().280  virtual void endImpliedDoScope() override { symMap.popImpliedDoBinding(); }281 282  /// Return the created hlfir.elemental.283  hlfir::Entity finishArrayCtorLowering(mlir::Location loc,284                                        fir::FirOpBuilder &builder) {285    return hlfir::Entity{elementalOp};286  }287 288private:289  mlir::Value shape;290  llvm::SmallVector<mlir::Value> lengthParams;291  hlfir::ExprType exprType;292  hlfir::ElementalOp elementalOp{};293};294 295/// Class that implements the "runtime temp strategy" to lower array296/// constructors.297class RuntimeTempStrategy : public StrategyBase {298  /// Name that will be given to the temporary allocation and hlfir.declare in299  /// the IR.300  static constexpr char tempName[] = ".tmp.arrayctor";301 302public:303  /// Start lowering an array constructor according to the runtime strategy.304  /// The temporary is only created if the extents and length parameters are305  /// already known. Otherwise, the handling of the allocation (and306  /// reallocation) is left up to the runtime.307  /// \p extent is the pre-computed extent of the array constructor, if it could308  /// be pre-computed. It is std::nullopt otherwise.309  /// \p lengths are the pre-computed length parameters of the array310  /// constructor, if they could be precomputed. \p missingLengthParameters is311  /// set to true if the length parameters could not be precomputed.312  RuntimeTempStrategy(mlir::Location loc, fir::FirOpBuilder &builder,313                      Fortran::lower::StatementContext &stmtCtx,314                      Fortran::lower::SymMap &symMap,315                      fir::SequenceType declaredType,316                      std::optional<mlir::Value> extent,317                      llvm::ArrayRef<mlir::Value> lengths,318                      bool missingLengthParameters)319      : StrategyBase{stmtCtx, symMap},320        arrayConstructorElementType{declaredType.getEleTy()} {321    mlir::Type heapType = fir::HeapType::get(declaredType);322    mlir::Type boxType = fir::BoxType::get(heapType);323    allocatableTemp = builder.createTemporary(loc, boxType, tempName);324    mlir::Value initialBoxValue;325    if (extent && !missingLengthParameters) {326      llvm::SmallVector<mlir::Value, 1> extents{*extent};327      mlir::Value tempStorage = builder.createHeapTemporary(328          loc, declaredType, tempName, extents, lengths);329      mlir::Value shape = builder.genShape(loc, extents);330      declare = hlfir::DeclareOp::create(builder, loc, tempStorage, tempName,331                                         shape, lengths);332      initialBoxValue =333          builder.createBox(loc, boxType, declare->getOriginalBase(), shape,334                            /*slice=*/mlir::Value{}, lengths, /*tdesc=*/{});335    } else {336      // The runtime will have to do the initial allocation.337      // The declare operation cannot be emitted in this case since the final338      // array constructor has not yet been allocated. Instead, the resulting339      // temporary variable will be extracted from the allocatable descriptor340      // after all the API calls.341      // Prepare the initial state of the allocatable descriptor with a342      // deallocated status and all the available knowledge about the extent343      // and length parameters.344      llvm::SmallVector<mlir::Value> emboxLengths(lengths);345      if (!extent)346        extent = builder.createIntegerConstant(loc, builder.getIndexType(), 0);347      if (missingLengthParameters) {348        if (mlir::isa<fir::CharacterType>(declaredType.getEleTy()))349          emboxLengths.push_back(builder.createIntegerConstant(350              loc, builder.getCharacterLengthType(), 0));351        else352          TODO(loc,353               "parametrized derived type array constructor without type-spec");354      }355      mlir::Value nullAddr = builder.createNullConstant(loc, heapType);356      mlir::Value shape = builder.genShape(loc, {*extent});357      initialBoxValue = builder.createBox(loc, boxType, nullAddr, shape,358                                          /*slice=*/mlir::Value{}, emboxLengths,359                                          /*tdesc=*/{});360    }361    fir::StoreOp::create(builder, loc, initialBoxValue, allocatableTemp);362    arrayConstructorVector = fir::runtime::genInitArrayConstructorVector(363        loc, builder, allocatableTemp,364        builder.createBool(loc, missingLengthParameters));365  }366 367  bool useSimplePushRuntime(hlfir::Entity value) {368    return value.isScalar() &&369           !mlir::isa<fir::CharacterType>(arrayConstructorElementType) &&370           !fir::isRecordWithAllocatableMember(arrayConstructorElementType) &&371           !fir::isRecordWithTypeParameters(arrayConstructorElementType);372  }373 374  /// Push a lowered ac-value into the array constructor vector using375  /// the runtime API.376  void pushValue(mlir::Location loc, fir::FirOpBuilder &builder,377                 hlfir::Entity value) {378    if (useSimplePushRuntime(value)) {379      auto [addrExv, cleanUp] = hlfir::convertToAddress(380          loc, builder, value, arrayConstructorElementType);381      mlir::Value addr = fir::getBase(addrExv);382      if (mlir::isa<fir::BaseBoxType>(addr.getType()))383        addr = fir::BoxAddrOp::create(builder, loc, addr);384      fir::runtime::genPushArrayConstructorSimpleScalar(385          loc, builder, arrayConstructorVector, addr);386      if (cleanUp)387        (*cleanUp)();388      return;389    }390    auto [boxExv, cleanUp] =391        hlfir::convertToBox(loc, builder, value, arrayConstructorElementType);392    fir::runtime::genPushArrayConstructorValue(393        loc, builder, arrayConstructorVector, fir::getBase(boxExv));394    if (cleanUp)395      (*cleanUp)();396  }397 398  /// Start a fir.do_loop with the control from an implied-do and return399  /// the loop induction variable that is the ac-do-variable value.400  mlir::Value startImpliedDo(mlir::Location loc, fir::FirOpBuilder &builder,401                             mlir::Value lower, mlir::Value upper,402                             mlir::Value stride) {403    auto loop = fir::DoLoopOp::create(builder, loc, lower, upper, stride,404                                      /*unordered=*/false,405                                      /*finalCount=*/false);406    builder.setInsertionPointToStart(loop.getBody());407    return loop.getInductionVar();408  }409 410  /// Move the temporary to an hlfir.expr value (array constructors are not411  /// variables and cannot be further modified).412  hlfir::Entity finishArrayCtorLowering(mlir::Location loc,413                                        fir::FirOpBuilder &builder) {414    // Temp is created using createHeapTemporary, or allocated on the heap415    // by the runtime.416    mlir::Value mustFree = builder.createBool(loc, true);417    mlir::Value temp;418    if (declare)419      temp = declare->getBase();420    else421      temp = hlfir::derefPointersAndAllocatables(422          loc, builder, hlfir::Entity{allocatableTemp});423    auto hlfirExpr = hlfir::AsExprOp::create(builder, loc, temp, mustFree);424    return hlfir::Entity{hlfirExpr};425  }426 427private:428  /// Element type of the array constructor being built.429  mlir::Type arrayConstructorElementType;430  /// Allocatable descriptor for the storage of the array constructor being431  /// built.432  mlir::Value allocatableTemp;433  /// Structure that allows the runtime API to maintain the status of434  /// of the array constructor being built between two API calls.435  mlir::Value arrayConstructorVector;436  /// DeclareOp for the array constructor storage, if it was possible to437  /// allocate it before any API calls.438  std::optional<hlfir::DeclareOp> declare;439};440 441/// Wrapper class that dispatch to the selected array constructor lowering442/// strategy and does nothing else.443class ArrayCtorLoweringStrategy {444public:445  template <typename A>446  ArrayCtorLoweringStrategy(A &&impl) : implVariant{std::forward<A>(impl)} {}447 448  void pushValue(mlir::Location loc, fir::FirOpBuilder &builder,449                 hlfir::Entity value) {450    return Fortran::common::visit(451        [&](auto &impl) { return impl.pushValue(loc, builder, value); },452        implVariant);453  }454 455  mlir::Value startImpliedDo(mlir::Location loc, fir::FirOpBuilder &builder,456                             mlir::Value lower, mlir::Value upper,457                             mlir::Value stride) {458    return Fortran::common::visit(459        [&](auto &impl) {460          return impl.startImpliedDo(loc, builder, lower, upper, stride);461        },462        implVariant);463  }464 465  hlfir::Entity finishArrayCtorLowering(mlir::Location loc,466                                        fir::FirOpBuilder &builder) {467    return Fortran::common::visit(468        [&](auto &impl) { return impl.finishArrayCtorLowering(loc, builder); },469        implVariant);470  }471 472  void startImpliedDoScope(llvm::StringRef doName, mlir::Value indexValue) {473    Fortran::common::visit(474        [&](auto &impl) {475          return impl.startImpliedDoScope(doName, indexValue);476        },477        implVariant);478  }479 480  void endImpliedDoScope() {481    Fortran::common::visit([&](auto &impl) { return impl.endImpliedDoScope(); },482                           implVariant);483  }484 485private:486  std::variant<InlinedTempStrategy, LooplessInlinedTempStrategy,487               AsElementalStrategy, RuntimeTempStrategy>488      implVariant;489};490} // namespace491 492//===----------------------------------------------------------------------===//493//   Definition of selectArrayCtorLoweringStrategy and its helpers.494//   This is the code that analyses the evaluate::ArrayConstructor<T>,495//   pre-lowers the array constructor extent and length parameters if it can,496//   and chooses the lowering strategy.497//===----------------------------------------------------------------------===//498 499/// Helper to lower a scalar extent expression (like implied-do bounds).500static mlir::Value lowerExtentExpr(mlir::Location loc,501                                   Fortran::lower::AbstractConverter &converter,502                                   Fortran::lower::SymMap &symMap,503                                   Fortran::lower::StatementContext &stmtCtx,504                                   const Fortran::evaluate::ExtentExpr &expr) {505  fir::FirOpBuilder &builder = converter.getFirOpBuilder();506  mlir::IndexType idxTy = builder.getIndexType();507  hlfir::Entity value = Fortran::lower::convertExprToHLFIR(508      loc, converter, toEvExpr(expr), symMap, stmtCtx);509  value = hlfir::loadTrivialScalar(loc, builder, value);510  return builder.createConvert(loc, idxTy, value);511}512 513namespace {514/// Helper class to lower the array constructor type and its length parameters.515/// The length parameters, if any, are only lowered if this does not require516/// evaluating an ac-value.517template <typename T>518struct LengthAndTypeCollector {519  static mlir::Type collect(mlir::Location,520                            Fortran::lower::AbstractConverter &converter,521                            const Fortran::evaluate::ArrayConstructor<T> &,522                            Fortran::lower::SymMap &,523                            Fortran::lower::StatementContext &,524                            mlir::SmallVectorImpl<mlir::Value> &) {525    // Numerical and Logical types.526    return Fortran::lower::getFIRType(&converter.getMLIRContext(), T::category,527                                      T::kind, /*lenParams*/ {});528  }529};530 531template <>532struct LengthAndTypeCollector<Fortran::evaluate::SomeDerived> {533  static mlir::Type collect(534      mlir::Location loc, Fortran::lower::AbstractConverter &converter,535      const Fortran::evaluate::ArrayConstructor<Fortran::evaluate::SomeDerived>536          &arrayCtorExpr,537      Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,538      mlir::SmallVectorImpl<mlir::Value> &lengths) {539    // Array constructors cannot be unlimited polymorphic (C7113), so there must540    // be a derived type spec available.541    return Fortran::lower::translateDerivedTypeToFIRType(542        converter, arrayCtorExpr.result().derivedTypeSpec());543  }544};545 546template <int Kind>547using Character =548    Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, Kind>;549template <int Kind>550struct LengthAndTypeCollector<Character<Kind>> {551  static mlir::Type collect(552      mlir::Location loc, Fortran::lower::AbstractConverter &converter,553      const Fortran::evaluate::ArrayConstructor<Character<Kind>> &arrayCtorExpr,554      Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,555      mlir::SmallVectorImpl<mlir::Value> &lengths) {556    llvm::SmallVector<Fortran::lower::LenParameterTy> typeLengths;557    if (const Fortran::evaluate::ExtentExpr *lenExpr = arrayCtorExpr.LEN()) {558      lengths.push_back(559          lowerExtentExpr(loc, converter, symMap, stmtCtx, *lenExpr));560      if (std::optional<std::int64_t> cstLen =561              Fortran::evaluate::ToInt64(*lenExpr))562        typeLengths.push_back(*cstLen);563    }564    return Fortran::lower::getFIRType(&converter.getMLIRContext(),565                                      Fortran::common::TypeCategory::Character,566                                      Kind, typeLengths);567  }568};569} // namespace570 571/// Does the array constructor have length parameters that572/// LengthAndTypeCollector::collect could not lower because this requires573/// lowering an ac-value and must be delayed?574static bool missingLengthParameters(mlir::Type elementType,575                                    llvm::ArrayRef<mlir::Value> lengths) {576  return (mlir::isa<fir::CharacterType>(elementType) ||577          fir::isRecordWithTypeParameters(elementType)) &&578         lengths.empty();579}580 581namespace {582/// Structure that analyses the ac-value and implied-do of583/// evaluate::ArrayConstructor before they are lowered. It does not generate any584/// IR. The result of this analysis pass is used to select the lowering585/// strategy.586struct ArrayCtorAnalysis {587  template <typename T>588  ArrayCtorAnalysis(589      Fortran::evaluate::FoldingContext &,590      const Fortran::evaluate::ArrayConstructor<T> &arrayCtorExpr);591 592  // Can the array constructor easily be rewritten into an hlfir.elemental ?593  bool isSingleImpliedDoWithOneScalarPureExpr() const {594    return !anyArrayExpr && isPerfectLoopNest &&595           innerNumberOfExprIfPrefectNest == 1 && depthIfPerfectLoopNest == 1 &&596           innerExprIsPureIfPerfectNest;597  }598 599  bool anyImpliedDo = false;600  bool anyArrayExpr = false;601  bool isPerfectLoopNest = true;602  bool innerExprIsPureIfPerfectNest = false;603  std::int64_t innerNumberOfExprIfPrefectNest = 0;604  std::int64_t depthIfPerfectLoopNest = 0;605};606} // namespace607 608template <typename T>609ArrayCtorAnalysis::ArrayCtorAnalysis(610    Fortran::evaluate::FoldingContext &foldingContext,611    const Fortran::evaluate::ArrayConstructor<T> &arrayCtorExpr) {612  llvm::SmallVector<const Fortran::evaluate::ArrayConstructorValues<T> *>613      arrayValueListStack{&arrayCtorExpr};614  // Loop through the ac-value-list(s) of the array constructor.615  while (!arrayValueListStack.empty()) {616    std::int64_t localNumberOfImpliedDo = 0;617    std::int64_t localNumberOfExpr = 0;618    // Loop though the ac-value of an ac-value list, and add any nested619    // ac-value-list of ac-implied-do to the stack.620    const Fortran::evaluate::ArrayConstructorValues<T> *currentArrayValueList =621        arrayValueListStack.pop_back_val();622    for (const Fortran::evaluate::ArrayConstructorValue<T> &acValue :623         *currentArrayValueList)624      Fortran::common::visit(625          Fortran::common::visitors{626              [&](const Fortran::evaluate::ImpliedDo<T> &impledDo) {627                arrayValueListStack.push_back(&impledDo.values());628                localNumberOfImpliedDo++;629              },630              [&](const Fortran::evaluate::Expr<T> &expr) {631                localNumberOfExpr++;632                anyArrayExpr = anyArrayExpr || expr.Rank() > 0;633              }},634          acValue.u);635    anyImpliedDo = anyImpliedDo || localNumberOfImpliedDo > 0;636 637    if (localNumberOfImpliedDo == 0) {638      // Leaf ac-value-list in the array constructor ac-value tree.639      if (isPerfectLoopNest) {640        // This this the only leaf of the array-constructor (the array641        // constructor is a nest of single implied-do with a list of expression642        // in the last deeper implied do). e.g: "[((i+j, i=1,n)j=1,m)]".643        innerNumberOfExprIfPrefectNest = localNumberOfExpr;644        if (localNumberOfExpr == 1)645          innerExprIsPureIfPerfectNest = !Fortran::evaluate::FindImpureCall(646              foldingContext, toEvExpr(std::get<Fortran::evaluate::Expr<T>>(647                                  currentArrayValueList->begin()->u)));648      }649    } else if (localNumberOfImpliedDo == 1 && localNumberOfExpr == 0) {650      // Perfect implied-do nest new level.651      ++depthIfPerfectLoopNest;652    } else {653      // More than one implied-do, or at least one implied-do and an expr654      // at that level. This will not form a perfect nest. Examples:655      // "[a, (i, i=1,n)]" or "[(i, i=1,n), (j, j=1,m)]".656      isPerfectLoopNest = false;657    }658  }659}660 661/// Does \p expr contain no calls to user function?662static bool isCallFreeExpr(const Fortran::evaluate::ExtentExpr &expr) {663  for (const Fortran::semantics::Symbol &symbol :664       Fortran::evaluate::CollectSymbols(expr))665    if (Fortran::semantics::IsProcedure(symbol))666      return false;667  return true;668}669 670/// Core function that pre-lowers the extent and length parameters of671/// array constructors if it can, runs the ac-value analysis and672/// select the lowering strategy accordingly.673template <typename T>674static ArrayCtorLoweringStrategy selectArrayCtorLoweringStrategy(675    mlir::Location loc, Fortran::lower::AbstractConverter &converter,676    const Fortran::evaluate::ArrayConstructor<T> &arrayCtorExpr,677    Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {678  fir::FirOpBuilder &builder = converter.getFirOpBuilder();679  mlir::Type idxType = builder.getIndexType();680  // Try to gather the array constructor extent.681  mlir::Value extent;682  fir::SequenceType::Extent typeExtent = fir::SequenceType::getUnknownExtent();683  auto shapeExpr = Fortran::evaluate::GetContextFreeShape(684      converter.getFoldingContext(), arrayCtorExpr);685  if (shapeExpr && shapeExpr->size() == 1 && (*shapeExpr)[0]) {686    const Fortran::evaluate::ExtentExpr &extentExpr = *(*shapeExpr)[0];687    if (auto constantExtent = Fortran::evaluate::ToInt64(extentExpr)) {688      typeExtent = *constantExtent;689      extent = builder.createIntegerConstant(loc, idxType, typeExtent);690    } else if (isCallFreeExpr(extentExpr)) {691      // The expression built by expression analysis for the array constructor692      // extent does not contain procedure symbols. It is side effect free.693      // This could be relaxed to allow pure procedure, but some care must694      // be taken to not bring in "unmapped" symbols from callee scopes.695      extent = lowerExtentExpr(loc, converter, symMap, stmtCtx, extentExpr);696    }697    // Otherwise, the temporary will have to be built step by step with698    // reallocation and the extent will only be known at the end of the array699    // constructor evaluation.700  }701  // Convert the array constructor type and try to gather its length parameter702  // values, if any.703  mlir::SmallVector<mlir::Value> lengths;704  mlir::Type elementType = LengthAndTypeCollector<T>::collect(705      loc, converter, arrayCtorExpr, symMap, stmtCtx, lengths);706  // Run an analysis of the array constructor ac-value.707  ArrayCtorAnalysis analysis(converter.getFoldingContext(), arrayCtorExpr);708  bool needToEvaluateOneExprToGetLengthParameters =709      missingLengthParameters(elementType, lengths);710  auto declaredType = fir::SequenceType::get({typeExtent}, elementType);711 712  // Based on what was gathered and the result of the analysis, select and713  // instantiate the right lowering strategy for the array constructor.714  if (!extent || needToEvaluateOneExprToGetLengthParameters ||715      analysis.anyArrayExpr ||716      mlir::isa<fir::RecordType>(declaredType.getEleTy()))717    return RuntimeTempStrategy(718        loc, builder, stmtCtx, symMap, declaredType,719        extent ? std::optional<mlir::Value>(extent) : std::nullopt, lengths,720        needToEvaluateOneExprToGetLengthParameters);721  // Note: the generated hlfir.elemental is always unordered, thus,722  // AsElementalStrategy can only be used for array constructors without723  // impure ac-value expressions. If/when this changes, make sure724  // the 'unordered' attribute is set accordingly for the hlfir.elemental.725  if (analysis.isSingleImpliedDoWithOneScalarPureExpr())726    return AsElementalStrategy(loc, builder, stmtCtx, symMap, declaredType,727                               extent, lengths);728 729  if (analysis.anyImpliedDo)730    return InlinedTempStrategy(loc, builder, stmtCtx, symMap, declaredType,731                               extent, lengths);732 733  return LooplessInlinedTempStrategy(loc, builder, stmtCtx, symMap,734                                     declaredType, extent, lengths);735}736 737/// Lower an ac-value expression \p expr and forward it to the selected738/// lowering strategy \p arrayBuilder,739template <typename T>740static void genAcValue(mlir::Location loc,741                       Fortran::lower::AbstractConverter &converter,742                       const Fortran::evaluate::Expr<T> &expr,743                       Fortran::lower::SymMap &symMap,744                       Fortran::lower::StatementContext &stmtCtx,745                       ArrayCtorLoweringStrategy &arrayBuilder) {746  // TODO: get rid of the toEvExpr indirection.747  fir::FirOpBuilder &builder = converter.getFirOpBuilder();748  hlfir::Entity value = Fortran::lower::convertExprToHLFIR(749      loc, converter, toEvExpr(expr), symMap, stmtCtx);750  value = hlfir::loadTrivialScalar(loc, builder, value);751  arrayBuilder.pushValue(loc, builder, value);752}753 754/// Lowers an ac-value implied-do \p impledDo according to the selected755/// lowering strategy \p arrayBuilder.756template <typename T>757static void genAcValue(mlir::Location loc,758                       Fortran::lower::AbstractConverter &converter,759                       const Fortran::evaluate::ImpliedDo<T> &impledDo,760                       Fortran::lower::SymMap &symMap,761                       Fortran::lower::StatementContext &stmtCtx,762                       ArrayCtorLoweringStrategy &arrayBuilder) {763  auto lowerIndex =764      [&](const Fortran::evaluate::ExtentExpr expr) -> mlir::Value {765    return lowerExtentExpr(loc, converter, symMap, stmtCtx, expr);766  };767  mlir::Value lower = lowerIndex(impledDo.lower());768  mlir::Value upper = lowerIndex(impledDo.upper());769  mlir::Value stride = lowerIndex(impledDo.stride());770  fir::FirOpBuilder &builder = converter.getFirOpBuilder();771  mlir::OpBuilder::InsertPoint insertPt = builder.saveInsertionPoint();772  mlir::Value impliedDoIndexValue =773      arrayBuilder.startImpliedDo(loc, builder, lower, upper, stride);774  arrayBuilder.startImpliedDoScope(toStringRef(impledDo.name()),775                                   impliedDoIndexValue);776 777  for (const auto &acValue : impledDo.values())778    Fortran::common::visit(779        [&](const auto &x) {780          genAcValue(loc, converter, x, symMap, stmtCtx, arrayBuilder);781        },782        acValue.u);783 784  arrayBuilder.endImpliedDoScope();785  builder.restoreInsertionPoint(insertPt);786}787 788/// Entry point for evaluate::ArrayConstructor lowering.789template <typename T>790hlfir::EntityWithAttributes Fortran::lower::ArrayConstructorBuilder<T>::gen(791    mlir::Location loc, Fortran::lower::AbstractConverter &converter,792    const Fortran::evaluate::ArrayConstructor<T> &arrayCtorExpr,793    Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {794  fir::FirOpBuilder &builder = converter.getFirOpBuilder();795 796  // Array constructors inside a where-assignment-stmt must be executed797  // exactly once without mask control, per Fortran 2023 section 10.2.3.2.798  // Lower them in a special region so that this can be enforced when799  // scheduling forall/where expression evaluations.800  if (isInWhereMaskedExpression(builder) &&801      !builder.getRegion().getParentOfType<hlfir::ExactlyOnceOp>()) {802    Fortran::lower::StatementContext localStmtCtx;803    mlir::Type bogusType = builder.getIndexType();804    auto exactlyOnce = hlfir::ExactlyOnceOp::create(builder, loc, bogusType);805    mlir::Block *block = builder.createBlock(&exactlyOnce.getBody());806    builder.setInsertionPointToStart(block);807 808    // Recursively generate the array constructor inside the exactly_once region809    hlfir::EntityWithAttributes res = ArrayConstructorBuilder<T>::gen(810        loc, converter, arrayCtorExpr, symMap, localStmtCtx);811 812    auto yield = hlfir::YieldOp::create(builder, loc, res);813    Fortran::lower::genCleanUpInRegionIfAny(loc, builder, yield.getCleanup(),814                                            localStmtCtx);815    builder.setInsertionPointAfter(exactlyOnce);816    exactlyOnce->getResult(0).setType(res.getType());817 818    if (hlfir::isFortranValue(exactlyOnce.getResult()))819      return hlfir::EntityWithAttributes{exactlyOnce.getResult()};820 821    // Create hlfir.declare for the result to satisfy822    // hlfir::EntityWithAttributes requirements.823    auto [exv, cleanup] = hlfir::translateToExtendedValue(824        loc, builder, hlfir::Entity{exactlyOnce});825    assert(!cleanup && "result is a variable");826    return hlfir::genDeclare(loc, builder, exv, ".arrayctor.result",827                             fir::FortranVariableFlagsAttr{});828  }829 830  // Select the lowering strategy given the array constructor.831  auto arrayBuilder = selectArrayCtorLoweringStrategy(832      loc, converter, arrayCtorExpr, symMap, stmtCtx);833  // Run the array lowering strategy through the ac-values.834  for (const auto &acValue : arrayCtorExpr)835    Fortran::common::visit(836        [&](const auto &x) {837          genAcValue(loc, converter, x, symMap, stmtCtx, arrayBuilder);838        },839        acValue.u);840  hlfir::Entity hlfirExpr = arrayBuilder.finishArrayCtorLowering(loc, builder);841  // Insert the clean-up for the created hlfir.expr.842  fir::FirOpBuilder *bldr = &builder;843  stmtCtx.attachCleanup(844      [=]() { hlfir::DestroyOp::create(*bldr, loc, hlfirExpr); });845  return hlfir::EntityWithAttributes{hlfirExpr};846}847 848using namespace Fortran::evaluate;849using namespace Fortran::common;850FOR_EACH_SPECIFIC_TYPE(template class Fortran::lower::ArrayConstructorBuilder, )851