flang/lib/Evaluate/fold-reduction.cpp

   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 {
  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       !arg[*dimIndex]) {
  16     dim.reset();
  17     return true; // no DIM= argument
  18   }
  19   if (auto *dimConst{
  20           Folder<SubscriptInteger>{context}.Folding(arg[*dimIndex])}) {
  21     if (auto dimScalar{dimConst->GetScalarValue()}) {
  22       auto dimVal{dimScalar->ToInt64()};
  23       if (dimVal >= 1 && dimVal <= rank) {
  24         dim = dimVal;
  25         return true; // DIM= exists and is a valid constant
  26       } else {
  27         context.messages().Say(
  28             "DIM=%jd is not valid for an array of rank %d"_err_en_US,
  29             static_cast<std::intmax_t>(dimVal), rank);
  30       }
  31     }
  32   }
  33   return false; // DIM= bad or not scalar constant
  34 }
  35
  36 Constant<LogicalResult> *GetReductionMASK(
  37     std::optional<ActualArgument> &maskArg, const ConstantSubscripts &shape,
  38     FoldingContext &context) {
  39   Constant<LogicalResult> *mask{
  40       Folder<LogicalResult>{context}.Folding(maskArg)};
  41   if (mask &&
  42       !CheckConformance(context.messages(), AsShape(shape),
  43           AsShape(mask->shape()), CheckConformanceFlags::RightScalarExpandable,
  44           "ARRAY=", "MASK=")
  45            .value_or(false)) {
  46     mask = nullptr;
  47   }
  48   return mask;
  49 }
  50 } // namespace Fortran::evaluate