blob: c5f5e1996b6b11f76b37c6e128f729fa423d87e3 [file] [log] [blame]
//===-- lib/Evaluate/fold-reduction.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
//
//===----------------------------------------------------------------------===//
#include "fold-reduction.h"
namespace Fortran::evaluate {
bool CheckReductionDIM(std::optional<int> &dim, FoldingContext &context,
ActualArguments &arg, std::optional<int> dimIndex, int rank) {
if (!dimIndex || static_cast<std::size_t>(*dimIndex) >= arg.size() ||
!arg[*dimIndex]) {
dim.reset();
return true; // no DIM= argument
}
if (auto *dimConst{
Folder<SubscriptInteger>{context}.Folding(arg[*dimIndex])}) {
if (auto dimScalar{dimConst->GetScalarValue()}) {
auto dimVal{dimScalar->ToInt64()};
if (dimVal >= 1 && dimVal <= rank) {
dim = dimVal;
return true; // DIM= exists and is a valid constant
} else {
context.messages().Say(
"DIM=%jd is not valid for an array of rank %d"_err_en_US,
static_cast<std::intmax_t>(dimVal), rank);
}
}
}
return false; // DIM= bad or not scalar constant
}
Constant<LogicalResult> *GetReductionMASK(
std::optional<ActualArgument> &maskArg, const ConstantSubscripts &shape,
FoldingContext &context) {
Constant<LogicalResult> *mask{
Folder<LogicalResult>{context}.Folding(maskArg)};
if (mask &&
!CheckConformance(context.messages(), AsShape(shape),
AsShape(mask->shape()), CheckConformanceFlags::RightScalarExpandable,
"ARRAY=", "MASK=")
.value_or(false)) {
mask = nullptr;
}
return mask;
}
} // namespace Fortran::evaluate