fc97d2e68b
Implement the UNSIGNED extension type and operations under control of a language feature flag (-funsigned). This is nearly identical to the UNSIGNED feature that has been available in Sun Fortran for years, and now implemented in GNU Fortran for gfortran 15, and proposed for ISO standardization in J3/24-116.txt. See the new documentation for details; but in short, this is C's unsigned type, with guaranteed modular arithmetic for +, -, and *, and the related transformational intrinsic functions SUM & al.
439 lines
17 KiB
C++
439 lines
17 KiB
C++
//===-- lib/Evaluate/fold-reduction.h -------------------------------------===//
|
|
//
|
|
// 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
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
#ifndef FORTRAN_EVALUATE_FOLD_REDUCTION_H_
|
|
#define FORTRAN_EVALUATE_FOLD_REDUCTION_H_
|
|
|
|
#include "fold-implementation.h"
|
|
|
|
namespace Fortran::evaluate {
|
|
|
|
// DOT_PRODUCT
|
|
template <typename T>
|
|
static Expr<T> FoldDotProduct(
|
|
FoldingContext &context, FunctionRef<T> &&funcRef) {
|
|
using Element = typename Constant<T>::Element;
|
|
auto args{funcRef.arguments()};
|
|
CHECK(args.size() == 2);
|
|
Folder<T> folder{context};
|
|
Constant<T> *va{folder.Folding(args[0])};
|
|
Constant<T> *vb{folder.Folding(args[1])};
|
|
if (va && vb) {
|
|
CHECK(va->Rank() == 1 && vb->Rank() == 1);
|
|
if (va->size() != vb->size()) {
|
|
context.messages().Say(
|
|
"Vector arguments to DOT_PRODUCT have distinct extents %zd and %zd"_err_en_US,
|
|
va->size(), vb->size());
|
|
return MakeInvalidIntrinsic(std::move(funcRef));
|
|
}
|
|
Element sum{};
|
|
bool overflow{false};
|
|
if constexpr (T::category == TypeCategory::Complex) {
|
|
std::vector<Element> conjugates;
|
|
for (const Element &x : va->values()) {
|
|
conjugates.emplace_back(x.CONJG());
|
|
}
|
|
Constant<T> conjgA{
|
|
std::move(conjugates), ConstantSubscripts{va->shape()}};
|
|
Expr<T> products{Fold(
|
|
context, Expr<T>{std::move(conjgA)} * Expr<T>{Constant<T>{*vb}})};
|
|
Constant<T> &cProducts{DEREF(UnwrapConstantValue<T>(products))};
|
|
[[maybe_unused]] Element correction{};
|
|
const auto &rounding{context.targetCharacteristics().roundingMode()};
|
|
for (const Element &x : cProducts.values()) {
|
|
if constexpr (useKahanSummation) {
|
|
auto next{x.Subtract(correction, rounding)};
|
|
overflow |= next.flags.test(RealFlag::Overflow);
|
|
auto added{sum.Add(next.value, rounding)};
|
|
overflow |= added.flags.test(RealFlag::Overflow);
|
|
correction = added.value.Subtract(sum, rounding)
|
|
.value.Subtract(next.value, rounding)
|
|
.value;
|
|
sum = std::move(added.value);
|
|
} else {
|
|
auto added{sum.Add(x, rounding)};
|
|
overflow |= added.flags.test(RealFlag::Overflow);
|
|
sum = std::move(added.value);
|
|
}
|
|
}
|
|
} else if constexpr (T::category == TypeCategory::Logical) {
|
|
Expr<T> conjunctions{Fold(context,
|
|
Expr<T>{LogicalOperation<T::kind>{LogicalOperator::And,
|
|
Expr<T>{Constant<T>{*va}}, Expr<T>{Constant<T>{*vb}}}})};
|
|
Constant<T> &cConjunctions{DEREF(UnwrapConstantValue<T>(conjunctions))};
|
|
for (const Element &x : cConjunctions.values()) {
|
|
if (x.IsTrue()) {
|
|
sum = Element{true};
|
|
break;
|
|
}
|
|
}
|
|
} else if constexpr (T::category == TypeCategory::Integer) {
|
|
Expr<T> products{
|
|
Fold(context, Expr<T>{Constant<T>{*va}} * Expr<T>{Constant<T>{*vb}})};
|
|
Constant<T> &cProducts{DEREF(UnwrapConstantValue<T>(products))};
|
|
for (const Element &x : cProducts.values()) {
|
|
auto next{sum.AddSigned(x)};
|
|
overflow |= next.overflow;
|
|
sum = std::move(next.value);
|
|
}
|
|
} else if constexpr (T::category == TypeCategory::Unsigned) {
|
|
Expr<T> products{
|
|
Fold(context, Expr<T>{Constant<T>{*va}} * Expr<T>{Constant<T>{*vb}})};
|
|
Constant<T> &cProducts{DEREF(UnwrapConstantValue<T>(products))};
|
|
for (const Element &x : cProducts.values()) {
|
|
sum = sum.AddUnsigned(x).value;
|
|
}
|
|
} else {
|
|
static_assert(T::category == TypeCategory::Real);
|
|
Expr<T> products{
|
|
Fold(context, Expr<T>{Constant<T>{*va}} * Expr<T>{Constant<T>{*vb}})};
|
|
Constant<T> &cProducts{DEREF(UnwrapConstantValue<T>(products))};
|
|
[[maybe_unused]] Element correction{};
|
|
const auto &rounding{context.targetCharacteristics().roundingMode()};
|
|
for (const Element &x : cProducts.values()) {
|
|
if constexpr (useKahanSummation) {
|
|
auto next{x.Subtract(correction, rounding)};
|
|
overflow |= next.flags.test(RealFlag::Overflow);
|
|
auto added{sum.Add(next.value, rounding)};
|
|
overflow |= added.flags.test(RealFlag::Overflow);
|
|
correction = added.value.Subtract(sum, rounding)
|
|
.value.Subtract(next.value, rounding)
|
|
.value;
|
|
sum = std::move(added.value);
|
|
} else {
|
|
auto added{sum.Add(x, rounding)};
|
|
overflow |= added.flags.test(RealFlag::Overflow);
|
|
sum = std::move(added.value);
|
|
}
|
|
}
|
|
}
|
|
if (overflow &&
|
|
context.languageFeatures().ShouldWarn(
|
|
common::UsageWarning::FoldingException)) {
|
|
context.messages().Say(common::UsageWarning::FoldingException,
|
|
"DOT_PRODUCT of %s data overflowed during computation"_warn_en_US,
|
|
T::AsFortran());
|
|
}
|
|
return Expr<T>{Constant<T>{std::move(sum)}};
|
|
}
|
|
return Expr<T>{std::move(funcRef)};
|
|
}
|
|
|
|
// Fold and validate a DIM= argument. Returns false on error.
|
|
bool CheckReductionDIM(std::optional<int> &dim, FoldingContext &,
|
|
ActualArguments &, std::optional<int> dimIndex, int rank);
|
|
|
|
// Fold and validate a MASK= argument. Return null on error, absent MASK=, or
|
|
// non-constant MASK=.
|
|
Constant<LogicalResult> *GetReductionMASK(
|
|
std::optional<ActualArgument> &maskArg, const ConstantSubscripts &shape,
|
|
FoldingContext &);
|
|
|
|
// Common preprocessing for reduction transformational intrinsic function
|
|
// folding. If the intrinsic can have DIM= &/or MASK= arguments, extract
|
|
// and check them. If a MASK= is present, apply it to the array data and
|
|
// substitute replacement values for elements corresponding to .FALSE. in
|
|
// the mask. If the result is present, the intrinsic call can be folded.
|
|
template <typename T> struct ArrayAndMask {
|
|
Constant<T> array;
|
|
Constant<LogicalResult> mask;
|
|
};
|
|
template <typename T>
|
|
static std::optional<ArrayAndMask<T>> ProcessReductionArgs(
|
|
FoldingContext &context, ActualArguments &arg, std::optional<int> &dim,
|
|
int arrayIndex, std::optional<int> dimIndex = std::nullopt,
|
|
std::optional<int> maskIndex = std::nullopt) {
|
|
if (arg.empty()) {
|
|
return std::nullopt;
|
|
}
|
|
Constant<T> *folded{Folder<T>{context}.Folding(arg[arrayIndex])};
|
|
if (!folded || folded->Rank() < 1) {
|
|
return std::nullopt;
|
|
}
|
|
if (!CheckReductionDIM(dim, context, arg, dimIndex, folded->Rank())) {
|
|
return std::nullopt;
|
|
}
|
|
std::size_t n{folded->size()};
|
|
std::vector<Scalar<LogicalResult>> maskElement;
|
|
if (maskIndex && static_cast<std::size_t>(*maskIndex) < arg.size() &&
|
|
arg[*maskIndex]) {
|
|
if (const Constant<LogicalResult> *origMask{
|
|
GetReductionMASK(arg[*maskIndex], folded->shape(), context)}) {
|
|
if (auto scalarMask{origMask->GetScalarValue()}) {
|
|
maskElement =
|
|
std::vector<Scalar<LogicalResult>>(n, scalarMask->IsTrue());
|
|
} else {
|
|
maskElement = origMask->values();
|
|
}
|
|
} else {
|
|
return std::nullopt;
|
|
}
|
|
} else {
|
|
maskElement = std::vector<Scalar<LogicalResult>>(n, true);
|
|
}
|
|
return ArrayAndMask<T>{Constant<T>(*folded),
|
|
Constant<LogicalResult>{
|
|
std::move(maskElement), ConstantSubscripts{folded->shape()}}};
|
|
}
|
|
|
|
// Generalized reduction to an array of one dimension fewer (w/ DIM=)
|
|
// or to a scalar (w/o DIM=). The ACCUMULATOR type must define
|
|
// operator()(Scalar<T> &, const ConstantSubscripts &, bool first)
|
|
// and Done(Scalar<T> &).
|
|
template <typename T, typename ACCUMULATOR, typename ARRAY>
|
|
static Constant<T> DoReduction(const Constant<ARRAY> &array,
|
|
const Constant<LogicalResult> &mask, std::optional<int> &dim,
|
|
const Scalar<T> &identity, ACCUMULATOR &accumulator) {
|
|
ConstantSubscripts at{array.lbounds()};
|
|
ConstantSubscripts maskAt{mask.lbounds()};
|
|
std::vector<typename Constant<T>::Element> elements;
|
|
ConstantSubscripts resultShape; // empty -> scalar
|
|
if (dim) { // DIM= is present, so result is an array
|
|
resultShape = array.shape();
|
|
resultShape.erase(resultShape.begin() + (*dim - 1));
|
|
ConstantSubscript dimExtent{array.shape().at(*dim - 1)};
|
|
CHECK(dimExtent == mask.shape().at(*dim - 1));
|
|
ConstantSubscript &dimAt{at[*dim - 1]};
|
|
ConstantSubscript dimLbound{dimAt};
|
|
ConstantSubscript &maskDimAt{maskAt[*dim - 1]};
|
|
ConstantSubscript maskDimLbound{maskDimAt};
|
|
for (auto n{GetSize(resultShape)}; n-- > 0;
|
|
array.IncrementSubscripts(at), mask.IncrementSubscripts(maskAt)) {
|
|
elements.push_back(identity);
|
|
if (dimExtent > 0) {
|
|
dimAt = dimLbound;
|
|
maskDimAt = maskDimLbound;
|
|
bool firstUnmasked{true};
|
|
for (ConstantSubscript j{0}; j < dimExtent; ++j, ++dimAt, ++maskDimAt) {
|
|
if (mask.At(maskAt).IsTrue()) {
|
|
accumulator(elements.back(), at, firstUnmasked);
|
|
firstUnmasked = false;
|
|
}
|
|
}
|
|
--dimAt, --maskDimAt;
|
|
}
|
|
accumulator.Done(elements.back());
|
|
}
|
|
} else { // no DIM=, result is scalar
|
|
elements.push_back(identity);
|
|
bool firstUnmasked{true};
|
|
for (auto n{array.size()}; n-- > 0;
|
|
array.IncrementSubscripts(at), mask.IncrementSubscripts(maskAt)) {
|
|
if (mask.At(maskAt).IsTrue()) {
|
|
accumulator(elements.back(), at, firstUnmasked);
|
|
firstUnmasked = false;
|
|
}
|
|
}
|
|
accumulator.Done(elements.back());
|
|
}
|
|
if constexpr (T::category == TypeCategory::Character) {
|
|
return {static_cast<ConstantSubscript>(identity.size()),
|
|
std::move(elements), std::move(resultShape)};
|
|
} else {
|
|
return {std::move(elements), std::move(resultShape)};
|
|
}
|
|
}
|
|
|
|
// MAXVAL & MINVAL
|
|
template <typename T, bool ABS = false> class MaxvalMinvalAccumulator {
|
|
public:
|
|
MaxvalMinvalAccumulator(
|
|
RelationalOperator opr, FoldingContext &context, const Constant<T> &array)
|
|
: opr_{opr}, context_{context}, array_{array} {};
|
|
void operator()(Scalar<T> &element, const ConstantSubscripts &at,
|
|
[[maybe_unused]] bool firstUnmasked) const {
|
|
auto aAt{array_.At(at)};
|
|
if constexpr (ABS) {
|
|
aAt = aAt.ABS();
|
|
}
|
|
if constexpr (T::category == TypeCategory::Real) {
|
|
if (firstUnmasked || element.IsNotANumber()) {
|
|
// Return NaN if and only if all unmasked elements are NaNs and
|
|
// at least one unmasked element is visible.
|
|
element = aAt;
|
|
return;
|
|
}
|
|
}
|
|
Expr<LogicalResult> test{PackageRelation(
|
|
opr_, Expr<T>{Constant<T>{aAt}}, Expr<T>{Constant<T>{element}})};
|
|
auto folded{GetScalarConstantValue<LogicalResult>(
|
|
test.Rewrite(context_, std::move(test)))};
|
|
CHECK(folded.has_value());
|
|
if (folded->IsTrue()) {
|
|
element = aAt;
|
|
}
|
|
}
|
|
void Done(Scalar<T> &) const {}
|
|
|
|
private:
|
|
RelationalOperator opr_;
|
|
FoldingContext &context_;
|
|
const Constant<T> &array_;
|
|
};
|
|
|
|
template <typename T>
|
|
static Expr<T> FoldMaxvalMinval(FoldingContext &context, FunctionRef<T> &&ref,
|
|
RelationalOperator opr, const Scalar<T> &identity) {
|
|
static_assert(T::category == TypeCategory::Integer ||
|
|
T::category == TypeCategory::Unsigned ||
|
|
T::category == TypeCategory::Real ||
|
|
T::category == TypeCategory::Character);
|
|
std::optional<int> dim;
|
|
if (std::optional<ArrayAndMask<T>> arrayAndMask{
|
|
ProcessReductionArgs<T>(context, ref.arguments(), dim,
|
|
/*ARRAY=*/0, /*DIM=*/1, /*MASK=*/2)}) {
|
|
MaxvalMinvalAccumulator<T> accumulator{opr, context, arrayAndMask->array};
|
|
return Expr<T>{DoReduction<T>(
|
|
arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)};
|
|
}
|
|
return Expr<T>{std::move(ref)};
|
|
}
|
|
|
|
// PRODUCT
|
|
template <typename T> class ProductAccumulator {
|
|
public:
|
|
ProductAccumulator(const Constant<T> &array) : array_{array} {}
|
|
void operator()(
|
|
Scalar<T> &element, const ConstantSubscripts &at, bool /*first*/) {
|
|
if constexpr (T::category == TypeCategory::Integer) {
|
|
auto prod{element.MultiplySigned(array_.At(at))};
|
|
overflow_ |= prod.SignedMultiplicationOverflowed();
|
|
element = prod.lower;
|
|
} else if constexpr (T::category == TypeCategory::Unsigned) {
|
|
element = element.MultiplyUnsigned(array_.At(at)).lower;
|
|
} else { // Real & Complex
|
|
auto prod{element.Multiply(array_.At(at))};
|
|
overflow_ |= prod.flags.test(RealFlag::Overflow);
|
|
element = prod.value;
|
|
}
|
|
}
|
|
bool overflow() const { return overflow_; }
|
|
void Done(Scalar<T> &) const {}
|
|
|
|
private:
|
|
const Constant<T> &array_;
|
|
bool overflow_{false};
|
|
};
|
|
|
|
template <typename T>
|
|
static Expr<T> FoldProduct(
|
|
FoldingContext &context, FunctionRef<T> &&ref, Scalar<T> identity) {
|
|
static_assert(T::category == TypeCategory::Integer ||
|
|
T::category == TypeCategory::Unsigned ||
|
|
T::category == TypeCategory::Real ||
|
|
T::category == TypeCategory::Complex);
|
|
std::optional<int> dim;
|
|
if (std::optional<ArrayAndMask<T>> arrayAndMask{
|
|
ProcessReductionArgs<T>(context, ref.arguments(), dim,
|
|
/*ARRAY=*/0, /*DIM=*/1, /*MASK=*/2)}) {
|
|
ProductAccumulator accumulator{arrayAndMask->array};
|
|
auto result{Expr<T>{DoReduction<T>(
|
|
arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)}};
|
|
if (accumulator.overflow() &&
|
|
context.languageFeatures().ShouldWarn(
|
|
common::UsageWarning::FoldingException)) {
|
|
context.messages().Say(common::UsageWarning::FoldingException,
|
|
"PRODUCT() of %s data overflowed"_warn_en_US, T::AsFortran());
|
|
}
|
|
return result;
|
|
}
|
|
return Expr<T>{std::move(ref)};
|
|
}
|
|
|
|
// SUM
|
|
template <typename T> class SumAccumulator {
|
|
using Element = typename Constant<T>::Element;
|
|
|
|
public:
|
|
SumAccumulator(const Constant<T> &array, Rounding rounding)
|
|
: array_{array}, rounding_{rounding} {}
|
|
void operator()(
|
|
Element &element, const ConstantSubscripts &at, bool /*first*/) {
|
|
if constexpr (T::category == TypeCategory::Integer) {
|
|
auto sum{element.AddSigned(array_.At(at))};
|
|
overflow_ |= sum.overflow;
|
|
element = sum.value;
|
|
} else if constexpr (T::category == TypeCategory::Unsigned) {
|
|
element = element.AddUnsigned(array_.At(at)).value;
|
|
} else { // Real & Complex: use Kahan summation
|
|
auto next{array_.At(at).Subtract(correction_, rounding_)};
|
|
overflow_ |= next.flags.test(RealFlag::Overflow);
|
|
auto sum{element.Add(next.value, rounding_)};
|
|
overflow_ |= sum.flags.test(RealFlag::Overflow);
|
|
// correction = (sum - element) - next; algebraically zero
|
|
correction_ = sum.value.Subtract(element, rounding_)
|
|
.value.Subtract(next.value, rounding_)
|
|
.value;
|
|
element = sum.value;
|
|
}
|
|
}
|
|
bool overflow() const { return overflow_; }
|
|
void Done([[maybe_unused]] Element &element) {
|
|
if constexpr (T::category != TypeCategory::Integer &&
|
|
T::category != TypeCategory::Unsigned) {
|
|
auto corrected{element.Add(correction_, rounding_)};
|
|
overflow_ |= corrected.flags.test(RealFlag::Overflow);
|
|
correction_ = Scalar<T>{};
|
|
element = corrected.value;
|
|
}
|
|
}
|
|
|
|
private:
|
|
const Constant<T> &array_;
|
|
Rounding rounding_;
|
|
bool overflow_{false};
|
|
Element correction_{};
|
|
};
|
|
|
|
template <typename T>
|
|
static Expr<T> FoldSum(FoldingContext &context, FunctionRef<T> &&ref) {
|
|
static_assert(T::category == TypeCategory::Integer ||
|
|
T::category == TypeCategory::Unsigned ||
|
|
T::category == TypeCategory::Real ||
|
|
T::category == TypeCategory::Complex);
|
|
using Element = typename Constant<T>::Element;
|
|
std::optional<int> dim;
|
|
Element identity{};
|
|
if (std::optional<ArrayAndMask<T>> arrayAndMask{
|
|
ProcessReductionArgs<T>(context, ref.arguments(), dim,
|
|
/*ARRAY=*/0, /*DIM=*/1, /*MASK=*/2)}) {
|
|
SumAccumulator accumulator{
|
|
arrayAndMask->array, context.targetCharacteristics().roundingMode()};
|
|
auto result{Expr<T>{DoReduction<T>(
|
|
arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)}};
|
|
if (accumulator.overflow() &&
|
|
context.languageFeatures().ShouldWarn(
|
|
common::UsageWarning::FoldingException)) {
|
|
context.messages().Say(common::UsageWarning::FoldingException,
|
|
"SUM() of %s data overflowed"_warn_en_US, T::AsFortran());
|
|
}
|
|
return result;
|
|
}
|
|
return Expr<T>{std::move(ref)};
|
|
}
|
|
|
|
// Utility for IALL, IANY, IPARITY, ALL, ANY, & PARITY
|
|
template <typename T> class OperationAccumulator {
|
|
public:
|
|
OperationAccumulator(const Constant<T> &array,
|
|
Scalar<T> (Scalar<T>::*operation)(const Scalar<T> &) const)
|
|
: array_{array}, operation_{operation} {}
|
|
void operator()(
|
|
Scalar<T> &element, const ConstantSubscripts &at, bool /*first*/) {
|
|
element = (element.*operation_)(array_.At(at));
|
|
}
|
|
void Done(Scalar<T> &) const {}
|
|
|
|
private:
|
|
const Constant<T> &array_;
|
|
Scalar<T> (Scalar<T>::*operation_)(const Scalar<T> &) const;
|
|
};
|
|
|
|
} // namespace Fortran::evaluate
|
|
#endif // FORTRAN_EVALUATE_FOLD_REDUCTION_H_
|