[flang][hlfir][NFC] refactor transformational intrinsic lowering

[tblah]

Summary

The old code had overgrown itself and become difficult to read and
modify. I've rewritten it and moved it into its own translation unit.

I moved PreparedActualArgument to the header file for the
transformational intrinsic lowering. Logically, it belongs in
ConvertCall.h, but putting it there would create a circular dependency
between HlfirIntrinsics and ConvertCall.

[vzakhari]

Thank you, @tblah!
I might have missed something, but this looks like an NFC - is it?

flang/include/flang/Lower/HlfirIntrinsics.h

87

nit: please add newline

flang/lib/Lower/HlfirIntrinsics.cpp

2

nit: please concat with the previous line

298

nit: please add newline

[cabreraam]

flang/include/flang/Lower/HlfirIntrinsics.h

87

When I've tried to add newlines to the end of files, the buildbot will fail it's pre-merge check because of clang-format. Am I missing something?

[tblah]

Fix opening comment split over two lines

[tblah]

flang/include/flang/Lower/HlfirIntrinsics.h

87

Yes clang-format just removed the newline again after I added it.

[vzakhari]

Thank you for the follow-ups.

flang/include/flang/Lower/HlfirIntrinsics.h

18

Sorry, I missed it before and it is probably not that important right now: you may want to guard the file content with ifndef FORTRAN_LOWER_....

[tblah]

Add include guards

[vzakhari]

flang/include/flang/Lower/HlfirIntrinsics.h

91

nit: typo in // FORTRAN_LOWER_HLFIRINTRINAICS_H

[tblah]

In D154235#4468721, @vzakhari wrote:

Thank you for the follow-ups.

Doh! Thanks for catching this

[tblah]

flang/include/flang/Lower/HlfirIntrinsics.h

91

Thanks, I'll fix this before merging

flang/include/flang/Lower/HlfirIntrinsics.h

+//===-- HlfirIntrinsics.h -- lowering to HLFIR intrinsic ops ----*- 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/
+//
+//===----------------------------------------------------------------------===//
+///
+/// Implements lowering of transformational intrinsics to HLFIR intrinsic
+/// operations
+///
+//===----------------------------------------------------------------------===//
+
+#include "flang/Optimizer/Builder/HLFIRTools.h"
+#include "llvm/ADT/SmallVector.h"
+#include <cassert>
+#include <optional>
+#include <string>
+
+namespace mlir {
+class Location;
+class Type;
+class Value;
+class ValueRange;
+} // namespace mlir
+
+namespace fir {
+class FirOpBuilder;
+struct IntrinsicArgumentLoweringRules;
+} // namespace fir
+
+namespace Fortran::lower {
+
+/// This structure holds the initial lowered value of an actual argument that
+/// was lowered regardless of the interface, and it holds whether or not it
+/// may be absent at runtime and the dummy is optional.
+struct PreparedActualArgument {
+
+  PreparedActualArgument(hlfir::Entity actual,
+                         std::optional<mlir::Value> isPresent)
+      : actual{actual}, isPresent{isPresent} {}
+  void setElementalIndices(mlir::ValueRange &indices) {
+    oneBasedElementalIndices = &indices;
+  }
+  hlfir::Entity getActual(mlir::Location loc,
+                          fir::FirOpBuilder &builder) const {
+    if (oneBasedElementalIndices)
+      return hlfir::getElementAt(loc, builder, actual,
+                                 *oneBasedElementalIndices);
+    return actual;
+  }
+  hlfir::Entity getOriginalActual() const { return actual; }
+  void setOriginalActual(hlfir::Entity newActual) { actual = newActual; }
+  bool handleDynamicOptional() const { return isPresent.has_value(); }
+  mlir::Value getIsPresent() const {
+    assert(handleDynamicOptional() && "not a dynamic optional");
+    return *isPresent;
+  }
+
+  void resetOptionalAspect() { isPresent = std::nullopt; }
+
+private:
+  hlfir::Entity actual;
+  mlir::ValueRange *oneBasedElementalIndices{nullptr};
+  // When the actual may be dynamically optional, "isPresent"
+  // holds a boolean value indicating the presence of the
+  // actual argument at runtime.
+  std::optional<mlir::Value> isPresent;
+};
+
+/// Vector of pre-lowered actual arguments. nullopt if the actual is
+/// "statically" absent (if it was not syntactically  provided).
+using PreparedActualArguments =
+    llvm::SmallVector<std::optional<PreparedActualArgument>>;
+
+std::optional<hlfir::EntityWithAttributes> lowerHlfirIntrinsic(
+    fir::FirOpBuilder &builder, mlir::Location loc, const std::string &name,
+    const Fortran::lower::PreparedActualArguments &loweredActuals,
+    const fir::IntrinsicArgumentLoweringRules *argLowering,
+    mlir::Type stmtResultType);
+
+} // namespace Fortran::lower
 No newline at end of file

