[flang] Lower sum intrinsic

This patch enables the lowering of the `sum` intrinsic. It adds
also infrastructure to deal with optional arguments in intrinsics and
implied loops.

This patch is part of the upstreaming effort from fir-dev branch.

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D121221

Co-authored-by: Eric Schweitz <eschweitz@nvidia.com>
Co-authored-by: Jean Perier <jperier@nvidia.com>
Co-authored-by: mleair <leairmark@gmail.com>

flang/include/flang/Lower/AbstractConverter.h

@@ -76,6 +76,9 @@ class AbstractConverter {
   /// Get the mlir instance of a symbol.
   virtual mlir::Value getSymbolAddress(SymbolRef sym) = 0;
 
+  /// Get the binding of an implied do variable by name.
+  virtual mlir::Value impliedDoBinding(llvm::StringRef name) = 0;
+
   /// Get the label set associated with a symbol.
   virtual bool lookupLabelSet(SymbolRef sym, pft::LabelSet &labelSet) = 0;
 

flang/include/flang/Lower/ConvertExpr.h

@@ -140,6 +140,13 @@ void createAllocatableArrayAssignment(AbstractConverter &converter,
                                       SymMap &symMap,
                                       StatementContext &stmtCtx);
 
+/// Lower an array expression with "parallel" semantics. Such a rhs expression
+/// is fully evaluated prior to being assigned back to a temporary array.
+fir::ExtendedValue createSomeArrayTempValue(AbstractConverter &converter,
+                                            const SomeExpr &expr,
+                                            SymMap &symMap,
+                                            StatementContext &stmtCtx);
+
 // Attribute for an alloca that is a trivial adaptor for converting a value to
 // pass-by-ref semantics for a VALUE parameter. The optimizer may be able to
 // eliminate these.

flang/include/flang/Lower/CustomIntrinsicCall.h

@@ -0,0 +1,99 @@
+//===-- Lower/CustomIntrinsicCall.h -----------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+///
+/// Custom intrinsic lowering for the few intrinsic that have optional
+/// arguments that prevents them to be handled in a more generic way in
+/// IntrinsicCall.cpp.
+/// The core principle is that this interface provides the intrinsic arguments
+/// via callbacks to generate fir::ExtendedValue (instead of a list of
+/// precomputed fir::ExtendedValue as done in the default intrinsic call
+/// lowering). This gives more flexibility to only generate references to
+/// dynamically optional arguments (pointers, allocatables, OPTIONAL dummies) in
+/// a safe way.
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_CUSTOMINTRINSICCALL_H
+#define FORTRAN_LOWER_CUSTOMINTRINSICCALL_H
+
+#include "flang/Lower/AbstractConverter.h"
+#include "llvm/ADT/Optional.h"
+#include <functional>
+
+namespace Fortran {
+
+namespace evaluate {
+class ProcedureRef;
+struct SpecificIntrinsic;
+} // namespace evaluate
+
+namespace lower {
+
+/// Does the call \p procRef to \p intrinsic need to be handle via this custom
+/// framework due to optional arguments. Otherwise, the tools from
+/// IntrinsicCall.cpp should be used directly.
+bool intrinsicRequiresCustomOptionalHandling(
+    const Fortran::evaluate::ProcedureRef &procRef,
+    const Fortran::evaluate::SpecificIntrinsic &intrinsic,
+    AbstractConverter &converter);
+
+/// Type of callback to be provided to prepare the arguments fetching from an
+/// actual argument expression.
+using OperandPrepare = std::function<void(const Fortran::lower::SomeExpr &)>;
+
+/// Type of the callback to inquire about an argument presence, once the call
+/// preparation was done. An absent optional means the argument is statically
+/// present. An mlir::Value means the presence must be checked at runtime, and
+/// that the value contains the "is present" boolean value.
+using OperandPresent = std::function<llvm::Optional<mlir::Value>(std::size_t)>;
+
+/// Type of the callback to generate an argument reference after the call
+/// preparation was done. For optional arguments, the utility guarantees
+/// these callbacks will only be called in regions where the presence was
+/// verified. This means the getter callback can dereference the argument
+/// without any special care.
+/// For elemental intrinsics, the getter must provide the current iteration
+/// element value.
+using OperandGetter = std::function<fir::ExtendedValue(std::size_t)>;
+
+/// Given a callback \p prepareOptionalArgument to prepare optional
+/// arguments and a callback \p prepareOtherArgument to prepare non-optional
+/// arguments prepare the intrinsic arguments calls.
+/// It is up to the caller to decide what argument preparation means,
+/// the only contract is that it should later allow the caller to provide
+/// callbacks to generate argument reference given an argument index without
+/// any further knowledge of the argument. The function simply visits
+/// the actual arguments, deciding which ones are dynamically optional,
+/// and calling the callbacks accordingly in argument order.
+void prepareCustomIntrinsicArgument(
+    const Fortran::evaluate::ProcedureRef &procRef,
+    const Fortran::evaluate::SpecificIntrinsic &intrinsic,
+    llvm::Optional<mlir::Type> retTy,
+    const OperandPrepare &prepareOptionalArgument,
+    const OperandPrepare &prepareOtherArgument, AbstractConverter &converter);
+
+/// Given a callback \p getOperand to generate a reference to the i-th argument,
+/// and a callback \p isPresentCheck to test if an argument is present, this
+/// function lowers the intrinsic calls to \p name whose argument were
+/// previously prepared with prepareCustomIntrinsicArgument. The elemental
+/// aspects must be taken into account by the caller (i.e, the function should
+/// be called during the loop nest generation for elemental intrinsics. It will
+/// not generate any implicit loop nest on its own).
+fir::ExtendedValue
+lowerCustomIntrinsic(fir::FirOpBuilder &builder, mlir::Location loc,
+                     llvm::StringRef name, llvm::Optional<mlir::Type> retTy,
+                     const OperandPresent &isPresentCheck,
+                     const OperandGetter &getOperand, std::size_t numOperands,
+                     Fortran::lower::StatementContext &stmtCtx);
+} // namespace lower
+} // namespace Fortran
+
+#endif // FORTRAN_LOWER_CUSTOMINTRINSICCALL_H

flang/include/flang/Lower/IntrinsicCall.h

@@ -18,6 +18,8 @@ class ExtendedValue;
 
 namespace Fortran::lower {
 
+class StatementContext;
+
 // TODO: Error handling interface ?
 // TODO: Implementation is incomplete. Many intrinsics to tbd.
 
@@ -27,7 +29,8 @@ namespace Fortran::lower {
 fir::ExtendedValue genIntrinsicCall(fir::FirOpBuilder &, mlir::Location,
                                     llvm::StringRef name,
                                     llvm::Optional<mlir::Type> resultType,
-                                    llvm::ArrayRef<fir::ExtendedValue> args);
+                                    llvm::ArrayRef<fir::ExtendedValue> args,
+                                    StatementContext &);
 
 /// Enum specifying how intrinsic argument evaluate::Expr should be
 /// lowered to fir::ExtendedValue to be passed to genIntrinsicCall.

flang/include/flang/Optimizer/Builder/FIRBuilder.h

@@ -420,6 +420,18 @@ llvm::SmallVector<mlir::Value> getExtents(fir::FirOpBuilder &builder,
 fir::ExtendedValue readBoxValue(fir::FirOpBuilder &builder, mlir::Location loc,
                                 const fir::BoxValue &box);
 
+/// Get non default (not all ones) lower bounds of \p exv. Returns empty
+/// vector if the lower bounds are all ones.
+llvm::SmallVector<mlir::Value>
+getNonDefaultLowerBounds(fir::FirOpBuilder &builder, mlir::Location loc,
+                         const fir::ExtendedValue &exv);
+
+/// Return length parameters associated to \p exv that are not deferred (that
+/// are available without having to read any fir.box values).
+/// Empty if \p exv has no length parameters or if they are all deferred.
+llvm::SmallVector<mlir::Value>
+getNonDeferredLengthParams(const fir::ExtendedValue &exv);
+
 //===----------------------------------------------------------------------===//
 // String literal helper helpers
 //===----------------------------------------------------------------------===//

flang/include/flang/Optimizer/Dialect/FIRType.h

@@ -127,6 +127,13 @@ inline bool isa_complex(mlir::Type t) {
 /// Is `t` a CHARACTER type? Does not check the length.
 inline bool isa_char(mlir::Type t) { return t.isa<fir::CharacterType>(); }
 
+/// Is `t` a trivial intrinsic type? CHARACTER is <em>excluded</em> because it
+/// is a dependent type.
+inline bool isa_trivial(mlir::Type t) {
+  return isa_integer(t) || isa_real(t) || isa_complex(t) ||
+         t.isa<fir::LogicalType>();
+}
+
 /// Is `t` a CHARACTER type with a LEN other than 1?
 inline bool isa_char_string(mlir::Type t) {
   if (auto ct = t.dyn_cast_or_null<fir::CharacterType>())
@@ -184,6 +191,12 @@ inline bool singleIndirectionLevel(mlir::Type ty) {
 }
 #endif
 
+/// Return true iff `ty` is the type of an ALLOCATABLE entity or value.
+bool isAllocatableType(mlir::Type ty);
+
+/// Return true iff `ty` is a RecordType with members that are allocatable.
+bool isRecordWithAllocatableMember(mlir::Type ty);
+
 /// Return true iff `ty` is a RecordType with type parameters.
 inline bool isRecordWithTypeParameters(mlir::Type ty) {
   if (auto recTy = ty.dyn_cast_or_null<fir::RecordType>())

flang/lib/Lower/Bridge.cpp

@@ -177,6 +177,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     return lookupSymbol(sym).getAddr();
   }
 
+  mlir::Value impliedDoBinding(llvm::StringRef name) override final {
+    mlir::Value val = localSymbols.lookupImpliedDo(name);
+    if (!val)
+      fir::emitFatalError(toLocation(), "ac-do-variable has no binding");
+    return val;
+  }
+
   bool lookupLabelSet(Fortran::lower::SymbolRef sym,
                       Fortran::lower::pft::LabelSet &labelSet) override final {
     Fortran::lower::pft::FunctionLikeUnit &owningProc =
@@ -818,6 +825,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     return cond;
   }
 
+  static bool
+  isArraySectionWithoutVectorSubscript(const Fortran::lower::SomeExpr &expr) {
+    return expr.Rank() > 0 && Fortran::evaluate::IsVariable(expr) &&
+           !Fortran::evaluate::UnwrapWholeSymbolDataRef(expr) &&
+           !Fortran::evaluate::HasVectorSubscript(expr);
+  }
+
   [[maybe_unused]] static bool
   isFuncResultDesignator(const Fortran::lower::SomeExpr &expr) {
     const Fortran::semantics::Symbol *sym =
@@ -1086,6 +1100,15 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     TODO(toLocation(), "SelectCaseStmt lowering");
   }
 
+  fir::ExtendedValue
+  genAssociateSelector(const Fortran::lower::SomeExpr &selector,
+                       Fortran::lower::StatementContext &stmtCtx) {
+    return isArraySectionWithoutVectorSubscript(selector)
+               ? Fortran::lower::createSomeArrayBox(*this, selector,
+                                                    localSymbols, stmtCtx)
+               : genExprAddr(selector, stmtCtx);
+  }
+
   void genFIR(const Fortran::parser::AssociateConstruct &) {
     TODO(toLocation(), "AssociateConstruct lowering");
   }
@@ -1457,10 +1480,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     TODO(toLocation(), "EndDoStmt lowering");
   }
 
-  void genFIR(const Fortran::parser::EndIfStmt &) {
-    TODO(toLocation(), "EndIfStmt lowering");
-  }
-
   void genFIR(const Fortran::parser::EndMpSubprogramStmt &) {
     TODO(toLocation(), "EndMpSubprogramStmt lowering");
   }
@@ -1472,6 +1491,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
   // Nop statements - No code, or code is generated at the construct level.
   void genFIR(const Fortran::parser::ContinueStmt &) {}      // nop
   void genFIR(const Fortran::parser::EndFunctionStmt &) {}   // nop
+  void genFIR(const Fortran::parser::EndIfStmt &) {}         // nop
   void genFIR(const Fortran::parser::EndSubroutineStmt &) {} // nop
 
   void genFIR(const Fortran::parser::EntryStmt &) {

flang/lib/Lower/CMakeLists.txt

@@ -9,6 +9,7 @@ add_flang_library(FortranLower
   ConvertType.cpp
   ConvertVariable.cpp
   ComponentPath.cpp
+  CustomIntrinsicCall.cpp
   DumpEvaluateExpr.cpp
   HostAssociations.cpp
   IntrinsicCall.cpp