[flang-commits] [flang] 80f8c6d - [flang] Lower of elemental calls in array expression
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Fri Mar 11 09:39:15 PST 2022
Author: Valentin Clement
Date: 2022-03-11T18:39:06+01:00
New Revision: 80f8c6dd16b8d0bca10dadf6ff49f7ed7484f346
URL: https://github.com/llvm/llvm-project/commit/80f8c6dd16b8d0bca10dadf6ff49f7ed7484f346
DIFF: https://github.com/llvm/llvm-project/commit/80f8c6dd16b8d0bca10dadf6ff49f7ed7484f346.diff
LOG: [flang] Lower of elemental calls in array expression
This patch adds tests and missing lowering
code to lower elemental function/subroutine calls
in array expression
This patch is part of the upstreaming effort from fir-dev branch.
Reviewed By: PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D121474
Co-authored-by: Jean Perier <jperier at nvidia.com>
Co-authored-by: Eric Schweitz <eschweitz at nvidia.com>
Added:
flang/lib/Lower/array-elemental-calls-2.f90
flang/test/Lower/array-elemental-calls.f90
Modified:
flang/include/flang/Optimizer/Builder/Factory.h
flang/lib/Lower/ConvertExpr.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/lib/Lower/IntrinsicCall.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Optimizer/Builder/Factory.h b/flang/include/flang/Optimizer/Builder/Factory.h
index 486ec6f1af2d4..68dd9afe119a0 100644
--- a/flang/include/flang/Optimizer/Builder/Factory.h
+++ b/flang/include/flang/Optimizer/Builder/Factory.h
@@ -188,12 +188,13 @@ originateIndices(mlir::Location loc, B &builder, mlir::Type memTy,
auto ty = fir::dyn_cast_ptrOrBoxEleTy(memTy);
assert(ty && ty.isa<fir::SequenceType>());
auto seqTy = ty.cast<fir::SequenceType>();
- const auto dimension = seqTy.getDimension();
- assert(shapeVal &&
- dimension == mlir::cast<fir::ShapeOp>(shapeVal.getDefiningOp())
- .getType()
- .getRank());
auto one = builder.template create<mlir::arith::ConstantIndexOp>(loc, 1);
+ const auto dimension = seqTy.getDimension();
+ if (shapeVal) {
+ assert(dimension == mlir::cast<fir::ShapeOp>(shapeVal.getDefiningOp())
+ .getType()
+ .getRank());
+ }
for (auto i : llvm::enumerate(indices)) {
if (i.index() < dimension) {
assert(fir::isa_integer(i.value().getType()));
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 2585087b15188..3c58bc8a8c096 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -461,6 +461,27 @@ argumentHostAssocs(Fortran::lower::AbstractConverter &converter,
return {};
}
+/// \p argTy must be a tuple (pair) of boxproc and integral types. Convert the
+/// \p funcAddr argument to a boxproc value, with the host-association as
+/// required. Call the factory function to finish creating the tuple value.
+static mlir::Value
+createBoxProcCharTuple(Fortran::lower::AbstractConverter &converter,
+ mlir::Type argTy, mlir::Value funcAddr,
+ mlir::Value charLen) {
+ auto boxTy =
+ argTy.cast<mlir::TupleType>().getType(0).cast<fir::BoxProcType>();
+ mlir::Location loc = converter.getCurrentLocation();
+ auto &builder = converter.getFirOpBuilder();
+ auto boxProc = [&]() -> mlir::Value {
+ if (auto host = argumentHostAssocs(converter, funcAddr))
+ return builder.create<fir::EmboxProcOp>(
+ loc, boxTy, llvm::ArrayRef<mlir::Value>{funcAddr, host});
+ return builder.create<fir::EmboxProcOp>(loc, boxTy, funcAddr);
+ }();
+ return fir::factory::createCharacterProcedureTuple(builder, loc, argTy,
+ boxProc, charLen);
+}
+
namespace {
/// Lowering of Fortran::evaluate::Expr<T> expressions
@@ -951,7 +972,14 @@ class ScalarExprLowering {
template <int KIND>
ExtValue genval(const Fortran::evaluate::Concat<KIND> &op) {
- TODO(getLoc(), "genval Concat<KIND>");
+ ExtValue lhs = genval(op.left());
+ ExtValue rhs = genval(op.right());
+ const fir::CharBoxValue *lhsChar = lhs.getCharBox();
+ const fir::CharBoxValue *rhsChar = rhs.getCharBox();
+ if (lhsChar && rhsChar)
+ return fir::factory::CharacterExprHelper{builder, getLoc()}
+ .createConcatenate(*lhsChar, *rhsChar);
+ TODO(getLoc(), "character array concatenate");
}
/// MIN and MAX operations
@@ -1749,6 +1777,12 @@ class ScalarExprLowering {
ExtValue genProcedureRef(const Fortran::evaluate::ProcedureRef &procRef,
llvm::Optional<mlir::Type> resultType) {
ExtValue res = genRawProcedureRef(procRef, resultType);
+ // In most contexts, pointers and allocatable do not appear as allocatable
+ // or pointer variable on the caller side (see 8.5.3 note 1 for
+ // allocatables). The few context where this can happen must call
+ // genRawProcedureRef directly.
+ if (const auto *box = res.getBoxOf<fir::MutableBoxValue>())
+ return fir::factory::genMutableBoxRead(builder, getLoc(), *box);
return res;
}
@@ -3745,6 +3779,141 @@ class ArrayExprLowering {
};
}
+ /// Lower a procedure reference to a user-defined elemental procedure.
+ CC genElementalUserDefinedProcRef(
+ const Fortran::evaluate::ProcedureRef &procRef,
+ llvm::Optional<mlir::Type> retTy) {
+ using PassBy = Fortran::lower::CallerInterface::PassEntityBy;
+
+ // 10.1.4 p5. Impure elemental procedures must be called in element order.
+ if (const Fortran::semantics::Symbol *procSym = procRef.proc().GetSymbol())
+ if (!Fortran::semantics::IsPureProcedure(*procSym))
+ setUnordered(false);
+
+ Fortran::lower::CallerInterface caller(procRef, converter);
+ llvm::SmallVector<CC> operands;
+ operands.reserve(caller.getPassedArguments().size());
+ mlir::Location loc = getLoc();
+ mlir::FunctionType callSiteType = caller.genFunctionType();
+ for (const Fortran::lower::CallInterface<
+ Fortran::lower::CallerInterface>::PassedEntity &arg :
+ caller.getPassedArguments()) {
+ // 15.8.3 p1. Elemental procedure with intent(out)/intent(inout)
+ // arguments must be called in element order.
+ if (arg.mayBeModifiedByCall())
+ setUnordered(false);
+ const auto *actual = arg.entity;
+ mlir::Type argTy = callSiteType.getInput(arg.firArgument);
+ if (!actual) {
+ // Optional dummy argument for which there is no actual argument.
+ auto absent = builder.create<fir::AbsentOp>(loc, argTy);
+ operands.emplace_back([=](IterSpace) { return absent; });
+ continue;
+ }
+ const auto *expr = actual->UnwrapExpr();
+ if (!expr)
+ TODO(loc, "assumed type actual argument lowering");
+
+ LLVM_DEBUG(expr->AsFortran(llvm::dbgs()
+ << "argument: " << arg.firArgument << " = [")
+ << "]\n");
+ if (arg.isOptional() && Fortran::evaluate::MayBePassedAsAbsentOptional(
+ *expr, converter.getFoldingContext()))
+ TODO(loc,
+ "passing dynamically optional argument to elemental procedures");
+ switch (arg.passBy) {
+ case PassBy::Value: {
+ // True pass-by-value semantics.
+ PushSemantics(ConstituentSemantics::RefTransparent);
+ operands.emplace_back(genElementalArgument(*expr));
+ } break;
+ case PassBy::BaseAddressValueAttribute: {
+ // VALUE attribute or pass-by-reference to a copy semantics. (byval*)
+ if (isArray(*expr)) {
+ PushSemantics(ConstituentSemantics::ByValueArg);
+ operands.emplace_back(genElementalArgument(*expr));
+ } else {
+ // Store scalar value in a temp to fulfill VALUE attribute.
+ mlir::Value val = fir::getBase(asScalar(*expr));
+ mlir::Value temp = builder.createTemporary(
+ loc, val.getType(),
+ llvm::ArrayRef<mlir::NamedAttribute>{
+ Fortran::lower::getAdaptToByRefAttr(builder)});
+ builder.create<fir::StoreOp>(loc, val, temp);
+ operands.emplace_back(
+ [=](IterSpace iters) -> ExtValue { return temp; });
+ }
+ } break;
+ case PassBy::BaseAddress: {
+ if (isArray(*expr)) {
+ PushSemantics(ConstituentSemantics::RefOpaque);
+ operands.emplace_back(genElementalArgument(*expr));
+ } else {
+ ExtValue exv = asScalarRef(*expr);
+ operands.emplace_back([=](IterSpace iters) { return exv; });
+ }
+ } break;
+ case PassBy::CharBoxValueAttribute: {
+ if (isArray(*expr)) {
+ PushSemantics(ConstituentSemantics::DataValue);
+ auto lambda = genElementalArgument(*expr);
+ operands.emplace_back([=](IterSpace iters) {
+ return fir::factory::CharacterExprHelper{builder, loc}
+ .createTempFrom(lambda(iters));
+ });
+ } else {
+ fir::factory::CharacterExprHelper helper(builder, loc);
+ fir::CharBoxValue argVal = helper.createTempFrom(asScalarRef(*expr));
+ operands.emplace_back(
+ [=](IterSpace iters) -> ExtValue { return argVal; });
+ }
+ } break;
+ case PassBy::BoxChar: {
+ PushSemantics(ConstituentSemantics::RefOpaque);
+ operands.emplace_back(genElementalArgument(*expr));
+ } break;
+ case PassBy::AddressAndLength:
+ // PassBy::AddressAndLength is only used for character results. Results
+ // are not handled here.
+ fir::emitFatalError(
+ loc, "unexpected PassBy::AddressAndLength in elemental call");
+ break;
+ case PassBy::CharProcTuple: {
+ ExtValue argRef = asScalarRef(*expr);
+ mlir::Value tuple = createBoxProcCharTuple(
+ converter, argTy, fir::getBase(argRef), fir::getLen(argRef));
+ operands.emplace_back(
+ [=](IterSpace iters) -> ExtValue { return tuple; });
+ } break;
+ case PassBy::Box:
+ case PassBy::MutableBox:
+ // See C15100 and C15101
+ fir::emitFatalError(loc, "cannot be POINTER, ALLOCATABLE");
+ }
+ }
+
+ if (caller.getIfIndirectCallSymbol())
+ fir::emitFatalError(loc, "cannot be indirect call");
+
+ // The lambda is mutable so that `caller` copy can be modified inside it.
+ return
+ [=, caller = std::move(caller)](IterSpace iters) mutable -> ExtValue {
+ for (const auto &[cc, argIface] :
+ llvm::zip(operands, caller.getPassedArguments())) {
+ auto exv = cc(iters);
+ auto arg = exv.match(
+ [&](const fir::CharBoxValue &cb) -> mlir::Value {
+ return fir::factory::CharacterExprHelper{builder, loc}
+ .createEmbox(cb);
+ },
+ [&](const auto &) { return fir::getBase(exv); });
+ caller.placeInput(argIface, arg);
+ }
+ return ScalarExprLowering{loc, converter, symMap, getElementCtx()}
+ .genCallOpAndResult(caller, callSiteType, retTy);
+ };
+ }
+
/// Generate a procedure reference. This code is shared for both functions and
/// subroutines, the
diff erence being reflected by `retTy`.
CC genProcRef(const Fortran::evaluate::ProcedureRef &procRef,
@@ -3767,7 +3936,9 @@ class ArrayExprLowering {
if (ScalarExprLowering::isStatementFunctionCall(procRef))
fir::emitFatalError(loc, "statement function cannot be elemental");
- TODO(loc, "elemental user defined proc ref");
+ // Elemental call.
+ // The procedure is called once per element of the array argument(s).
+ return genElementalUserDefinedProcRef(procRef, retTy);
}
// Transformational call.
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 302a1eaedb49e..6e2a0a21edc46 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -760,7 +760,9 @@ void Fortran::lower::mapSymbolAttributes(
// Lower lower bounds, explicit type parameters and explicit
// extents if any.
if (ba.isChar())
- TODO(loc, "lowerToBoxValue character");
+ if (mlir::Value len =
+ lowerExplicitCharLen(converter, loc, ba, symMap, stmtCtx))
+ explicitParams.push_back(len);
// TODO: derived type length parameters.
lowerExplicitLowerBounds(converter, loc, ba, lbounds, symMap, stmtCtx);
lowerExplicitExtents(converter, loc, ba, lbounds, extents, symMap,
diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp
index 3f2f036d7f12b..542a3b376a040 100644
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -236,6 +236,7 @@ struct IntrinsicLibrary {
mlir::Value genAbs(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genAssociated(mlir::Type,
llvm::ArrayRef<fir::ExtendedValue>);
+ fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
template <Extremum, ExtremumBehavior>
mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
/// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments
@@ -336,6 +337,7 @@ static constexpr IntrinsicHandler handlers[]{
&I::genAssociated,
{{{"pointer", asInquired}, {"target", asInquired}}},
/*isElemental=*/false},
+ {"char", &I::genChar},
{"iand", &I::genIand},
{"sum",
&I::genSum,
@@ -1092,6 +1094,24 @@ IntrinsicLibrary::genAssociated(mlir::Type resultType,
return Fortran::lower::genAssociated(builder, loc, pointerBox, targetBox);
}
+// CHAR
+fir::ExtendedValue
+IntrinsicLibrary::genChar(mlir::Type type,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ // Optional KIND argument.
+ assert(args.size() >= 1);
+ const mlir::Value *arg = args[0].getUnboxed();
+ // expect argument to be a scalar integer
+ if (!arg)
+ mlir::emitError(loc, "CHAR intrinsic argument not unboxed");
+ fir::factory::CharacterExprHelper helper{builder, loc};
+ fir::CharacterType::KindTy kind = helper.getCharacterType(type).getFKind();
+ mlir::Value cast = helper.createSingletonFromCode(*arg, kind);
+ mlir::Value len =
+ builder.createIntegerConstant(loc, builder.getCharacterLengthType(), 1);
+ return fir::CharBoxValue{cast, len};
+}
+
// IAND
mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
diff --git a/flang/lib/Lower/array-elemental-calls-2.f90 b/flang/lib/Lower/array-elemental-calls-2.f90
new file mode 100644
index 0000000000000..b08a20063a6af
--- /dev/null
+++ b/flang/lib/Lower/array-elemental-calls-2.f90
@@ -0,0 +1,202 @@
+! RUN: bbc -o - -emit-fir %s | FileCheck %s
+
+! Test lowering of operations sub-expression inside elemental call arguments.
+! This tests array contexts where an address is needed for each element (for
+! the argument), but part of the array sub-expression must be lowered by value
+! (for the operation)
+
+module test_ops
+ interface
+ integer elemental function elem_func(i)
+ integer, intent(in) :: i
+ end function
+ integer elemental function elem_func_logical(l)
+ logical(8), intent(in) :: l
+ end function
+ integer elemental function elem_func_logical4(l)
+ logical, intent(in) :: l
+ end function
+ integer elemental function elem_func_real(x)
+ real(8), value :: x
+ end function
+ end interface
+ integer :: i(10), j(10), iscalar
+ logical(8) :: a(10), b(10)
+ real(8) :: x(10), y(10)
+ complex(8) :: z1(10), z2
+
+ contains
+ ! CHECK-LABEL: func @_QMtest_opsPcheck_binary_ops() {
+ subroutine check_binary_ops()
+ print *, elem_func(i+j)
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca i32
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[VAL_25:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xi32>, index) -> i32
+ ! CHECK: %[[VAL_26:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xi32>, index) -> i32
+ ! CHECK: %[[VAL_27:.*]] = arith.addi %[[VAL_25]], %[[VAL_26]] : i32
+ ! CHECK: fir.store %[[VAL_27]] to %[[VAL_0]] : !fir.ref<i32>
+ ! CHECK: fir.call @_QPelem_func(%[[VAL_0]]) : (!fir.ref<i32>) -> i32
+ end subroutine
+
+ ! CHECK-LABEL: func @_QMtest_opsPcheck_binary_ops_2() {
+ subroutine check_binary_ops_2()
+ print *, elem_func(i*iscalar)
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca i32
+ ! CHECK: %[[VAL_13:.*]] = fir.load %{{.*}} : !fir.ref<i32>
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[VAL_25:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xi32>, index) -> i32
+ ! CHECK: %[[VAL_27:.*]] = arith.muli %[[VAL_25]], %[[VAL_13]] : i32
+ ! CHECK: fir.store %[[VAL_27]] to %[[VAL_0]] : !fir.ref<i32>
+ ! CHECK: fir.call @_QPelem_func(%[[VAL_0]]) : (!fir.ref<i32>) -> i32
+ end subroutine
+
+ ! CHECK-LABEL: func @_QMtest_opsPcheck_negate() {
+ subroutine check_negate()
+ print *, elem_func(-i)
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca i32
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[VAL_21:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xi32>, index) -> i32
+ ! CHECK: %[[VAL_22:.*]] = arith.constant 0 : i32
+ ! CHECK: %[[VAL_23:.*]] = arith.subi %[[VAL_22]], %[[VAL_21]] : i32
+ ! CHECK: fir.store %[[VAL_23]] to %[[VAL_0]] : !fir.ref<i32>
+ ! CHECK: fir.call @_QPelem_func(%[[VAL_0]]) : (!fir.ref<i32>) -> i32
+ end subroutine
+
+ ! CHECK-LABEL: func @_QMtest_opsPcheck_convert() {
+ subroutine check_convert()
+ print *, elem_func(int(x))
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca i32
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[VAL_21:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64
+ ! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (f64) -> i32
+ ! CHECK: fir.store %[[VAL_22]] to %[[VAL_0]] : !fir.ref<i32>
+ ! CHECK: fir.call @_QPelem_func(%[[VAL_0]]) : (!fir.ref<i32>) -> i32
+ end subroutine
+
+ ! CHECK-LABEL: func @_QMtest_opsPcheck_exteremum() {
+ subroutine check_exteremum()
+ print *, elem_func(min(i, j))
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca i32
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[VAL_25:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xi32>, index) -> i32
+ ! CHECK: %[[VAL_26:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xi32>, index) -> i32
+ ! CHECK: %[[VAL_27:.*]] = arith.cmpi slt, %[[VAL_25]], %[[VAL_26]] : i32
+ ! CHECK: %[[VAL_28:.*]] = select %[[VAL_27]], %[[VAL_25]], %[[VAL_26]] : i32
+ ! CHECK: fir.store %[[VAL_28]] to %[[VAL_0]] : !fir.ref<i32>
+ ! CHECK: fir.call @_QPelem_func(%[[VAL_0]]) : (!fir.ref<i32>) -> i32
+ end subroutine
+
+ ! CHECK-LABEL: func @_QMtest_opsPcheck_logical_unary_ops() {
+ subroutine check_logical_unary_ops()
+ print *, elem_func_logical(.not.b)
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.logical<8>
+ ! CHECK: %[[VAL_12:.*]] = arith.constant true
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[VAL_22:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10x!fir.logical<8>>, index) -> !fir.logical<8>
+ ! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (!fir.logical<8>) -> i1
+ ! CHECK: %[[VAL_24:.*]] = arith.xori %[[VAL_23]], %[[VAL_12]] : i1
+ ! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_24]] : (i1) -> !fir.logical<8>
+ ! CHECK: fir.store %[[VAL_25]] to %[[VAL_0]] : !fir.ref<!fir.logical<8>>
+ ! CHECK: fir.call @_QPelem_func_logical(%[[VAL_0]]) : (!fir.ref<!fir.logical<8>>) -> i32
+ end subroutine
+
+ ! CHECK-LABEL: func @_QMtest_opsPcheck_logical_binary_ops() {
+ subroutine check_logical_binary_ops()
+ print *, elem_func_logical(a.eqv.b)
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.logical<8>
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[VAL_25:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10x!fir.logical<8>>, index) -> !fir.logical<8>
+ ! CHECK: %[[VAL_26:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10x!fir.logical<8>>, index) -> !fir.logical<8>
+ ! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_25]] : (!fir.logical<8>) -> i1
+ ! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_26]] : (!fir.logical<8>) -> i1
+ ! CHECK: %[[VAL_29:.*]] = arith.cmpi eq, %[[VAL_27]], %[[VAL_28]] : i1
+ ! CHECK: %[[VAL_30:.*]] = fir.convert %[[VAL_29]] : (i1) -> !fir.logical<8>
+ ! CHECK: fir.store %[[VAL_30]] to %[[VAL_0]] : !fir.ref<!fir.logical<8>>
+ ! CHECK: fir.call @_QPelem_func_logical(%[[VAL_0]]) : (!fir.ref<!fir.logical<8>>) -> i32
+ end subroutine
+
+ ! CHECK-LABEL: func @_QMtest_opsPcheck_compare() {
+ subroutine check_compare()
+ print *, elem_func_logical4(x.lt.y)
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.logical<4>
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[VAL_25:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64
+ ! CHECK: %[[VAL_26:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64
+ ! CHECK: %[[VAL_27:.*]] = arith.cmpf olt, %[[VAL_25]], %[[VAL_26]] : f64
+ ! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[VAL_28]] to %[[VAL_0]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: fir.call @_QPelem_func_logical4(%[[VAL_0]]) : (!fir.ref<!fir.logical<4>>) -> i32
+ end subroutine
+
+ ! CHECK-LABEL: func @_QMtest_opsPcheck_pow() {
+ subroutine check_pow()
+ print *, elem_func_real(x**y)
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca f64
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[VAL_25:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64
+ ! CHECK: %[[VAL_26:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64
+ ! CHECK: %[[VAL_27:.*]] = fir.call @__fd_pow_1(%[[VAL_25]], %[[VAL_26]]) : (f64, f64) -> f64
+ ! CHECK: fir.store %[[VAL_27]] to %[[VAL_0]] : !fir.ref<f64>
+ ! CHECK: %[[VAL_28:.*]] = fir.call @_QPelem_func_real(%[[VAL_0]]) : (!fir.ref<f64>) -> i32
+ end subroutine
+
+ ! CHECK-LABEL: func @_QMtest_opsPcheck_cmplx_part() {
+ subroutine check_cmplx_part()
+ print *, elem_func_real(AIMAG(z1 + z2))
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca f64
+ ! CHECK: %[[VAL_13:.*]] = fir.load %{{.*}} : !fir.ref<!fir.complex<8>>
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[VAL_23:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10x!fir.complex<8>>, index) -> !fir.complex<8>
+ ! CHECK: %[[VAL_24:.*]] = fir.addc %[[VAL_23]], %[[VAL_13]] : !fir.complex<8>
+ ! CHECK: %[[VAL_25:.*]] = fir.extract_value %[[VAL_24]], [1 : index] : (!fir.complex<8>) -> f64
+ ! CHECK: fir.store %[[VAL_25]] to %[[VAL_0]] : !fir.ref<f64>
+ ! CHECK: fir.call @_QPelem_func_real(%[[VAL_0]]) : (!fir.ref<f64>) -> i32
+ end subroutine
+
+ ! CHECK-LABEL: func @_QMtest_opsPcheck_parentheses() {
+ subroutine check_parentheses()
+ print *, elem_func_real((x))
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca f64
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[VAL_21:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64
+ ! CHECK: %[[VAL_22:.*]] = fir.no_reassoc %[[VAL_21]] : f64
+ ! CHECK: fir.store %[[VAL_22]] to %[[VAL_0]] : !fir.ref<f64>
+ ! CHECK: fir.call @_QPelem_func_real(%[[VAL_0]]) : (!fir.ref<f64>) -> i32
+ end subroutine
+
+ ! CHECK-LABEL: func @_QMtest_opsPcheck_parentheses_logical() {
+ subroutine check_parentheses_logical()
+ print *, elem_func_logical((a))
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.logical<8>
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[VAL_21:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10x!fir.logical<8>>, index) -> !fir.logical<8>
+ ! CHECK: %[[VAL_22:.*]] = fir.no_reassoc %[[VAL_21]] : !fir.logical<8>
+ ! CHECK: fir.store %[[VAL_22]] to %[[VAL_0]] : !fir.ref<!fir.logical<8>>
+ ! CHECK: fir.call @_QPelem_func_logical(%[[VAL_0]]) : (!fir.ref<!fir.logical<8>>) -> i32
+ end subroutine
+
+ subroutine check_parentheses_derived(a)
+ type t
+ integer :: i
+ end type
+ interface
+ integer elemental function elem_func_derived(x)
+ import :: t
+ type(t), intent(in) :: x
+ end function
+ end interface
+ type(t), pointer :: a(:)
+ print *, elem_func_derived((a))
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.type<_QMtest_opsFcheck_parentheses_derivedTt{i:i32}>
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[VAL_21:.*]] = fir.array_access %{{.}}, %{{.*}}
+ ! CHECK: %[[VAL_22:.*]] = fir.no_reassoc %[[VAL_21]] : !fir.ref<!fir.type<_QMtest_opsFcheck_parentheses_derivedTt{i:i32}>>
+ ! CHECK: %[[FIELD:.*]] = fir.field_index i, !fir.type<_QMtest_opsFcheck_parentheses_derivedTt{i:i32}>
+ ! CHECK: %[[FROM:.*]] = fir.coordinate_of %[[VAL_22]], %[[FIELD]] : (!fir.ref<!fir.type<_QMtest_opsFcheck_parentheses_derivedTt{i:i32}>>, !fir.field) -> !fir.ref<i32>
+ ! CHECK: %[[TO:.*]] = fir.coordinate_of %[[VAL_0]], %[[FIELD]] : (!fir.ref<!fir.type<_QMtest_opsFcheck_parentheses_derivedTt{i:i32}>>, !fir.field) -> !fir.ref<i32>
+ ! CHECK: %[[VAL:.*]] = fir.load %[[FROM]] : !fir.ref<i32>
+ ! CHECK: fir.store %[[VAL]] to %[[TO]] : !fir.ref<i32>
+ ! CHECK: %25 = fir.call @_QPelem_func_derived(%[[VAL_0]]) : (!fir.ref<!fir.type<_QMtest_opsFcheck_parentheses_derivedTt{i:i32}>>) -> i32
+ end subroutine
+ end module
+
\ No newline at end of file
diff --git a/flang/test/Lower/array-elemental-calls.f90 b/flang/test/Lower/array-elemental-calls.f90
new file mode 100644
index 0000000000000..3319c7a92f75e
--- /dev/null
+++ b/flang/test/Lower/array-elemental-calls.f90
@@ -0,0 +1,106 @@
+! Test lowering of elemental calls in array expressions.
+! RUN: bbc -o - -emit-fir %s | FileCheck %s
+
+module scalar_in_elem
+
+ contains
+ elemental integer function elem_by_ref(a,b) result(r)
+ integer, intent(in) :: a
+ real, intent(in) :: b
+ r = a + b
+ end function
+ elemental integer function elem_by_valueref(a,b) result(r)
+ integer, value :: a
+ real, value :: b
+ r = a + b
+ end function
+
+ ! CHECK-LABEL: func @_QMscalar_in_elemPtest_elem_by_ref(
+ ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.array<100xi32>>{{.*}}, %[[arg1:.*]]: !fir.ref<!fir.array<100xi32>>{{.*}}) {
+ subroutine test_elem_by_ref(i, j)
+ integer :: i(100), j(100)
+ ! CHECK: %[[tmp:.*]] = fir.alloca f32
+ ! CHECK: %[[cst:.*]] = arith.constant 4.200000e+01 : f32
+ ! CHECK: fir.store %[[cst]] to %[[tmp]] : !fir.ref<f32>
+
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[j:.*]] = fir.array_coor %[[arg1]](%{{.*}}) %{{.*}} : (!fir.ref<!fir.array<100xi32>>, !fir.shape<1>, index) -> !fir.ref<i32>
+ ! CHECK: fir.call @_QMscalar_in_elemPelem_by_ref(%[[j]], %[[tmp]]) : (!fir.ref<i32>, !fir.ref<f32>) -> i32
+ ! CHECK: fir.result
+ i = elem_by_ref(j, 42.)
+ end
+
+ ! CHECK-LABEL: func @_QMscalar_in_elemPtest_elem_by_valueref(
+ ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.array<100xi32>>{{.*}}, %[[arg1:.*]]: !fir.ref<!fir.array<100xi32>>{{.*}}) {
+ subroutine test_elem_by_valueref(i, j)
+ integer :: i(100), j(100)
+ ! CHECK-DAG: %[[tmpA:.*]] = fir.alloca i32 {adapt.valuebyref}
+ ! CHECK-DAG: %[[tmpB:.*]] = fir.alloca f32 {adapt.valuebyref}
+ ! CHECK: %[[jload:.*]] = fir.array_load %[[arg1]]
+ ! CHECK: %[[cst:.*]] = arith.constant 4.200000e+01 : f32
+ ! CHECK: fir.store %[[cst]] to %[[tmpB]] : !fir.ref<f32>
+
+ ! CHECK: fir.do_loop
+ ! CHECK: %[[j:.*]] = fir.array_fetch %[[jload]], %{{.*}} : (!fir.array<100xi32>, index) -> i32
+ ! CHECK: fir.store %[[j]] to %[[tmpA]] : !fir.ref<i32>
+ ! CHECK: fir.call @_QMscalar_in_elemPelem_by_valueref(%[[tmpA]], %[[tmpB]]) : (!fir.ref<i32>, !fir.ref<f32>) -> i32
+ ! CHECK: fir.result
+ i = elem_by_valueref(j, 42.)
+ end
+ end module
+
+
+ ! Test that impure elemental functions cause ordered loops to be emitted
+ subroutine test_loop_order(i, j)
+ integer :: i(:), j(:)
+ interface
+ elemental integer function pure_func(j)
+ integer, intent(in) :: j
+ end function
+ elemental impure integer function impure_func(j)
+ integer, intent(in) :: j
+ end function
+ end interface
+
+ i = 42 + pure_func(j)
+ i = 42 + impure_func(j)
+ end subroutine
+
+ ! CHECK-LABEL: func @_QPtest_loop_order(
+ ! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xi32>>{{.*}}, %[[VAL_1:.*]]: !fir.box<!fir.array<?xi32>>{{.*}}) {
+ ! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index
+ ! CHECK: %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_2]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index)
+ ! CHECK: %[[VAL_4:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?xi32>>) -> !fir.array<?xi32>
+ ! CHECK: %[[VAL_5:.*]] = arith.constant 42 : i32
+ ! CHECK: %[[VAL_6:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index
+ ! CHECK: %[[VAL_8:.*]] = arith.subi %[[VAL_3]]#1, %[[VAL_6]] : index
+ ! CHECK: %[[VAL_9:.*]] = fir.do_loop %[[VAL_10:.*]] = %[[VAL_7]] to %[[VAL_8]] step %[[VAL_6]] unordered iter_args(%[[VAL_11:.*]] = %[[VAL_4]]) -> (!fir.array<?xi32>) {
+ ! CHECK: %[[VAL_12:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_13:.*]] = arith.addi %[[VAL_10]], %[[VAL_12]] : index
+ ! CHECK: %[[VAL_14:.*]] = fir.array_coor %[[VAL_1]] %[[VAL_13]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_15:.*]] = fir.call @_QPpure_func(%[[VAL_14]]) : (!fir.ref<i32>) -> i32
+ ! CHECK: %[[VAL_16:.*]] = arith.addi %[[VAL_5]], %[[VAL_15]] : i32
+ ! CHECK: %[[VAL_17:.*]] = fir.array_update %[[VAL_11]], %[[VAL_16]], %[[VAL_10]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+ ! CHECK: fir.result %[[VAL_17]] : !fir.array<?xi32>
+ ! CHECK: }
+ ! CHECK: fir.array_merge_store %[[VAL_4]], %[[VAL_18:.*]] to %[[VAL_0]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?xi32>>
+ ! CHECK: %[[VAL_19:.*]] = arith.constant 0 : index
+ ! CHECK: %[[VAL_20:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_19]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index)
+ ! CHECK: %[[VAL_21:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?xi32>>) -> !fir.array<?xi32>
+ ! CHECK: %[[VAL_22:.*]] = arith.constant 42 : i32
+ ! CHECK: %[[VAL_23:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_24:.*]] = arith.constant 0 : index
+ ! CHECK: %[[VAL_25:.*]] = arith.subi %[[VAL_20]]#1, %[[VAL_23]] : index
+ ! CHECK: %[[VAL_26:.*]] = fir.do_loop %[[VAL_27:.*]] = %[[VAL_24]] to %[[VAL_25]] step %[[VAL_23]] iter_args(%[[VAL_28:.*]] = %[[VAL_21]]) -> (!fir.array<?xi32>) {
+ ! CHECK: %[[VAL_29:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_30:.*]] = arith.addi %[[VAL_27]], %[[VAL_29]] : index
+ ! CHECK: %[[VAL_31:.*]] = fir.array_coor %[[VAL_1]] %[[VAL_30]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_32:.*]] = fir.call @_QPimpure_func(%[[VAL_31]]) : (!fir.ref<i32>) -> i32
+ ! CHECK: %[[VAL_33:.*]] = arith.addi %[[VAL_22]], %[[VAL_32]] : i32
+ ! CHECK: %[[VAL_34:.*]] = fir.array_update %[[VAL_28]], %[[VAL_33]], %[[VAL_27]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
+ ! CHECK: fir.result %[[VAL_34]] : !fir.array<?xi32>
+ ! CHECK: }
+ ! CHECK: fir.array_merge_store %[[VAL_21]], %[[VAL_35:.*]] to %[[VAL_0]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?xi32>>
+ ! CHECK: return
+ ! CHECK: }
More information about the flang-commits
mailing list