flang/lib/Lower/CMakeLists.txt

 get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
 get_property(extension_libs GLOBAL PROPERTY MLIR_EXTENSION_LIBS)
 
 add_flang_library(FortranLower
   Allocatable.cpp
   Bridge.cpp
   CallInterface.cpp
   Coarray.cpp
+  ComponentPath.cpp
   ConvertArrayConstructor.cpp
   ConvertCall.cpp
   ConvertConstant.cpp
   ConvertExpr.cpp
   ConvertExprToHLFIR.cpp
   ConvertProcedureDesignator.cpp
   ConvertType.cpp
   ConvertVariable.cpp
-  ComponentPath.cpp
   CustomIntrinsicCall.cpp
   DumpEvaluateExpr.cpp
+  HlfirIntrinsics.cpp
   HostAssociations.cpp
   IO.cpp
   IterationSpace.cpp
   LoweringOptions.cpp
   Mangler.cpp
   OpenACC.cpp
   OpenMP.cpp
   PFTBuilder.cpp

flang/lib/Lower/ConvertCall.cpp

 //===-- ConvertCall.cpp ---------------------------------------------------===//
 //
 // 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/
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/ConvertCall.h"
 #include "flang/Lower/ConvertExprToHLFIR.h"
 #include "flang/Lower/ConvertVariable.h"
 #include "flang/Lower/CustomIntrinsicCall.h"
+#include "flang/Lower/HlfirIntrinsics.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Optimizer/Builder/BoxValue.h"
 #include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/HLFIRTools.h"
 #include "flang/Optimizer/Builder/IntrinsicCall.h"
 #include "flang/Optimizer/Builder/LowLevelIntrinsics.h"
struct CallContext {
 
   const Fortran::evaluate::ProcedureRef &procRef;
   Fortran::lower::AbstractConverter &converter;
   Fortran::lower::SymMap &symMap;
   Fortran::lower::StatementContext &stmtCtx;
   std::optional<mlir::Type> resultType;
   mlir::Location loc;
 };
-
-/// This structure holds the initial lowered value of an actual argument that
-/// was lowered regardless of the interface, and it holds whether or not it
-/// may be absent at runtime and the dummy is optional.
-struct PreparedActualArgument {
-
-  PreparedActualArgument(hlfir::Entity actual,
-                         std::optional<mlir::Value> isPresent)
-      : actual{actual}, isPresent{isPresent} {}
-  void setElementalIndices(mlir::ValueRange &indices) {
-    oneBasedElementalIndices = &indices;
-  }
-  hlfir::Entity getActual(mlir::Location loc,
-                          fir::FirOpBuilder &builder) const {
-    if (oneBasedElementalIndices)
-      return hlfir::getElementAt(loc, builder, actual,
-                                 *oneBasedElementalIndices);
-    return actual;
-  }
-  hlfir::Entity getOriginalActual() const { return actual; }
-  void setOriginalActual(hlfir::Entity newActual) { actual = newActual; }
-  bool handleDynamicOptional() const { return isPresent.has_value(); }
-  mlir::Value getIsPresent() const {
-    assert(handleDynamicOptional() && "not a dynamic optional");
-    return *isPresent;
-  }
-
-  void resetOptionalAspect() { isPresent = std::nullopt; }
-
-private:
-  hlfir::Entity actual;
-  mlir::ValueRange *oneBasedElementalIndices{nullptr};
-  // When the actual may be dynamically optional, "isPresent"
-  // holds a boolean value indicating the presence of the
-  // actual argument at runtime.
-  std::optional<mlir::Value> isPresent;
-};
 } // namespace
 
