//===-- 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 static Expr FoldDotProduct( FoldingContext &context, FunctionRef &&funcRef) { using Element = typename Constant::Element; auto args{funcRef.arguments()}; CHECK(args.size() == 2); Folder folder{context}; Constant *va{folder.Folding(args[0])}; Constant *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 conjugates; for (const Element &x : va->values()) { conjugates.emplace_back(x.CONJG()); } Constant conjgA{ std::move(conjugates), ConstantSubscripts{va->shape()}}; Expr products{Fold( context, Expr{std::move(conjgA)} * Expr{Constant{*vb}})}; Constant &cProducts{DEREF(UnwrapConstantValue(products))}; Element correction{}; // Use Kahan summation for greater precision. const auto &rounding{context.targetCharacteristics().roundingMode()}; for (const Element &x : cProducts.values()) { auto next{correction.Add(x, 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 if constexpr (T::category == TypeCategory::Logical) { Expr conjunctions{Fold(context, Expr{LogicalOperation{LogicalOperator::And, Expr{Constant{*va}}, Expr{Constant{*vb}}}})}; Constant &cConjunctions{DEREF(UnwrapConstantValue(conjunctions))}; for (const Element &x : cConjunctions.values()) { if (x.IsTrue()) { sum = Element{true}; break; } } } else if constexpr (T::category == TypeCategory::Integer) { Expr products{ Fold(context, Expr{Constant{*va}} * Expr{Constant{*vb}})}; Constant &cProducts{DEREF(UnwrapConstantValue(products))}; for (const Element &x : cProducts.values()) { auto next{sum.AddSigned(x)}; overflow |= next.overflow; sum = std::move(next.value); } } else { static_assert(T::category == TypeCategory::Real); Expr products{ Fold(context, Expr{Constant{*va}} * Expr{Constant{*vb}})}; Constant &cProducts{DEREF(UnwrapConstantValue(products))}; Element correction{}; // Use Kahan summation for greater precision. const auto &rounding{context.targetCharacteristics().roundingMode()}; for (const Element &x : cProducts.values()) { auto next{correction.Add(x, 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); } } if (overflow) { context.messages().Say( "DOT_PRODUCT of %s data overflowed during computation"_warn_en_US, T::AsFortran()); } return Expr{Constant{std::move(sum)}}; } return Expr{std::move(funcRef)}; } // Fold and validate a DIM= argument. Returns false on error. bool CheckReductionDIM(std::optional &dim, FoldingContext &, ActualArguments &, std::optional dimIndex, int rank); // Fold and validate a MASK= argument. Return null on error, absent MASK=, or // non-constant MASK=. Constant *GetReductionMASK( std::optional &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 struct ArrayAndMask { Constant array; Constant mask; }; template static std::optional> ProcessReductionArgs( FoldingContext &context, ActualArguments &arg, std::optional &dim, int arrayIndex, std::optional dimIndex = std::nullopt, std::optional maskIndex = std::nullopt) { if (arg.empty()) { return std::nullopt; } Constant *folded{Folder{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> maskElement; if (maskIndex && static_cast(*maskIndex) < arg.size() && arg[*maskIndex]) { if (const Constant *origMask{ GetReductionMASK(arg[*maskIndex], folded->shape(), context)}) { if (auto scalarMask{origMask->GetScalarValue()}) { maskElement = std::vector>(n, scalarMask->IsTrue()); } else { maskElement = origMask->values(); } } else { return std::nullopt; } } else { maskElement = std::vector>(n, true); } return ArrayAndMask{Constant(*folded), Constant{ 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 &, const ConstantSubscripts &, bool first) // and Done(Scalar &). template static Constant DoReduction(const Constant &array, const Constant &mask, std::optional &dim, const Scalar &identity, ACCUMULATOR &accumulator) { ConstantSubscripts at{array.lbounds()}; ConstantSubscripts maskAt{mask.lbounds()}; std::vector::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; IncrementSubscripts(at, array.shape()), IncrementSubscripts(maskAt, mask.shape())) { dimAt = dimLbound; maskDimAt = maskDimLbound; elements.push_back(identity); bool firstUnmasked{true}; for (ConstantSubscript j{0}; j < dimExtent; ++j, ++dimAt, ++maskDimAt) { if (mask.At(maskAt).IsTrue()) { accumulator(elements.back(), at, firstUnmasked); firstUnmasked = false; } } accumulator.Done(elements.back()); } } else { // no DIM=, result is scalar elements.push_back(identity); bool firstUnmasked{true}; for (auto n{array.size()}; n-- > 0; IncrementSubscripts(at, array.shape()), IncrementSubscripts(maskAt, mask.shape())) { 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(identity.size()), std::move(elements), std::move(resultShape)}; } else { return {std::move(elements), std::move(resultShape)}; } } // MAXVAL & MINVAL template class MaxvalMinvalAccumulator { public: MaxvalMinvalAccumulator( RelationalOperator opr, FoldingContext &context, const Constant &array) : opr_{opr}, context_{context}, array_{array} {}; void operator()(Scalar &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 test{PackageRelation( opr_, Expr{Constant{aAt}}, Expr{Constant{element}})}; auto folded{GetScalarConstantValue( test.Rewrite(context_, std::move(test)))}; CHECK(folded.has_value()); if (folded->IsTrue()) { element = aAt; } } void Done(Scalar &) const {} private: RelationalOperator opr_; FoldingContext &context_; const Constant &array_; }; template static Expr FoldMaxvalMinval(FoldingContext &context, FunctionRef &&ref, RelationalOperator opr, const Scalar &identity) { static_assert(T::category == TypeCategory::Integer || T::category == TypeCategory::Real || T::category == TypeCategory::Character); std::optional dim; if (std::optional> arrayAndMask{ ProcessReductionArgs(context, ref.arguments(), dim, /*ARRAY=*/0, /*DIM=*/1, /*MASK=*/2)}) { MaxvalMinvalAccumulator accumulator{opr, context, arrayAndMask->array}; return Expr{DoReduction( arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)}; } return Expr{std::move(ref)}; } // PRODUCT template class ProductAccumulator { public: ProductAccumulator(const Constant &array) : array_{array} {} void operator()( Scalar &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 { // 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 &) const {} private: const Constant &array_; bool overflow_{false}; }; template static Expr FoldProduct( FoldingContext &context, FunctionRef &&ref, Scalar identity) { static_assert(T::category == TypeCategory::Integer || T::category == TypeCategory::Real || T::category == TypeCategory::Complex); std::optional dim; if (std::optional> arrayAndMask{ ProcessReductionArgs(context, ref.arguments(), dim, /*ARRAY=*/0, /*DIM=*/1, /*MASK=*/2)}) { ProductAccumulator accumulator{arrayAndMask->array}; auto result{Expr{DoReduction( arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)}}; if (accumulator.overflow()) { context.messages().Say( "PRODUCT() of %s data overflowed"_warn_en_US, T::AsFortran()); } return result; } return Expr{std::move(ref)}; } // SUM template class SumAccumulator { using Element = typename Constant::Element; public: SumAccumulator(const Constant &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 { // Real & Complex: use Kahan summation auto next{array_.At(at).Add(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) { auto corrected{element.Add(correction_, rounding_)}; overflow_ |= corrected.flags.test(RealFlag::Overflow); correction_ = Scalar{}; element = corrected.value; } } private: const Constant &array_; Rounding rounding_; bool overflow_{false}; Element correction_{}; }; template static Expr FoldSum(FoldingContext &context, FunctionRef &&ref) { static_assert(T::category == TypeCategory::Integer || T::category == TypeCategory::Real || T::category == TypeCategory::Complex); using Element = typename Constant::Element; std::optional dim; Element identity{}; if (std::optional> arrayAndMask{ ProcessReductionArgs(context, ref.arguments(), dim, /*ARRAY=*/0, /*DIM=*/1, /*MASK=*/2)}) { SumAccumulator accumulator{ arrayAndMask->array, context.targetCharacteristics().roundingMode()}; auto result{Expr{DoReduction( arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)}}; if (accumulator.overflow()) { context.messages().Say( "SUM() of %s data overflowed"_warn_en_US, T::AsFortran()); } return result; } return Expr{std::move(ref)}; } // Utility for IALL, IANY, IPARITY, ALL, ANY, & PARITY template class OperationAccumulator { public: OperationAccumulator(const Constant &array, Scalar (Scalar::*operation)(const Scalar &) const) : array_{array}, operation_{operation} {} void operator()( Scalar &element, const ConstantSubscripts &at, bool /*first*/) { element = (element.*operation_)(array_.At(at)); } void Done(Scalar &) const {} private: const Constant &array_; Scalar (Scalar::*operation_)(const Scalar &) const; }; } // namespace Fortran::evaluate #endif // FORTRAN_EVALUATE_FOLD_REDUCTION_H_