shylie/llvm-project
1
0
Fork 0
Code Issues Pull Requests Actions 6 Packages Projects Releases Wiki Activity
llvm-project/flang/lib/Lower/HlfirIntrinsics.cpp
Sairudra More d0ddae678e
[flang] Fix segfault in CSHIFT/EOSHIFT with dynamically optional DIM (#184431) 
When `DIM` is passed as an optional dummy argument and is absent at
runtime, the HLFIR lowering for the `CSHIFT` and `EOSHIFT` intrinsics
treated it as unconditionally present. This resulted in an unconditional
load of the `DIM` reference, causing a null pointer dereference and a
runtime segmentation fault when absent.

The underlying issue was that the `dim` argument for `cshift` and
`eoshift` was not marked with `handleDynamicOptional` during intrinsic
argument lowering setup. As a result, the `isPresent` state was never
populated, and the lowering implementation incorrectly fell through to
an unconditional scalar load.

This patch resolves the issue by:
1. Updating the `dim` entries for `cshift` and `eoshift` in
`IntrinsicCall.cpp` to use `handleDynamicOptional`. This enables
`getOperandVector()` to appropriately emit a guarded load (via
`loadOptionalValue()`) that safely returns a 0 placeholder when `DIM` is
absent.
2. Updating the HLFIR lowering implementations (`HlfirCShiftLowering`
and `HlfirEOShiftLowering`) to use the loaded scalar. It now employs an
`arith.select` to substitute the 0 placeholder with the
standard-mandated default of 1 when `isPresent` is false, matching the
Fortran requirements (§16.9.68 and §16.9.77) without generating
redundant `fir.if` or `fir.load` operations. Explicit `DIM=0` calls
still correctly forward the 0 value to flang-rt to trigger the
appropriate runtime bounds check error.

Co-authored-by: Sairudra More <moresair@pe31.hpc.amslabs.hpecorp.net>
2026-03-09 10:54:25 +05:30

674 lines
27 KiB
C++
Raw Permalink Blame History

//===-- 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/BoxValue.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/HLFIRTools.h"
#include "flang/Optimizer/Builder/IntrinsicCall.h"
#include "flang/Optimizer/Builder/MutableBox.h"
#include "flang/Optimizer/Builder/Todo.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);
for (const hlfir::CleanupFunction &fn : cleanupFns)
fn();
return {hlfir::EntityWithAttributes{res}};
}
protected:
fir::FirOpBuilder &builder;
mlir::Location loc;
llvm::SmallVector<hlfir::CleanupFunction, 3> cleanupFns;
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 OP::create(builder, loc, args...);
}
mlir::Value loadBoxAddress(
const std::optional<Fortran::lower::PreparedActualArgument> &arg);
mlir::Value
loadTrivialScalar(const Fortran::lower::PreparedActualArgument &arg);
mlir::Value loadOptionalValue(Fortran::lower::PreparedActualArgument &arg);
void addCleanup(std::optional<hlfir::CleanupFunction> cleanup) {
if (cleanup)
cleanupFns.emplace_back(std::move(*cleanup));
}
};
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 HlfirMaxvalLowering = HlfirReductionIntrinsic<hlfir::MaxvalOp, true>;
using HlfirMinvalLowering = HlfirReductionIntrinsic<hlfir::MinvalOp, true>;
using HlfirAnyLowering = HlfirReductionIntrinsic<hlfir::AnyOp, false>;
using HlfirAllLowering = HlfirReductionIntrinsic<hlfir::AllOp, false>;
template <typename OP>
class HlfirMinMaxLocIntrinsic : public HlfirTransformationalIntrinsic {
public:
using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
protected:
mlir::Value
lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering,
mlir::Type stmtResultType) override;
};
using HlfirMinlocLowering = HlfirMinMaxLocIntrinsic<hlfir::MinlocOp>;
using HlfirMaxlocLowering = HlfirMinMaxLocIntrinsic<hlfir::MaxlocOp>;
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;
};
class HlfirCharTrimLowering : public HlfirTransformationalIntrinsic {
public:
HlfirCharTrimLowering(fir::FirOpBuilder &builder, mlir::Location loc)
: HlfirTransformationalIntrinsic(builder, loc) {}
protected:
mlir::Value
lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering,
mlir::Type stmtResultType) override;
};
class HlfirCShiftLowering : public HlfirTransformationalIntrinsic {
public:
using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
protected:
mlir::Value
lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering,
mlir::Type stmtResultType) override;
};
class HlfirEOShiftLowering : public HlfirTransformationalIntrinsic {
public:
using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
protected:
mlir::Value
lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering,
mlir::Type stmtResultType) override;
};
class HlfirReshapeLowering : public HlfirTransformationalIntrinsic {
public:
using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
protected:
mlir::Value
lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering,
mlir::Type stmtResultType) override;
};
class HlfirIndexLowering : public HlfirTransformationalIntrinsic {
public:
using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
protected:
mlir::Value
lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering,
mlir::Type stmtResultType) override;
};
struct HlfirLenLowering : public HlfirTransformationalIntrinsic {
using HlfirTransformationalIntrinsic::HlfirTransformationalIntrinsic;
mlir::Value
lowerImpl(const Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering,
mlir::Type stmtResultType) override;
};
} // namespace
mlir::Value HlfirTransformationalIntrinsic::loadBoxAddress(
const std::optional<Fortran::lower::PreparedActualArgument> &arg) {
if (!arg)
return mlir::Value{};
hlfir::Entity actual = arg->getActual(loc, builder);
if (!arg->handleDynamicOptional()) {
if (actual.isMutableBox()) {
// this is a box address type but is not dynamically optional. Just load
// the box, assuming it is well formed (!fir.ref<!fir.box<...>> ->
// !fir.box<...>)
return fir::LoadOp::create(builder, loc, actual.getBase());
}
return actual;
}
auto [exv, cleanup] = hlfir::translateToExtendedValue(loc, builder, actual);
addCleanup(cleanup);
mlir::Value isPresent = arg->getIsPresent();
// createBox will not do create any invalid memory dereferences if exv is
// absent. The created fir.box will not be usable, but the SelectOp below
// ensures it won't be.
mlir::Value box = builder.createBox(loc, exv);
mlir::Type boxType = box.getType();
auto absent = fir::AbsentOp::create(builder, loc, boxType);
auto boxOrAbsent = mlir::arith::SelectOp::create(builder, loc, boxType,
isPresent, box, absent);
return boxOrAbsent;
}
mlir::Value HlfirTransformationalIntrinsic::loadOptionalValue(
Fortran::lower::PreparedActualArgument &arg) {
mlir::Type eleType = arg.getFortranElementType();
// For an elemental call, getActual() may produce
// a designator denoting the array element to be passed
// to the subprogram. If the actual array is dynamically
// optional the designator must be generated under
// isPresent check (see also genIntrinsicRefCore).
return builder
.genIfOp(loc, {eleType}, arg.getIsPresent(),
/*withElseRegion=*/true)
.genThen([&]() {
hlfir::Entity actual = arg.getActual(loc, builder);
assert(eleType == actual.getFortranElementType() &&
"result type mismatch in genOptionalValue");
assert(actual.isScalar() && fir::isa_trivial(eleType) &&
"must be a numerical or logical scalar");
hlfir::Entity val = hlfir::loadTrivialScalar(loc, builder, actual);
fir::ResultOp::create(builder, loc, val);
})
.genElse([&]() {
mlir::Value zero = fir::factory::createZeroValue(builder, loc, eleType);
fir::ResultOp::create(builder, loc, zero);
})
.getResults()[0];
}
mlir::Value HlfirTransformationalIntrinsic::loadTrivialScalar(
const Fortran::lower::PreparedActualArgument &arg) {
hlfir::Entity actual = arg.getActual(loc, builder);
return hlfir::loadTrivialScalar(loc, builder, actual);
}
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;
}
mlir::Value valArg;
if (!argLowering) {
valArg = loadTrivialScalar(*arg);
operands.emplace_back(valArg);
continue;
}
fir::ArgLoweringRule argRules =
fir::lowerIntrinsicArgumentAs(*argLowering, i);
if (argRules.lowerAs == fir::LowerIntrinsicArgAs::Box) {
valArg = loadBoxAddress(arg);
} else if (argRules.handleDynamicOptional) {
if (argRules.lowerAs == fir::LowerIntrinsicArgAs::Value) {
if (arg->handleDynamicOptional())
valArg = loadOptionalValue(*arg);
else
valArg = loadTrivialScalar(*arg);
} else {
TODO(loc, "hlfir transformational intrinsic dynamically optional "
"argument without box lowering");
}
} else {
hlfir::Entity actual = arg->getActual(loc, builder);
if (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 = mlir::dyn_cast<fir::SequenceType>(normalisedResult)) {
hlfir::ExprType::Shape resultShape =
hlfir::ExprType::Shape{array.getShape()};
mlir::Type elementType = array.getEleTy();
return hlfir::ExprType::get(builder.getContext(), resultShape, elementType,
fir::isPolymorphicType(stmtResultType));
} else if (auto resCharType =
mlir::dyn_cast<fir::CharacterType>(stmtResultType)) {
normalisedResult = hlfir::ExprType::get(
builder.getContext(), hlfir::ExprType::Shape{}, resCharType,
/*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 HlfirMinMaxLocIntrinsic<OP>::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];
mlir::Value mask = operands[2];
mlir::Value back = operands[4];
// dim, mask and back can be NULL if these arguments are not given.
if (dim)
dim = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{dim});
if (back)
back = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{back});
mlir::Type resultTy = computeResultType(array, stmtResultType);
return createOp<OP>(resultTy, array, dim, mask, back);
}
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 = mlir::cast<fir::SequenceType>(normalisedResult);
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]);
if (auto resCharType = mlir::dyn_cast<fir::CharacterType>(elementType))
if (!resCharType.hasConstantLen()) {
// The FunctionRef expression might have imprecise character
// type at this point, and we can improve it by propagating
// the constant length from the argument.
auto argCharType = mlir::dyn_cast<fir::CharacterType>(
hlfir::getFortranElementType(operands[0].getType()));
if (argCharType && argCharType.hasConstantLen())
elementType = fir::CharacterType::get(
builder.getContext(), resCharType.getFKind(), argCharType.getLen());
}
mlir::Type resultTy =
hlfir::ExprType::get(builder.getContext(), resultShape, elementType,
fir::isPolymorphicType(stmtResultType));
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::Type resultType = computeResultType(array, stmtResultType);
return createOp<hlfir::CountOp>(resultType, array, dim);
}
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});
}
mlir::Value HlfirCharTrimLowering::lowerImpl(
const Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering,
mlir::Type stmtResultType) {
auto operands = getOperandVector(loweredActuals, argLowering);
assert(operands.size() == 1);
return createOp<hlfir::CharTrimOp>(operands[0]);
}
mlir::Value HlfirCShiftLowering::lowerImpl(
const Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering,
mlir::Type stmtResultType) {
auto operands = getOperandVector(loweredActuals, argLowering);
assert(operands.size() == 3);
mlir::Value dim = operands[2];
if (!dim) {
// If DIM is not present, drop the last element which is a null Value.
operands.truncate(2);
} else if (loweredActuals[2] && loweredActuals[2]->handleDynamicOptional()) {
// Use getIsPresent() to select between a present DIM value or
// the default 1 per Fortran 16.9.68.
mlir::Value isPresent = loweredActuals[2]->getIsPresent();
mlir::Type dimType = dim.getType();
mlir::Value one = builder.createIntegerConstant(loc, dimType, 1);
dim = mlir::arith::SelectOp::create(builder, loc, isPresent, dim, one);
operands[2] = dim;
} else {
// If DIM is present, then dereference it if it is a ref.
dim = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{dim});
operands[2] = dim;
}
mlir::Type resultType = computeResultType(operands[0], stmtResultType);
return createOp<hlfir::CShiftOp>(resultType, operands);
}
mlir::Value HlfirEOShiftLowering::lowerImpl(
const Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering,
mlir::Type stmtResultType) {
auto operands = getOperandVector(loweredActuals, argLowering);
assert(operands.size() == 4);
mlir::Value array = operands[0];
mlir::Value shift = operands[1];
mlir::Value boundary = operands[2];
mlir::Value dim = operands[3];
if (loweredActuals[3] && loweredActuals[3]->handleDynamicOptional()) {
// Use getIsPresent() to select between a present DIM value or
// the default 1 per Fortran 16.9.77.
mlir::Value isPresent = loweredActuals[3]->getIsPresent();
mlir::Type dimType = dim.getType();
mlir::Value one = builder.createIntegerConstant(loc, dimType, 1);
dim = mlir::arith::SelectOp::create(builder, loc, isPresent, dim, one);
} else if (dim) {
// If DIM is statically present, dereference it if it is a ref.
dim = hlfir::loadTrivialScalar(loc, builder, hlfir::Entity{dim});
}
mlir::Type resultType = computeResultType(array, stmtResultType);
if (boundary && fir::isa_trivial(boundary.getType())) {
mlir::Type elementType = hlfir::getFortranElementType(resultType);
if (auto logicalTy = mlir::dyn_cast<fir::LogicalType>(elementType)) {
// Scalar logical constant boundary might be represented using i1, i2, ...
// type. We need to cast it to fir.logical type of the ARRAY/result.
if (boundary.getType() != logicalTy)
boundary = builder.createConvert(loc, logicalTy, boundary);
} else {
// When the boundary is a constant like '1u', the lowering converts
// it into a signless arith.constant value (which is a requirement
// of the Arith dialect). If the ARRAY/RESULT is also UNSIGNED,
// we have to cast the boundary to the same unsigned type.
auto resultIntTy = mlir::dyn_cast<mlir::IntegerType>(elementType);
auto boundaryIntTy =
mlir::dyn_cast<mlir::IntegerType>(boundary.getType());
if (resultIntTy && boundaryIntTy &&
resultIntTy.getSignedness() != boundaryIntTy.getSignedness())
boundary = builder.createConvert(loc, resultIntTy, boundary);
}
}
return createOp<hlfir::EOShiftOp>(resultType, array, shift, boundary, dim);
}
mlir::Value HlfirReshapeLowering::lowerImpl(
const Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering,
mlir::Type stmtResultType) {
auto operands = getOperandVector(loweredActuals, argLowering);
assert(operands.size() == 4);
mlir::Type resultType = computeResultType(operands[0], stmtResultType);
return createOp<hlfir::ReshapeOp>(resultType, operands[0], operands[1],
operands[2], operands[3]);
}
mlir::Value HlfirIndexLowering::lowerImpl(
const Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering,
mlir::Type stmtResultType) {
auto operands = getOperandVector(loweredActuals, argLowering);
// 'kind' optional operand is unused here as it has already been
// translated into result type.
assert(operands.size() == 4);
mlir::Value substr = operands[1];
mlir::Value str = operands[0];
mlir::Value back = operands[2];
mlir::Value result =
createOp<hlfir::IndexOp>(stmtResultType, substr, str, back);
return result;
}
mlir::Value HlfirLenLowering::lowerImpl(
const Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering,
mlir::Type stmtResultType) {
// LEN (STRING [, KIND])
assert((loweredActuals.size() == 1 || loweredActuals.size() == 2) &&
loweredActuals[0].has_value());
Fortran::lower::PreparedActualArgument &strArg =
const_cast<Fortran::lower::PreparedActualArgument &>(*loweredActuals[0]);
return builder.createConvert(loc, stmtResultType,
strArg.genCharLength(loc, builder));
}
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 the result is of a derived type that may need finalization,
// we have to use DestroyOp with 'finalize' attribute for the result
// of the intrinsic operation.
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);
// FIXME: the result may need finalization.
if (name == "transpose")
return HlfirTransposeLowering{builder, loc}.lower(
loweredActuals, argLowering, stmtResultType);
if (name == "count")
return HlfirCountLowering{builder, loc}.lower(loweredActuals, argLowering,
stmtResultType);
if (name == "maxval")
return HlfirMaxvalLowering{builder, loc}.lower(loweredActuals, argLowering,
stmtResultType);
if (name == "minval")
return HlfirMinvalLowering{builder, loc}.lower(loweredActuals, argLowering,
stmtResultType);
if (name == "minloc")
return HlfirMinlocLowering{builder, loc}.lower(loweredActuals, argLowering,
stmtResultType);
if (name == "maxloc")
return HlfirMaxlocLowering{builder, loc}.lower(loweredActuals, argLowering,
stmtResultType);
if (name == "cshift")
return HlfirCShiftLowering{builder, loc}.lower(loweredActuals, argLowering,
stmtResultType);
if (name == "eoshift")
return HlfirEOShiftLowering{builder, loc}.lower(loweredActuals, argLowering,
stmtResultType);
if (name == "reshape")
return HlfirReshapeLowering{builder, loc}.lower(loweredActuals, argLowering,
stmtResultType);
if (name == "index")
return HlfirIndexLowering{builder, loc}.lower(loweredActuals, argLowering,
stmtResultType);
if (name == "len")
return HlfirLenLowering{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);
if (name == "trim")
return HlfirCharTrimLowering{builder, loc}.lower(
loweredActuals, argLowering, stmtResultType);
}
return std::nullopt;
}
Reference in New Issue View Git Blame Copy Permalink