1 //===-- lib/Evaluate/fold-reduction.cpp -----------------------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8
9 #include "fold-reduction.h"
10
11 namespace Fortran::evaluate {
CheckReductionDIM(std::optional<int> & dim,FoldingContext & context,ActualArguments & arg,std::optional<int> dimIndex,int rank)12 bool CheckReductionDIM(std::optional<int> &dim, FoldingContext &context,
13 ActualArguments &arg, std::optional<int> dimIndex, int rank) {
14 if (dimIndex && static_cast<std::size_t>(*dimIndex) < arg.size()) {
15 if (auto *dimConst{
16 Folder<SubscriptInteger>{context}.Folding(arg[*dimIndex])}) {
17 if (auto dimScalar{dimConst->GetScalarValue()}) {
18 auto dimVal{dimScalar->ToInt64()};
19 if (dimVal >= 1 && dimVal <= rank) {
20 dim = dimVal;
21 } else {
22 context.messages().Say(
23 "DIM=%jd is not valid for an array of rank %d"_err_en_US,
24 static_cast<std::intmax_t>(dimVal), rank);
25 return false;
26 }
27 }
28 }
29 }
30 return true;
31 }
32
GetReductionMASK(std::optional<ActualArgument> & maskArg,const ConstantSubscripts & shape,FoldingContext & context)33 Constant<LogicalResult> *GetReductionMASK(
34 std::optional<ActualArgument> &maskArg, const ConstantSubscripts &shape,
35 FoldingContext &context) {
36 Constant<LogicalResult> *mask{
37 Folder<LogicalResult>{context}.Folding(maskArg)};
38 if (mask &&
39 !CheckConformance(context.messages(), AsShape(shape),
40 AsShape(mask->shape()), CheckConformanceFlags::RightScalarExpandable,
41 "ARRAY=", "MASK=")
42 .value_or(false)) {
43 mask = nullptr;
44 }
45 return mask;
46 }
47 } // namespace Fortran::evaluate
48