-/// Vector of pre-lowered actual arguments. nullopt if the actual is
-/// "statically" absent (if it was not syntactically  provided).
-using PreparedActualArguments =
-    llvm::SmallVector<std::optional<PreparedActualArgument>>;
-
 // Helper to transform a fir::ExtendedValue to an hlfir::EntityWithAttributes.
 static hlfir::EntityWithAttributes
 extendedValueToHlfirEntity(mlir::Location loc, fir::FirOpBuilder &builder,
                            const fir::ExtendedValue &exv,
                            llvm::StringRef name) {
   mlir::Value firBase = fir::getBase(exv);
   mlir::Type firBaseTy = firBase.getType();
   if (fir::isa_trivial(firBaseTy))

 /// - copy-in into contiguous variable if the dummy must be contiguous
 /// - copy into a temporary if the dummy has the VALUE attribute.
 /// - package the prepared dummy as required (fir.box, fir.class,
 ///   fir.box_char...).
 /// This function should only be called with an actual that is present.
 /// The optional aspects must be handled by this function user.
 static PreparedDummyArgument preparePresentUserCallActualArgument(
     mlir::Location loc, fir::FirOpBuilder &builder,
-    const PreparedActualArgument &preparedActual, mlir::Type dummyType,
+    const Fortran::lower::PreparedActualArgument &preparedActual,
+    mlir::Type dummyType,
     const Fortran::lower::CallerInterface::PassedEntity &arg,
     const Fortran::lower::SomeExpr &expr,
     Fortran::lower::AbstractConverter &converter) {
 
   Fortran::evaluate::FoldingContext &foldingContext =
       converter.getFoldingContext();
 
   // Step 1: get the actual argument, which includes addressing the
static PreparedDummyArgument preparePresentUserCallActualArgument(
   return preparedDummy;
 }
 
 /// When dummy is not ALLOCATABLE, POINTER and is not passed in register,
 /// prepare the actual argument according to the interface, taking care
 /// of any optional aspect.
 static PreparedDummyArgument prepareUserCallActualArgument(
     mlir::Location loc, fir::FirOpBuilder &builder,
-    const PreparedActualArgument &preparedActual, mlir::Type dummyType,
+    const Fortran::lower::PreparedActualArgument &preparedActual,
+    mlir::Type dummyType,
     const Fortran::lower::CallerInterface::PassedEntity &arg,
     const Fortran::lower::SomeExpr &expr,
     Fortran::lower::AbstractConverter &converter) {
   if (!preparedActual.handleDynamicOptional())
     return preparePresentUserCallActualArgument(
         loc, builder, preparedActual, dummyType, arg, expr, converter);
 
   // Conditional dummy argument preparation. The actual may be absent

 
 /// Lower calls to user procedures with actual arguments that have been
 /// pre-lowered but not yet prepared according to the interface.
 /// This can be called for elemental procedures, but only with scalar
 /// arguments: if there are array arguments, it must be provided with
 /// the array argument elements value and will return the corresponding
 /// scalar result value.
 static std::optional<hlfir::EntityWithAttributes>
-genUserCall(PreparedActualArguments &loweredActuals,
+genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
             Fortran::lower::CallerInterface &caller,
             mlir::FunctionType callSiteType, CallContext &callContext) {
   using PassBy = Fortran::lower::CallerInterface::PassEntityBy;
   mlir::Location loc = callContext.loc;
   fir::FirOpBuilder &builder = callContext.getBuilder();
   llvm::SmallVector<CallCleanUp> callCleanUps;
   for (auto [preparedActual, arg] :
        llvm::zip(loweredActuals, caller.getPassedArguments())) {
if (!fir::getBase(result))
     return std::nullopt; // subroutine call.
   // TODO: "move" non pointer results into hlfir.expr.
   return extendedValueToHlfirEntity(loc, builder, result, ".tmp.func_result");
 }
 
 /// Lower calls to intrinsic procedures with actual arguments that have been
 /// pre-lowered but have not yet been prepared according to the interface.
 static std::optional<hlfir::EntityWithAttributes>
-genIntrinsicRefCore(PreparedActualArguments &loweredActuals,
+genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
                     const Fortran::evaluate::SpecificIntrinsic *intrinsic,
                     const fir::IntrinsicArgumentLoweringRules *argLowering,
                     CallContext &callContext) {
   llvm::SmallVector<fir::ExtendedValue> operands;
   auto &stmtCtx = callContext.stmtCtx;
   auto &converter = callContext.converter;
   fir::FirOpBuilder &builder = callContext.getBuilder();
   mlir::Location loc = callContext.loc;
else
           loc, resultEntity, builder.createBool(loc, mustBeFreed));
     resultEntity = hlfir::EntityWithAttributes{asExpr.getResult()};
   }
   return resultEntity;
 }
 
 /// Lower calls to intrinsic procedures with actual arguments that have been
 /// pre-lowered but have not yet been prepared according to the interface.
-static std::optional<hlfir::EntityWithAttributes>
-genHLFIRIntrinsicRefCore(PreparedActualArguments &loweredActuals,
-                         const Fortran::evaluate::SpecificIntrinsic *intrinsic,
-                         const fir::IntrinsicArgumentLoweringRules *argLowering,
-                         CallContext &callContext) {
+static std::optional<hlfir::EntityWithAttributes> genHLFIRIntrinsicRefCore(
+    Fortran::lower::PreparedActualArguments &loweredActuals,
   if (!useHlfirIntrinsicOps)
     return genIntrinsicRefCore(loweredActuals, intrinsic, argLowering,
                                callContext);
 
   fir::FirOpBuilder &builder = callContext.getBuilder();
   mlir::Location loc = callContext.loc;
-
-  auto getOperandVector = [&](PreparedActualArguments &loweredActuals) {
-    llvm::SmallVector<mlir::Value> operands;
-    operands.reserve(loweredActuals.size());
-
-    for (size_t i = 0; i < loweredActuals.size(); ++i) {
-      std::optional<PreparedActualArgument> arg = loweredActuals[i];
-      if (!arg) {
-        operands.emplace_back();
-        continue;
-      }
-      hlfir::Entity actual = arg->getOriginalActual();
-      mlir::Value valArg;
-
-      // if intrinsic handler has no lowering rules
-      if (!argLowering) {
-        valArg = hlfir::loadTrivialScalar(loc, builder, actual);
-      } else {
-        fir::ArgLoweringRule argRules =
-            fir::lowerIntrinsicArgumentAs(*argLowering, i);
-        if (!argRules.handleDynamicOptional &&
-            argRules.lowerAs != fir::LowerIntrinsicArgAs::Inquired)
-          valArg = hlfir::derefPointersAndAllocatables(loc, builder, actual);
-        else
-          valArg = actual.getBase();
-      }
-
-      operands.emplace_back(valArg);
-    }
-    return operands;
-  };
-
-  auto computeResultType = [&](mlir::Value argArray,
-                               mlir::Type stmtResultType) -> mlir::Type {
-    hlfir::ExprType::Shape resultShape;
-    mlir::Type normalisedResult =
-        hlfir::getFortranElementOrSequenceType(stmtResultType);
-    mlir::Type elementType;
-    if (auto array = normalisedResult.dyn_cast<fir::SequenceType>()) {
-      resultShape = hlfir::ExprType::Shape{array.getShape()};
-      elementType = array.getEleTy();
-      return hlfir::ExprType::get(builder.getContext(), resultShape,
-                                  elementType,
-                                  /*polymorphic=*/false);
-    }
-    elementType = normalisedResult;
-    return elementType;
-  };
-
-  auto buildSumOperation = [](fir::FirOpBuilder &builder, mlir::Location loc,
-                              mlir::Type resultTy, mlir::Value array,
-                              mlir::Value dim, mlir::Value mask) {
-    return builder.create<hlfir::SumOp>(loc, resultTy, array, dim, mask);
-  };
-
-  auto buildProductOperation = [](fir::FirOpBuilder &builder,
-                                  mlir::Location loc, mlir::Type resultTy,
-                                  mlir::Value array, mlir::Value dim,
-                                  mlir::Value mask) {
-    return builder.create<hlfir::ProductOp>(loc, resultTy, array, dim, mask);
-  };
-
-  auto buildAnyOperation = [](fir::FirOpBuilder &builder, mlir::Location loc,
-                              mlir::Type resultTy, mlir::Value array,
-                              mlir::Value dim, mlir::Value mask) {
-    return builder.create<hlfir::AnyOp>(loc, resultTy, array, dim);
-  };
-
-  auto buildAllOperation = [](fir::FirOpBuilder &builder, mlir::Location loc,
-                              mlir::Type resultTy, mlir::Value array,
-                              mlir::Value dim, mlir::Value mask) {
-    return builder.create<hlfir::AllOp>(loc, resultTy, array, dim);
-  };
-
-  auto buildReductionIntrinsic =
-      [&](PreparedActualArguments &loweredActuals, mlir::Location loc,
-          fir::FirOpBuilder &builder, CallContext &callContext,
-          std::function<mlir::Operation *(fir::FirOpBuilder &, mlir::Location,
-                                          mlir::Type, mlir::Value, mlir::Value,
-                                          mlir::Value)>
-              buildFunc,
-          bool hasMask) -> std::optional<hlfir::EntityWithAttributes> {
-    // shared logic for building the product and sum operations
-    llvm::SmallVector<mlir::Value> operands = getOperandVector(loweredActuals);
-    // dim, mask can be NULL if these arguments were not given
-    mlir::Value array = operands[0];
-    mlir::Value dim = operands[1];
-    if (dim)
-      dim = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{dim});
-
-    mlir::Value mask;
-    if (hasMask)
-      mask = operands[2];
-
-    mlir::Type resultTy = computeResultType(array, *callContext.resultType);
-    auto *intrinsicOp = buildFunc(builder, loc, resultTy, array, dim, mask);
-    return {hlfir::EntityWithAttributes{intrinsicOp->getResult(0)}};
-  };
-
   const std::string intrinsicName = callContext.getProcedureName();
-  if (intrinsicName == "sum") {
-    return buildReductionIntrinsic(loweredActuals, loc, builder, callContext,
-                                   buildSumOperation, true);
-  }
-  if (intrinsicName == "product") {
-    return buildReductionIntrinsic(loweredActuals, loc, builder, callContext,
-                                   buildProductOperation, true);
-  }
-  if (intrinsicName == "matmul") {
-    llvm::SmallVector<mlir::Value> operands = getOperandVector(loweredActuals);
-    mlir::Type resultTy =
-        computeResultType(operands[0], *callContext.resultType);
-    hlfir::MatmulOp matmulOp = builder.create<hlfir::MatmulOp>(
-        loc, resultTy, operands[0], operands[1]);
-
-    return {hlfir::EntityWithAttributes{matmulOp.getResult()}};
-  }
-  if (intrinsicName == "transpose") {
-    llvm::SmallVector<mlir::Value> operands = getOperandVector(loweredActuals);
-    hlfir::ExprType::Shape resultShape;
-    mlir::Type normalisedResult =
-        hlfir::getFortranElementOrSequenceType(*callContext.resultType);
-    auto array = normalisedResult.cast<fir::SequenceType>();
-    llvm::ArrayRef<int64_t> arrayShape = array.getShape();
-    assert(arrayShape.size() == 2 && "arguments to transpose have a rank of 2");
-    mlir::Type elementType = array.getEleTy();
-    resultShape.push_back(arrayShape[0]);
-    resultShape.push_back(arrayShape[1]);
-    mlir::Type resultTy = hlfir::ExprType::get(
-        builder.getContext(), resultShape, elementType, /*polymorphic=*/false);
-    hlfir::TransposeOp transposeOp =
-        builder.create<hlfir::TransposeOp>(loc, resultTy, operands[0]);
-
-    return {hlfir::EntityWithAttributes{transposeOp.getResult()}};
-  }
-  if (intrinsicName == "any") {
-    return buildReductionIntrinsic(loweredActuals, loc, builder, callContext,
-                                   buildAnyOperation, false);
-  }
-  if (intrinsicName == "all") {
-    return buildReductionIntrinsic(loweredActuals, loc, builder, callContext,
-                                   buildAllOperation, false);
-  }
-  if (intrinsicName == "dot_product") {
-    llvm::SmallVector<mlir::Value> operands = getOperandVector(loweredActuals);
-    mlir::Type resultTy =
-        computeResultType(operands[0], *callContext.resultType);
-    hlfir::DotProductOp dotProductOp = builder.create<hlfir::DotProductOp>(
-        loc, resultTy, operands[0], operands[1]);
-
-    return {hlfir::EntityWithAttributes{dotProductOp.getResult()}};
-  }
-  if (intrinsicName == "count") {
-    llvm::SmallVector<mlir::Value> operands = getOperandVector(loweredActuals);
-    mlir::Value array = operands[0];
-    mlir::Value dim = operands[1];
-    if (dim)
-      dim = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{dim});
-    mlir::Value kind = operands[2];
-    mlir::Type resultTy = computeResultType(array, *callContext.resultType);
-    hlfir::CountOp countOp =
-        builder.create<hlfir::CountOp>(loc, resultTy, array, dim, kind);
-    return {hlfir::EntityWithAttributes{countOp.getResult()}};
-  }
-
-  if ((intrinsicName == "min" || intrinsicName == "max") &&
-      hlfir::getFortranElementType(callContext.resultType.value())
-          .isa<fir::CharacterType>()) {
-    llvm::SmallVector<mlir::Value> operands = getOperandVector(loweredActuals);
-    assert(operands.size() >= 2);
-
-    hlfir::CharExtremumPredicate pred = (intrinsicName == "min")
-                                            ? hlfir::CharExtremumPredicate::min
-                                            : hlfir::CharExtremumPredicate::max;
-    hlfir::CharExtremumOp charExtremumOp =
-        builder.create<hlfir::CharExtremumOp>(loc, pred,
-                                              mlir::ValueRange{operands});
-    return {hlfir::EntityWithAttributes{charExtremumOp.getResult()}};
-  }
 
-  // TODO add hlfir operations for other transformational intrinsics here
+  // transformational intrinsic ops always have a result type
+  if (callContext.resultType) {
+    std::optional<hlfir::EntityWithAttributes> res =
+        Fortran::lower::lowerHlfirIntrinsic(builder, loc, intrinsicName,
+                                            loweredActuals, argLowering,
+                                            *callContext.resultType);
+    if (res)
+      return res;
+  }
 
   // fallback to calling the intrinsic via fir.call
   return genIntrinsicRefCore(loweredActuals, intrinsic, argLowering,
                              callContext);
 }
 
 namespace {
 template <typename ElementalCallBuilderImpl>
 class ElementalCallBuilder {
 public:
   std::optional<hlfir::EntityWithAttributes>
-  genElementalCall(PreparedActualArguments &loweredActuals, bool isImpure,
-                   CallContext &callContext) {
+  genElementalCall(Fortran::lower::PreparedActualArguments &loweredActuals,
+                   bool isImpure, CallContext &callContext) {
     mlir::Location loc = callContext.loc;
     fir::FirOpBuilder &builder = callContext.getBuilder();
     unsigned numArgs = loweredActuals.size();
     // Step 1: dereference pointers/allocatables and compute elemental shape.
     mlir::Value shape;
-    PreparedActualArgument *optionalWithShape;
+    Fortran::lower::PreparedActualArgument *optionalWithShape;
     // 10.1.4 p5. Impure elemental procedures must be called in element order.
     bool mustBeOrdered = isImpure;
     for (unsigned i = 0; i < numArgs; ++i) {
       auto &preparedActual = loweredActuals[i];
       if (preparedActual) {
         hlfir::Entity actual = preparedActual->getOriginalActual();
         // Elemental procedure dummy arguments cannot be pointer/allocatables
         // (C15100), so it is safe to dereference any pointer or allocatable

 
 class ElementalUserCallBuilder
     : public ElementalCallBuilder<ElementalUserCallBuilder> {
 public:
   ElementalUserCallBuilder(Fortran::lower::CallerInterface &caller,
                            mlir::FunctionType callSiteType)
       : caller{caller}, callSiteType{callSiteType} {}
   std::optional<hlfir::Entity>
-  genElementalKernel(PreparedActualArguments &loweredActuals,
+  genElementalKernel(Fortran::lower::PreparedActualArguments &loweredActuals,
                      CallContext &callContext) {
     return genUserCall(loweredActuals, caller, callSiteType, callContext);
   }
 
   bool argMayBeModifiedByCall(unsigned argIdx) const {
     assert(argIdx < caller.getPassedArguments().size() && "bad argument index");
     return caller.getPassedArguments()[argIdx].mayBeModifiedByCall();
   }
 
   bool canLoadActualArgumentBeforeLoop(unsigned argIdx) const {
     using PassBy = Fortran::lower::CallerInterface::PassEntityBy;
     assert(argIdx < caller.getPassedArguments().size() && "bad argument index");
     // If the actual argument does not need to be passed via an address,
     // or will be passed in the address of a temporary copy, it can be loaded
     // before the elemental loop nest.
     const auto &arg = caller.getPassedArguments()[argIdx];
     return arg.passBy == PassBy::Value ||
            arg.passBy == PassBy::BaseAddressValueAttribute;
   }
 
-  mlir::Value
-  computeDynamicCharacterResultLength(PreparedActualArguments &loweredActuals,
-                                      CallContext &callContext) {
+  mlir::Value computeDynamicCharacterResultLength(
+      Fortran::lower::PreparedActualArguments &loweredActuals,
     TODO(callContext.loc,
          "compute elemental function result length parameters in HLFIR");
   }
 
 private:
   Fortran::lower::CallerInterface &caller;
   mlir::FunctionType callSiteType;
 };
 
 class ElementalIntrinsicCallBuilder
     : public ElementalCallBuilder<ElementalIntrinsicCallBuilder> {
 public:
   ElementalIntrinsicCallBuilder(
       const Fortran::evaluate::SpecificIntrinsic *intrinsic,
       const fir::IntrinsicArgumentLoweringRules *argLowering, bool isFunction)
       : intrinsic{intrinsic}, argLowering{argLowering}, isFunction{isFunction} {
   }
   std::optional<hlfir::Entity>
-  genElementalKernel(PreparedActualArguments &loweredActuals,
+  genElementalKernel(Fortran::lower::PreparedActualArguments &loweredActuals,
                      CallContext &callContext) {
     return genHLFIRIntrinsicRefCore(loweredActuals, intrinsic, argLowering,
                                     callContext);
   }
   // Elemental intrinsic functions cannot modify their arguments.
   bool argMayBeModifiedByCall(int) const { return !isFunction; }
   bool canLoadActualArgumentBeforeLoop(int) const {
     // Elemental intrinsic functions never need the actual addresses
     // of their arguments.
     return isFunction;
   }
 
-  mlir::Value
-  computeDynamicCharacterResultLength(PreparedActualArguments &loweredActuals,
-                                      CallContext &callContext) {
+  mlir::Value computeDynamicCharacterResultLength(
+      Fortran::lower::PreparedActualArguments &loweredActuals,
     if (intrinsic)
       if (intrinsic->name == "adjustr" || intrinsic->name == "adjustl" ||
           intrinsic->name == "merge")
         return hlfir::genCharLength(
             callContext.loc, callContext.getBuilder(),
             loweredActuals[0].value().getOriginalActual());
     // Character MIN/MAX is the min/max of the arguments length that are
     // present.

 genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
                 CallContext &callContext) {
   mlir::Location loc = callContext.loc;
   auto &converter = callContext.converter;
   if (intrinsic && Fortran::lower::intrinsicRequiresCustomOptionalHandling(
                        callContext.procRef, *intrinsic, converter))
     TODO(loc, "special cases of intrinsic with optional arguments");
 
-  PreparedActualArguments loweredActuals;
+  Fortran::lower::PreparedActualArguments loweredActuals;
   const fir::IntrinsicArgumentLoweringRules *argLowering =
       fir::getIntrinsicArgumentLowering(callContext.getProcedureName());
   for (const auto &arg : llvm::enumerate(callContext.procRef.arguments())) {
 
     if (!arg.value()) {
       // Absent optional.
       loweredActuals.push_back(std::nullopt);
       continue;
if (!expr) {
           callContext.symMap.lookupVariableDefinition(*assumedTypeSym);
       if (!var)
         fir::emitFatalError(loc, "assumed-type symbol was not lowered");
       assert(
           (!argLowering ||
            !fir::lowerIntrinsicArgumentAs(*argLowering, arg.index())
                 .handleDynamicOptional) &&
           "TYPE(*) are not expected to appear as optional intrinsic arguments");
-      loweredActuals.push_back(PreparedActualArgument{
+      loweredActuals.push_back(Fortran::lower::PreparedActualArgument{
           hlfir::Entity{*var}, /*isPresent=*/std::nullopt});
       continue;
     }
     auto loweredActual = Fortran::lower::convertExprToHLFIR(
         loc, callContext.converter, *expr, callContext.symMap,
         callContext.stmtCtx);
     std::optional<mlir::Value> isPresent;
     if (argLowering) {
       fir::ArgLoweringRule argRules =
           fir::lowerIntrinsicArgumentAs(*argLowering, arg.index());
       if (argRules.handleDynamicOptional)
         isPresent =
             genIsPresentIfArgMaybeAbsent(loc, loweredActual, *expr, callContext,
                                          /*passAsAllocatableOrPointer=*/false);
     }
-    loweredActuals.push_back(PreparedActualArgument{loweredActual, isPresent});
+    loweredActuals.push_back(
+        Fortran::lower::PreparedActualArgument{loweredActual, isPresent});
   }
 
   if (callContext.isElementalProcWithArrayArgs()) {
     // All intrinsic elemental functions are pure.
     const bool isFunction = callContext.resultType.has_value();
     return ElementalIntrinsicCallBuilder{intrinsic, argLowering, isFunction}
         .genElementalCall(loweredActuals, /*isImpure=*/!isFunction, callContext)
         .value();
genProcedureRef(CallContext &callContext) {
   if (callContext.isStatementFunctionCall())
     return genStmtFunctionRef(loc, callContext.converter, callContext.symMap,
                               callContext.stmtCtx, callContext.procRef);
 
   Fortran::lower::CallerInterface caller(callContext.procRef,
                                          callContext.converter);
   mlir::FunctionType callSiteType = caller.genFunctionType();
 
-  PreparedActualArguments loweredActuals;
+  Fortran::lower::PreparedActualArguments loweredActuals;
   // Lower the actual arguments
   for (const Fortran::lower::CallInterface<
            Fortran::lower::CallerInterface>::PassedEntity &arg :
        caller.getPassedArguments())
     if (const auto *actual = arg.entity) {
       const auto *expr = actual->UnwrapExpr();
       if (!expr)
         TODO(loc, "assumed type actual argument");
if (const auto *actual = arg.entity) {
       std::optional<mlir::Value> isPresent;
       if (arg.isOptional())
         isPresent = genIsPresentIfArgMaybeAbsent(
             loc, loweredActual, *expr, callContext,
             arg.passBy ==
                 Fortran::lower::CallerInterface::PassEntityBy::MutableBox);
 
       loweredActuals.emplace_back(
-          PreparedActualArgument{loweredActual, isPresent});
+          Fortran::lower::PreparedActualArgument{loweredActual, isPresent});
     } else {
       // Optional dummy argument for which there is no actual argument.
       loweredActuals.emplace_back(std::nullopt);
     }
   if (callContext.isElementalProcWithArrayArgs()) {
     bool isImpure = false;
     if (const Fortran::semantics::Symbol *procSym =
             callContext.procRef.proc().GetSymbol())

flang/lib/Lower/HlfirIntrinsics.cpp

+//===-- HlfirIntrinsics.cpp
+//---------------------------------------------------===//
+//
+// 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/
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/HlfirIntrinsics.h"
+
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Builder/HLFIRTools.h"
+#include "flang/Optimizer/Builder/IntrinsicCall.h"
+#include "flang/Optimizer/Dialect/FIRType.h"
+#include "flang/Optimizer/HLFIR/HLFIRDialect.h"
+#include "flang/Optimizer/HLFIR/HLFIROps.h"
+#include "mlir/IR/Value.h"
+#include "llvm/ADT/SmallVector.h"
+#include <mlir/IR/ValueRange.h>
+
+namespace {
+
+class HlfirTransformationalIntrinsic {
+public:
+  explicit HlfirTransformationalIntrinsic(fir::FirOpBuilder &builder,
+                                          mlir::Location loc)
+      : builder(builder), loc(loc) {}
+
+  virtual ~HlfirTransformationalIntrinsic() = default;
+
+  hlfir::EntityWithAttributes
+  lower(const Fortran::lower::PreparedActualArguments &loweredActuals,
+        const fir::IntrinsicArgumentLoweringRules *argLowering,
+        mlir::Type stmtResultType) {
+    mlir::Value res = lowerImpl(loweredActuals, argLowering, stmtResultType);
+    return {hlfir::EntityWithAttributes{res}};
+  }
+
+protected:
+  fir::FirOpBuilder &builder;
+  mlir::Location loc;
+
+  virtual mlir::Value
+  lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
+            const fir::IntrinsicArgumentLoweringRules *argLowering,
+            mlir::Type stmtResultType) = 0;
+
+  llvm::SmallVector<mlir::Value> getOperandVector(
+      const Fortran::lower::PreparedActualArguments &loweredActuals,
+      const fir::IntrinsicArgumentLoweringRules *argLowering);
+
+  mlir::Type computeResultType(mlir::Value argArray, mlir::Type stmtResultType);
+
+  template <typename OP, typename... BUILD_ARGS>
+  inline OP createOp(BUILD_ARGS... args) {
+    return builder.create<OP>(loc, args...);
+  }
+};
+
+template <typename OP, bool HAS_MASK>
+class HlfirReductionIntrinsic : public HlfirTransformationalIntrinsic {
+public:
+  using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
+
+protected:
+  mlir::Value
+  lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
+            const fir::IntrinsicArgumentLoweringRules *argLowering,
+            mlir::Type stmtResultType) override;
+};
+using HlfirSumLowering = HlfirReductionIntrinsic<hlfir::SumOp, true>;
+using HlfirProductLowering = HlfirReductionIntrinsic<hlfir::ProductOp, true>;
+using HlfirAnyLowering = HlfirReductionIntrinsic<hlfir::AnyOp, false>;
+using HlfirAllLowering = HlfirReductionIntrinsic<hlfir::AllOp, false>;
+
+template <typename OP>
+class HlfirProductIntrinsic : public HlfirTransformationalIntrinsic {
+public:
+  using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
+
+protected:
+  mlir::Value
+  lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
+            const fir::IntrinsicArgumentLoweringRules *argLowering,
+            mlir::Type stmtResultType) override;
+};
+using HlfirMatmulLowering = HlfirProductIntrinsic<hlfir::MatmulOp>;
+using HlfirDotProductLowering = HlfirProductIntrinsic<hlfir::DotProductOp>;
+
+class HlfirTransposeLowering : public HlfirTransformationalIntrinsic {
+public:
+  using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
+
+protected:
+  mlir::Value
+  lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
+            const fir::IntrinsicArgumentLoweringRules *argLowering,
+            mlir::Type stmtResultType) override;
+};
+
+class HlfirCountLowering : public HlfirTransformationalIntrinsic {
+public:
+  using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
+
+protected:
+  mlir::Value
+  lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
+            const fir::IntrinsicArgumentLoweringRules *argLowering,
+            mlir::Type stmtResultType) override;
+};
+
+class HlfirCharExtremumLowering : public HlfirTransformationalIntrinsic {
+public:
+  HlfirCharExtremumLowering(fir::FirOpBuilder &builder, mlir::Location loc,
+                            hlfir::CharExtremumPredicate pred)
+      : HlfirTransformationalIntrinsic(builder, loc), pred{pred} {}
+
+protected:
+  mlir::Value
+  lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
+            const fir::IntrinsicArgumentLoweringRules *argLowering,
+            mlir::Type stmtResultType) override;
+
+protected:
+  hlfir::CharExtremumPredicate pred;
+};
+
+} // namespace
+
+llvm::SmallVector<mlir::Value> HlfirTransformationalIntrinsic::getOperandVector(
+    const Fortran::lower::PreparedActualArguments &loweredActuals,
+    const fir::IntrinsicArgumentLoweringRules *argLowering) {
+  llvm::SmallVector<mlir::Value> operands;
+  operands.reserve(loweredActuals.size());
+
+  for (size_t i = 0; i < loweredActuals.size(); ++i) {
+    std::optional<Fortran::lower::PreparedActualArgument> arg =
+        loweredActuals[i];
+    if (!arg) {
+      operands.emplace_back();
+      continue;
+    }
+    hlfir::Entity actual = arg->getOriginalActual();
+    mlir::Value valArg;
+
+    if (!argLowering) {
+      valArg = hlfir::loadTrivialScalar(loc, builder, actual);
+    } else {
+      fir::ArgLoweringRule argRules =
+          fir::lowerIntrinsicArgumentAs(*argLowering, i);
+      if (!argRules.handleDynamicOptional &&
+          argRules.lowerAs != fir::LowerIntrinsicArgAs::Inquired)
+        valArg = hlfir::derefPointersAndAllocatables(loc, builder, actual);
+      else
+        valArg = actual.getBase();
+    }
+
+    operands.emplace_back(valArg);
+  }
+  return operands;
+}
+
+mlir::Type
+HlfirTransformationalIntrinsic::computeResultType(mlir::Value argArray,
+                                                  mlir::Type stmtResultType) {
+  mlir::Type normalisedResult =
+      hlfir::getFortranElementOrSequenceType(stmtResultType);
+  if (auto array = normalisedResult.dyn_cast<fir::SequenceType>()) {
+    hlfir::ExprType::Shape resultShape =
+        hlfir::ExprType::Shape{array.getShape()};
+    mlir::Type elementType = array.getEleTy();
+    return hlfir::ExprType::get(builder.getContext(), resultShape, elementType,
+                                /*polymorphic=*/false);
+  }
+  return normalisedResult;
+}
+
+template <typename OP, bool HAS_MASK>
+mlir::Value HlfirReductionIntrinsic<OP, HAS_MASK>::lowerImpl(
+    const Fortran::lower::PreparedActualArguments &loweredActuals,
+    const fir::IntrinsicArgumentLoweringRules *argLowering,
+    mlir::Type stmtResultType) {
+  auto operands = getOperandVector(loweredActuals, argLowering);
+  mlir::Value array = operands[0];
+  mlir::Value dim = operands[1];
+  // dim, mask can be NULL if these arguments are not given
+  if (dim)
+    dim = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{dim});
+
+  mlir::Type resultTy = computeResultType(array, stmtResultType);
+
+  OP op;
+  if constexpr (HAS_MASK)
+    op = createOp<OP>(resultTy, array, dim, /*mask=*/operands[2]);
+  else
+    op = createOp<OP>(resultTy, array, dim);
+  return op;
+}
+
+template <typename OP>
+mlir::Value HlfirProductIntrinsic<OP>::lowerImpl(
+    const Fortran::lower::PreparedActualArguments &loweredActuals,
+    const fir::IntrinsicArgumentLoweringRules *argLowering,
+    mlir::Type stmtResultType) {
+  auto operands = getOperandVector(loweredActuals, argLowering);
+  mlir::Type resultType = computeResultType(operands[0], stmtResultType);
+  return createOp<OP>(resultType, operands[0], operands[1]);
+}
+
+mlir::Value HlfirTransposeLowering::lowerImpl(
+    const Fortran::lower::PreparedActualArguments &loweredActuals,
+    const fir::IntrinsicArgumentLoweringRules *argLowering,
+    mlir::Type stmtResultType) {
+  auto operands = getOperandVector(loweredActuals, argLowering);
+  hlfir::ExprType::Shape resultShape;
+  mlir::Type normalisedResult =
+      hlfir::getFortranElementOrSequenceType(stmtResultType);
+  auto array = normalisedResult.cast<fir::SequenceType>();
+  llvm::ArrayRef<int64_t> arrayShape = array.getShape();
+  assert(arrayShape.size() == 2 && "arguments to transpose have a rank of 2");
+  mlir::Type elementType = array.getEleTy();
+  resultShape.push_back(arrayShape[0]);
+  resultShape.push_back(arrayShape[1]);
+  mlir::Type resultTy = hlfir::ExprType::get(
+      builder.getContext(), resultShape, elementType, /*polymorphic=*/false);
+  return createOp<hlfir::TransposeOp>(resultTy, operands[0]);
+}
+
+mlir::Value HlfirCountLowering::lowerImpl(
+    const Fortran::lower::PreparedActualArguments &loweredActuals,
+    const fir::IntrinsicArgumentLoweringRules *argLowering,
+    mlir::Type stmtResultType) {
+  auto operands = getOperandVector(loweredActuals, argLowering);
+  mlir::Value array = operands[0];
+  mlir::Value dim = operands[1];
+  if (dim)
+    dim = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{dim});
+  mlir::Value kind = operands[2];
+  mlir::Type resultType = computeResultType(array, stmtResultType);
+  return createOp<hlfir::CountOp>(resultType, array, dim, kind);
+}
+
+mlir::Value HlfirCharExtremumLowering::lowerImpl(
+    const Fortran::lower::PreparedActualArguments &loweredActuals,
+    const fir::IntrinsicArgumentLoweringRules *argLowering,
+    mlir::Type stmtResultType) {
+  auto operands = getOperandVector(loweredActuals, argLowering);
+  assert(operands.size() >= 2);
+  return createOp<hlfir::CharExtremumOp>(pred, mlir::ValueRange{operands});
+}
+
+std::optional<hlfir::EntityWithAttributes> Fortran::lower::lowerHlfirIntrinsic(
+    fir::FirOpBuilder &builder, mlir::Location loc, const std::string &name,
+    const Fortran::lower::PreparedActualArguments &loweredActuals,
+    const fir::IntrinsicArgumentLoweringRules *argLowering,
+    mlir::Type stmtResultType) {
+  if (name == "sum")
+    return HlfirSumLowering{builder, loc}.lower(loweredActuals, argLowering,
+                                                stmtResultType);
+  if (name == "product")
+    return HlfirProductLowering{builder, loc}.lower(loweredActuals, argLowering,
+                                                    stmtResultType);
+  if (name == "any")
+    return HlfirAnyLowering{builder, loc}.lower(loweredActuals, argLowering,
+                                                stmtResultType);
+  if (name == "all")
+    return HlfirAllLowering{builder, loc}.lower(loweredActuals, argLowering,
+                                                stmtResultType);
+  if (name == "matmul")
+    return HlfirMatmulLowering{builder, loc}.lower(loweredActuals, argLowering,
+                                                   stmtResultType);
+  if (name == "dot_product")
+    return HlfirDotProductLowering{builder, loc}.lower(
+        loweredActuals, argLowering, stmtResultType);
+  if (name == "transpose")
+    return HlfirTransposeLowering{builder, loc}.lower(
+        loweredActuals, argLowering, stmtResultType);
+  if (name == "count")
+    return HlfirCountLowering{builder, loc}.lower(loweredActuals, argLowering,
+                                                  stmtResultType);
+  if (mlir::isa<fir::CharacterType>(stmtResultType)) {
+    if (name == "min")
+      return HlfirCharExtremumLowering{builder, loc,
+                                       hlfir::CharExtremumPredicate::min}
+          .lower(loweredActuals, argLowering, stmtResultType);
+    if (name == "max")
+      return HlfirCharExtremumLowering{builder, loc,
+                                       hlfir::CharExtremumPredicate::max}
+          .lower(loweredActuals, argLowering, stmtResultType);
+  }
+  return std::nullopt;
+}
 No newline at end of file