flang/lib/Evaluate/shape.cpp

   1 //===-- lib/Evaluate/shape.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 "flang/Evaluate/shape.h"
  10 #include "flang/Common/idioms.h"
  11 #include "flang/Common/template.h"
  12 #include "flang/Evaluate/characteristics.h"
  13 #include "flang/Evaluate/check-expression.h"
  14 #include "flang/Evaluate/fold.h"
  15 #include "flang/Evaluate/intrinsics.h"
  16 #include "flang/Evaluate/tools.h"
  17 #include "flang/Evaluate/type.h"
  18 #include "flang/Parser/message.h"
  19 #include "flang/Semantics/symbol.h"
  20 #include <functional>
  21
  22 using namespace std::placeholders; // _1, _2, &c. for std::bind()
  23
  24 namespace Fortran::evaluate {
  25
  26 bool IsImpliedShape(const Symbol &original) {
  27   const Symbol &symbol{ResolveAssociations(original)};
  28   const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()};
  29   return details && symbol.attrs().test(semantics::Attr::PARAMETER) &&
  30       details->shape().CanBeImpliedShape();
  31 }
  32
  33 bool IsExplicitShape(const Symbol &original) {
  34   const Symbol &symbol{ResolveAssociations(original)};
  35   if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
  36     const auto &shape{details->shape()};
  37     return shape.Rank() == 0 ||
  38         shape.IsExplicitShape(); // true when scalar, too
  39   } else {
  40     return symbol
  41         .has<semantics::AssocEntityDetails>(); // exprs have explicit shape
  42   }
  43 }
  44
  45 Shape GetShapeHelper::ConstantShape(const Constant<ExtentType> &arrayConstant) {
  46   CHECK(arrayConstant.Rank() == 1);
  47   Shape result;
  48   std::size_t dimensions{arrayConstant.size()};
  49   for (std::size_t j{0}; j < dimensions; ++j) {
  50     Scalar<ExtentType> extent{arrayConstant.values().at(j)};
  51     result.emplace_back(MaybeExtentExpr{ExtentExpr{std::move(extent)}});
  52   }
  53   return result;
  54 }
  55
  56 auto GetShapeHelper::AsShapeResult(ExtentExpr &&arrayExpr) const -> Result {
  57   if (context_) {
  58     arrayExpr = Fold(*context_, std::move(arrayExpr));
  59   }
  60   if (const auto *constArray{UnwrapConstantValue<ExtentType>(arrayExpr)}) {
  61     return ConstantShape(*constArray);
  62   }
  63   if (auto *constructor{UnwrapExpr<ArrayConstructor<ExtentType>>(arrayExpr)}) {
  64     Shape result;
  65     for (auto &value : *constructor) {
  66       auto *expr{std::get_if<ExtentExpr>(&value.u)};
  67       if (expr && expr->Rank() == 0) {
  68         result.emplace_back(std::move(*expr));
  69       } else {
  70         return std::nullopt;
  71       }
  72     }
  73     return result;
  74   } else {
  75     return std::nullopt;
  76   }
  77 }
  78
  79 Shape GetShapeHelper::CreateShape(int rank, NamedEntity &base) const {
  80   Shape shape;
  81   for (int dimension{0}; dimension < rank; ++dimension) {
  82     shape.emplace_back(GetExtent(base, dimension, invariantOnly_));
  83   }
  84   return shape;
  85 }
  86
  87 std::optional<ExtentExpr> AsExtentArrayExpr(const Shape &shape) {
  88   ArrayConstructorValues<ExtentType> values;
  89   for (const auto &dim : shape) {
  90     if (dim) {
  91       values.Push(common::Clone(*dim));
  92     } else {
  93       return std::nullopt;
  94     }
  95   }
  96   return ExtentExpr{ArrayConstructor<ExtentType>{std::move(values)}};
  97 }
  98
  99 std::optional<Constant<ExtentType>> AsConstantShape(
 100     FoldingContext &context, const Shape &shape) {
 101   if (auto shapeArray{AsExtentArrayExpr(shape)}) {
 102     auto folded{Fold(context, std::move(*shapeArray))};
 103     if (auto *p{UnwrapConstantValue<ExtentType>(folded)}) {
 104       return std::move(*p);
 105     }
 106   }
 107   return std::nullopt;
 108 }
 109
 110 Constant<SubscriptInteger> AsConstantShape(const ConstantSubscripts &shape) {
 111   using IntType = Scalar<SubscriptInteger>;
 112   std::vector<IntType> result;
 113   for (auto dim : shape) {
 114     result.emplace_back(dim);
 115   }
 116   return {std::move(result), ConstantSubscripts{GetRank(shape)}};
 117 }
 118
 119 ConstantSubscripts AsConstantExtents(const Constant<ExtentType> &shape) {
 120   ConstantSubscripts result;
 121   for (const auto &extent : shape.values()) {
 122     result.push_back(extent.ToInt64());
 123   }
 124   return result;
 125 }
 126
 127 std::optional<ConstantSubscripts> AsConstantExtents(
 128     FoldingContext &context, const Shape &shape) {
 129   if (auto shapeConstant{AsConstantShape(context, shape)}) {
 130     return AsConstantExtents(*shapeConstant);
 131   } else {
 132     return std::nullopt;
 133   }
 134 }
 135
 136 Shape AsShape(const ConstantSubscripts &shape) {
 137   Shape result;
 138   for (const auto &extent : shape) {
 139     result.emplace_back(ExtentExpr{extent});
 140   }
 141   return result;
 142 }
 143
 144 std::optional<Shape> AsShape(const std::optional<ConstantSubscripts> &shape) {
 145   if (shape) {
 146     return AsShape(*shape);
 147   } else {
 148     return std::nullopt;
 149   }
 150 }
 151
 152 Shape Fold(FoldingContext &context, Shape &&shape) {
 153   for (auto &dim : shape) {
 154     dim = Fold(context, std::move(dim));
 155   }
 156   return std::move(shape);
 157 }
 158
 159 std::optional<Shape> Fold(
 160     FoldingContext &context, std::optional<Shape> &&shape) {
 161   if (shape) {
 162     return Fold(context, std::move(*shape));
 163   } else {
 164     return std::nullopt;
 165   }
 166 }
 167
 168 static ExtentExpr ComputeTripCount(
 169     ExtentExpr &&lower, ExtentExpr &&upper, ExtentExpr &&stride) {
 170   ExtentExpr strideCopy{common::Clone(stride)};
 171   ExtentExpr span{
 172       (std::move(upper) - std::move(lower) + std::move(strideCopy)) /
 173       std::move(stride)};
 174   return ExtentExpr{
 175       Extremum<ExtentType>{Ordering::Greater, std::move(span), ExtentExpr{0}}};
 176 }
 177
 178 ExtentExpr CountTrips(
 179     ExtentExpr &&lower, ExtentExpr &&upper, ExtentExpr &&stride) {
 180   return ComputeTripCount(
 181       std::move(lower), std::move(upper), std::move(stride));
 182 }
 183
 184 ExtentExpr CountTrips(const ExtentExpr &lower, const ExtentExpr &upper,
 185     const ExtentExpr &stride) {
 186   return ComputeTripCount(
 187       common::Clone(lower), common::Clone(upper), common::Clone(stride));
 188 }
 189
 190 MaybeExtentExpr CountTrips(MaybeExtentExpr &&lower, MaybeExtentExpr &&upper,
 191     MaybeExtentExpr &&stride) {
 192   std::function<ExtentExpr(ExtentExpr &&, ExtentExpr &&, ExtentExpr &&)> bound{
 193       std::bind(ComputeTripCount, _1, _2, _3)};
 194   return common::MapOptional(
 195       std::move(bound), std::move(lower), std::move(upper), std::move(stride));
 196 }
 197
 198 MaybeExtentExpr GetSize(Shape &&shape) {
 199   ExtentExpr extent{1};
 200   for (auto &&dim : std::move(shape)) {
 201     if (dim) {
 202       extent = std::move(extent) * std::move(*dim);
 203     } else {
 204       return std::nullopt;
 205     }
 206   }
 207   return extent;
 208 }
 209
 210 ConstantSubscript GetSize(const ConstantSubscripts &shape) {
 211   ConstantSubscript size{1};
 212   for (auto dim : shape) {
 213     CHECK(dim >= 0);
 214     size *= dim;
 215   }
 216   return size;
 217 }
 218
 219 bool ContainsAnyImpliedDoIndex(const ExtentExpr &expr) {
 220   struct MyVisitor : public AnyTraverse<MyVisitor> {
 221     using Base = AnyTraverse<MyVisitor>;
 222     MyVisitor() : Base{*this} {}
 223     using Base::operator();
 224     bool operator()(const ImpliedDoIndex &) { return true; }
 225   };
 226   return MyVisitor{}(expr);
 227 }
 228
 229 // Determines lower bound on a dimension.  This can be other than 1 only
 230 // for a reference to a whole array object or component. (See LBOUND, 16.9.109).
 231 // ASSOCIATE construct entities may require traversal of their referents.
 232 template <typename RESULT, bool LBOUND_SEMANTICS>
 233 class GetLowerBoundHelper
 234     : public Traverse<GetLowerBoundHelper<RESULT, LBOUND_SEMANTICS>, RESULT> {
 235 public:
 236   using Result = RESULT;
 237   using Base = Traverse<GetLowerBoundHelper, RESULT>;
 238   using Base::operator();
 239   explicit GetLowerBoundHelper(
 240       int d, FoldingContext *context, bool invariantOnly)
 241       : Base{*this}, dimension_{d}, context_{context},
 242         invariantOnly_{invariantOnly} {}
 243   static Result Default() { return Result{1}; }
 244   static Result Combine(Result &&, Result &&) {
 245     // Operator results and array references always have lower bounds == 1
 246     return Result{1};
 247   }
 248
 249   Result GetLowerBound(const Symbol &symbol0, NamedEntity &&base) const {
 250     const Symbol &symbol{symbol0.GetUltimate()};
 251     if (const auto *object{
 252             symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
 253       int rank{object->shape().Rank()};
 254       if (dimension_ < rank) {
 255         const semantics::ShapeSpec &shapeSpec{object->shape()[dimension_]};
 256         if (shapeSpec.lbound().isExplicit()) {
 257           if (const auto &lbound{shapeSpec.lbound().GetExplicit()}) {
 258             if constexpr (LBOUND_SEMANTICS) {
 259               bool ok{false};
 260               auto lbValue{ToInt64(*lbound)};
 261               if (dimension_ == rank - 1 &&
 262                   semantics::IsAssumedSizeArray(symbol)) {
 263                 // last dimension of assumed-size dummy array: don't worry
 264                 // about handling an empty dimension
 265                 ok = !invariantOnly_ || IsScopeInvariantExpr(*lbound);
 266               } else if (lbValue.value_or(0) == 1) {
 267                 // Lower bound is 1, regardless of extent
 268                 ok = true;
 269               } else if (const auto &ubound{shapeSpec.ubound().GetExplicit()}) {
 270                 // If we can't prove that the dimension is nonempty,
 271                 // we must be conservative.
 272                 // TODO: simple symbolic math in expression rewriting to
 273                 // cope with cases like A(J:J)
 274                 if (context_) {
 275                   auto extent{ToInt64(Fold(*context_,
 276                       ExtentExpr{*ubound} - ExtentExpr{*lbound} +
 277                           ExtentExpr{1}))};
 278                   if (extent) {
 279                     if (extent <= 0) {
 280                       return Result{1};
 281                     }
 282                     ok = true;
 283                   } else {
 284                     ok = false;
 285                   }
 286                 } else {
 287                   auto ubValue{ToInt64(*ubound)};
 288                   if (lbValue && ubValue) {
 289                     if (*lbValue > *ubValue) {
 290                       return Result{1};
 291                     }
 292                     ok = true;
 293                   } else {
 294                     ok = false;
 295                   }
 296                 }
 297               }
 298               return ok ? *lbound : Result{};
 299             } else {
 300               return *lbound;
 301             }
 302           } else {
 303             return Result{1};
 304           }
 305         }
 306         if (IsDescriptor(symbol)) {
 307           return ExtentExpr{DescriptorInquiry{std::move(base),
 308               DescriptorInquiry::Field::LowerBound, dimension_}};
 309         }
 310       }
 311     } else if (const auto *assoc{
 312                    symbol.detailsIf<semantics::AssocEntityDetails>()}) {
 313       if (assoc->IsAssumedSize()) { // RANK(*)
 314         return Result{1};
 315       } else if (assoc->IsAssumedRank()) { // RANK DEFAULT
 316       } else if (assoc->rank()) { // RANK(n)
 317         const Symbol &resolved{ResolveAssociations(symbol)};
 318         if (IsDescriptor(resolved) && dimension_ < *assoc->rank()) {
 319           return ExtentExpr{DescriptorInquiry{std::move(base),
 320               DescriptorInquiry::Field::LowerBound, dimension_}};
 321         }
 322       } else {
 323         Result exprLowerBound{((*this)(assoc->expr()))};
 324         if (IsActuallyConstant(exprLowerBound)) {
 325           return std::move(exprLowerBound);
 326         } else {
 327           // If the lower bound of the associated entity is not resolved to a
 328           // constant expression at the time of the association, it is unsafe
 329           // to re-evaluate it later in the associate construct. Statements
 330           // in between may have modified its operands value.
 331           return ExtentExpr{DescriptorInquiry{std::move(base),
 332               DescriptorInquiry::Field::LowerBound, dimension_}};
 333         }
 334       }
 335     }
 336     if constexpr (LBOUND_SEMANTICS) {
 337       return Result{};
 338     } else {
 339       return Result{1};
 340     }
 341   }
 342
 343   Result operator()(const Symbol &symbol) const {
 344     return GetLowerBound(symbol, NamedEntity{symbol});
 345   }
 346
 347   Result operator()(const Component &component) const {
 348     if (component.base().Rank() == 0) {
 349       return GetLowerBound(
 350           component.GetLastSymbol(), NamedEntity{common::Clone(component)});
 351     }
 352     return Result{1};
 353   }
 354
 355   template <typename T> Result operator()(const Expr<T> &expr) const {
 356     if (const Symbol * whole{UnwrapWholeSymbolOrComponentDataRef(expr)}) {
 357       return (*this)(*whole);
 358     } else if constexpr (common::HasMember<Constant<T>, decltype(expr.u)>) {
 359       if (const auto *con{std::get_if<Constant<T>>(&expr.u)}) {
 360         ConstantSubscripts lb{con->lbounds()};
 361         if (dimension_ < GetRank(lb)) {
 362           return Result{lb[dimension_]};
 363         }
 364       } else { // operation
 365         return Result{1};
 366       }
 367     } else {
 368       return (*this)(expr.u);
 369     }
 370     if constexpr (LBOUND_SEMANTICS) {
 371       return Result{};
 372     } else {
 373       return Result{1};
 374     }
 375   }
 376
 377 private:
 378   int dimension_; // zero-based
 379   FoldingContext *context_{nullptr};
 380   bool invariantOnly_{false};
 381 };
 382
 383 ExtentExpr GetRawLowerBound(
 384     const NamedEntity &base, int dimension, bool invariantOnly) {
 385   return GetLowerBoundHelper<ExtentExpr, false>{
 386       dimension, nullptr, invariantOnly}(base);
 387 }
 388
 389 ExtentExpr GetRawLowerBound(FoldingContext &context, const NamedEntity &base,
 390     int dimension, bool invariantOnly) {
 391   return Fold(context,
 392       GetLowerBoundHelper<ExtentExpr, false>{
 393           dimension, &context, invariantOnly}(base));
 394 }
 395
 396 MaybeExtentExpr GetLBOUND(
 397     const NamedEntity &base, int dimension, bool invariantOnly) {
 398   return GetLowerBoundHelper<MaybeExtentExpr, true>{
 399       dimension, nullptr, invariantOnly}(base);
 400 }
 401
 402 MaybeExtentExpr GetLBOUND(FoldingContext &context, const NamedEntity &base,
 403     int dimension, bool invariantOnly) {
 404   return Fold(context,
 405       GetLowerBoundHelper<MaybeExtentExpr, true>{
 406           dimension, &context, invariantOnly}(base));
 407 }
 408
 409 Shape GetRawLowerBounds(const NamedEntity &base, bool invariantOnly) {
 410   Shape result;
 411   int rank{base.Rank()};
 412   for (int dim{0}; dim < rank; ++dim) {
 413     result.emplace_back(GetRawLowerBound(base, dim, invariantOnly));
 414   }
 415   return result;
 416 }
 417
 418 Shape GetRawLowerBounds(
 419     FoldingContext &context, const NamedEntity &base, bool invariantOnly) {
 420   Shape result;
 421   int rank{base.Rank()};
 422   for (int dim{0}; dim < rank; ++dim) {
 423     result.emplace_back(GetRawLowerBound(context, base, dim, invariantOnly));
 424   }
 425   return result;
 426 }
 427
 428 Shape GetLBOUNDs(const NamedEntity &base, bool invariantOnly) {
 429   Shape result;
 430   int rank{base.Rank()};
 431   for (int dim{0}; dim < rank; ++dim) {
 432     result.emplace_back(GetLBOUND(base, dim, invariantOnly));
 433   }
 434   return result;
 435 }
 436
 437 Shape GetLBOUNDs(
 438     FoldingContext &context, const NamedEntity &base, bool invariantOnly) {
 439   Shape result;
 440   int rank{base.Rank()};
 441   for (int dim{0}; dim < rank; ++dim) {
 442     result.emplace_back(GetLBOUND(context, base, dim, invariantOnly));
 443   }
 444   return result;
 445 }
 446
 447 // If the upper and lower bounds are constant, return a constant expression for
 448 // the extent.  In particular, if the upper bound is less than the lower bound,
 449 // return zero.
 450 static MaybeExtentExpr GetNonNegativeExtent(
 451     const semantics::ShapeSpec &shapeSpec, bool invariantOnly) {
 452   const auto &ubound{shapeSpec.ubound().GetExplicit()};
 453   const auto &lbound{shapeSpec.lbound().GetExplicit()};
 454   std::optional<ConstantSubscript> uval{ToInt64(ubound)};
 455   std::optional<ConstantSubscript> lval{ToInt64(lbound)};
 456   if (uval && lval) {
 457     if (*uval < *lval) {
 458       return ExtentExpr{0};
 459     } else {
 460       return ExtentExpr{*uval - *lval + 1};
 461     }
 462   } else if (lbound && ubound &&
 463       (!invariantOnly ||
 464           (IsScopeInvariantExpr(*lbound) && IsScopeInvariantExpr(*ubound)))) {
 465     // Apply effective IDIM (MAX calculation with 0) so thet the
 466     // result is never negative
 467     if (lval.value_or(0) == 1) {
 468       return ExtentExpr{Extremum<SubscriptInteger>{
 469           Ordering::Greater, ExtentExpr{0}, common::Clone(*ubound)}};
 470     } else {
 471       return ExtentExpr{
 472           Extremum<SubscriptInteger>{Ordering::Greater, ExtentExpr{0},
 473               common::Clone(*ubound) - common::Clone(*lbound) + ExtentExpr{1}}};
 474     }
 475   } else {
 476     return std::nullopt;
 477   }
 478 }
 479
 480 static MaybeExtentExpr GetAssociatedExtent(
 481     const Symbol &symbol, int dimension) {
 482   if (const auto *assoc{symbol.detailsIf<semantics::AssocEntityDetails>()};
 483       assoc && !assoc->rank()) { // not SELECT RANK case
 484     if (auto shape{GetShape(assoc->expr())};
 485         shape && dimension < static_cast<int>(shape->size())) {
 486       if (auto &extent{shape->at(dimension)};
 487           // Don't return a non-constant extent, as the variables that
 488           // determine the shape of the selector's expression may change
 489           // during execution of the construct.
 490           extent && IsActuallyConstant(*extent)) {
 491         return std::move(extent);
 492       }
 493     }
 494   }
 495   return ExtentExpr{DescriptorInquiry{
 496       NamedEntity{symbol}, DescriptorInquiry::Field::Extent, dimension}};
 497 }
 498
 499 MaybeExtentExpr GetExtent(
 500     const NamedEntity &base, int dimension, bool invariantOnly) {
 501   CHECK(dimension >= 0);
 502   const Symbol &last{base.GetLastSymbol()};
 503   const Symbol &symbol{ResolveAssociations(last)};
 504   if (const auto *assoc{last.detailsIf<semantics::AssocEntityDetails>()}) {
 505     if (assoc->IsAssumedSize() || assoc->IsAssumedRank()) { // RANK(*)/DEFAULT
 506       return std::nullopt;
 507     } else if (assoc->rank()) { // RANK(n)
 508       if (semantics::IsDescriptor(symbol) && dimension < *assoc->rank()) {
 509         return ExtentExpr{DescriptorInquiry{
 510             NamedEntity{base}, DescriptorInquiry::Field::Extent, dimension}};
 511       } else {
 512         return std::nullopt;
 513       }
 514     } else {
 515       return GetAssociatedExtent(last, dimension);
 516     }
 517   }
 518   if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
 519     if (IsImpliedShape(symbol) && details->init()) {
 520       if (auto shape{GetShape(symbol, invariantOnly)}) {
 521         if (dimension < static_cast<int>(shape->size())) {
 522           return std::move(shape->at(dimension));
 523         }
 524       }
 525     } else {
 526       int j{0};
 527       for (const auto &shapeSpec : details->shape()) {
 528         if (j++ == dimension) {
 529           if (auto extent{GetNonNegativeExtent(shapeSpec, invariantOnly)}) {
 530             return extent;
 531           } else if (semantics::IsAssumedSizeArray(symbol) &&
 532               j == symbol.Rank()) {
 533             break;
 534           } else if (semantics::IsDescriptor(symbol)) {
 535             return ExtentExpr{DescriptorInquiry{NamedEntity{base},
 536                 DescriptorInquiry::Field::Extent, dimension}};
 537           } else {
 538             break;
 539           }
 540         }
 541       }
 542     }
 543   }
 544   return std::nullopt;
 545 }
 546
 547 MaybeExtentExpr GetExtent(FoldingContext &context, const NamedEntity &base,
 548     int dimension, bool invariantOnly) {
 549   return Fold(context, GetExtent(base, dimension, invariantOnly));
 550 }
 551
 552 MaybeExtentExpr GetExtent(const Subscript &subscript, const NamedEntity &base,
 553     int dimension, bool invariantOnly) {
 554   return common::visit(
 555       common::visitors{
 556           [&](const Triplet &triplet) -> MaybeExtentExpr {
 557             MaybeExtentExpr upper{triplet.upper()};
 558             if (!upper) {
 559               upper = GetUBOUND(base, dimension, invariantOnly);
 560             }
 561             MaybeExtentExpr lower{triplet.lower()};
 562             if (!lower) {
 563               lower = GetLBOUND(base, dimension, invariantOnly);
 564             }
 565             return CountTrips(std::move(lower), std::move(upper),
 566                 MaybeExtentExpr{triplet.stride()});
 567           },
 568           [&](const IndirectSubscriptIntegerExpr &subs) -> MaybeExtentExpr {
 569             if (auto shape{GetShape(subs.value())}) {
 570               if (GetRank(*shape) > 0) {
 571                 CHECK(GetRank(*shape) == 1); // vector-valued subscript
 572                 return std::move(shape->at(0));
 573               }
 574             }
 575             return std::nullopt;
 576           },
 577       },
 578       subscript.u);
 579 }
 580
 581 MaybeExtentExpr GetExtent(FoldingContext &context, const Subscript &subscript,
 582     const NamedEntity &base, int dimension, bool invariantOnly) {
 583   return Fold(context, GetExtent(subscript, base, dimension, invariantOnly));
 584 }
 585
 586 MaybeExtentExpr ComputeUpperBound(
 587     ExtentExpr &&lower, MaybeExtentExpr &&extent) {
 588   if (extent) {
 589     if (ToInt64(lower).value_or(0) == 1) {
 590       return std::move(*extent);
 591     } else {
 592       return std::move(*extent) + std::move(lower) - ExtentExpr{1};
 593     }
 594   } else {
 595     return std::nullopt;
 596   }
 597 }
 598
 599 MaybeExtentExpr ComputeUpperBound(
 600     FoldingContext &context, ExtentExpr &&lower, MaybeExtentExpr &&extent) {
 601   return Fold(context, ComputeUpperBound(std::move(lower), std::move(extent)));
 602 }
 603
 604 MaybeExtentExpr GetRawUpperBound(
 605     const NamedEntity &base, int dimension, bool invariantOnly) {
 606   const Symbol &symbol{ResolveAssociations(base.GetLastSymbol())};
 607   if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
 608     int rank{details->shape().Rank()};
 609     if (dimension < rank) {
 610       const auto &bound{details->shape()[dimension].ubound().GetExplicit()};
 611       if (bound && (!invariantOnly || IsScopeInvariantExpr(*bound))) {
 612         return *bound;
 613       } else if (semantics::IsAssumedSizeArray(symbol) &&
 614           dimension + 1 == symbol.Rank()) {
 615         return std::nullopt;
 616       } else {
 617         return ComputeUpperBound(
 618             GetRawLowerBound(base, dimension), GetExtent(base, dimension));
 619       }
 620     }
 621   } else if (const auto *assoc{
 622                  symbol.detailsIf<semantics::AssocEntityDetails>()}) {
 623     if (assoc->IsAssumedSize() || assoc->IsAssumedRank()) {
 624       return std::nullopt;
 625     } else if (assoc->rank() && dimension >= *assoc->rank()) {
 626       return std::nullopt;
 627     } else if (auto extent{GetAssociatedExtent(symbol, dimension)}) {
 628       return ComputeUpperBound(
 629           GetRawLowerBound(base, dimension), std::move(extent));
 630     }
 631   }
 632   return std::nullopt;
 633 }
 634
 635 MaybeExtentExpr GetRawUpperBound(FoldingContext &context,
 636     const NamedEntity &base, int dimension, bool invariantOnly) {
 637   return Fold(context, GetRawUpperBound(base, dimension, invariantOnly));
 638 }
 639
 640 static MaybeExtentExpr GetExplicitUBOUND(FoldingContext *context,
 641     const semantics::ShapeSpec &shapeSpec, bool invariantOnly) {
 642   const auto &ubound{shapeSpec.ubound().GetExplicit()};
 643   if (ubound && (!invariantOnly || IsScopeInvariantExpr(*ubound))) {
 644     if (auto extent{GetNonNegativeExtent(shapeSpec, invariantOnly)}) {
 645       if (auto cstExtent{ToInt64(
 646               context ? Fold(*context, std::move(*extent)) : *extent)}) {
 647         if (cstExtent > 0) {
 648           return *ubound;
 649         } else if (cstExtent == 0) {
 650           return ExtentExpr{0};
 651         }
 652       }
 653     }
 654   }
 655   return std::nullopt;
 656 }
 657
 658 static MaybeExtentExpr GetUBOUND(FoldingContext *context,
 659     const NamedEntity &base, int dimension, bool invariantOnly) {
 660   const Symbol &symbol{ResolveAssociations(base.GetLastSymbol())};
 661   if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
 662     int rank{details->shape().Rank()};
 663     if (dimension < rank) {
 664       const semantics::ShapeSpec &shapeSpec{details->shape()[dimension]};
 665       if (auto ubound{GetExplicitUBOUND(context, shapeSpec, invariantOnly)}) {
 666         return *ubound;
 667       } else if (semantics::IsAssumedSizeArray(symbol) &&
 668           dimension + 1 == symbol.Rank()) {
 669         return std::nullopt; // UBOUND() folding replaces with -1
 670       } else if (auto lb{GetLBOUND(base, dimension, invariantOnly)}) {
 671         return ComputeUpperBound(
 672             std::move(*lb), GetExtent(base, dimension, invariantOnly));
 673       }
 674     }
 675   } else if (const auto *assoc{
 676                  symbol.detailsIf<semantics::AssocEntityDetails>()}) {
 677     if (assoc->IsAssumedSize() || assoc->IsAssumedRank()) {
 678       return std::nullopt;
 679     } else if (assoc->rank()) { // RANK (n)
 680       const Symbol &resolved{ResolveAssociations(symbol)};
 681       if (IsDescriptor(resolved) && dimension < *assoc->rank()) {
 682         ExtentExpr lb{DescriptorInquiry{NamedEntity{base},
 683             DescriptorInquiry::Field::LowerBound, dimension}};
 684         ExtentExpr extent{DescriptorInquiry{
 685             std::move(base), DescriptorInquiry::Field::Extent, dimension}};
 686         return ComputeUpperBound(std::move(lb), std::move(extent));
 687       }
 688     } else if (auto extent{GetAssociatedExtent(symbol, dimension)}) {
 689       if (auto lb{GetLBOUND(base, dimension, invariantOnly)}) {
 690         return ComputeUpperBound(std::move(*lb), std::move(extent));
 691       }
 692     }
 693   }
 694   return std::nullopt;
 695 }
 696
 697 MaybeExtentExpr GetUBOUND(
 698     const NamedEntity &base, int dimension, bool invariantOnly) {
 699   return GetUBOUND(nullptr, base, dimension, invariantOnly);
 700 }
 701
 702 MaybeExtentExpr GetUBOUND(FoldingContext &context, const NamedEntity &base,
 703     int dimension, bool invariantOnly) {
 704   return Fold(context, GetUBOUND(&context, base, dimension, invariantOnly));
 705 }
 706
 707 static Shape GetUBOUNDs(
 708     FoldingContext *context, const NamedEntity &base, bool invariantOnly) {
 709   Shape result;
 710   int rank{base.Rank()};
 711   for (int dim{0}; dim < rank; ++dim) {
 712     result.emplace_back(GetUBOUND(context, base, dim, invariantOnly));
 713   }
 714   return result;
 715 }
 716
 717 Shape GetUBOUNDs(
 718     FoldingContext &context, const NamedEntity &base, bool invariantOnly) {
 719   return Fold(context, GetUBOUNDs(&context, base, invariantOnly));
 720 }
 721
 722 Shape GetUBOUNDs(const NamedEntity &base, bool invariantOnly) {
 723   return GetUBOUNDs(nullptr, base, invariantOnly);
 724 }
 725
 726 auto GetShapeHelper::operator()(const Symbol &symbol) const -> Result {
 727   return common::visit(
 728       common::visitors{
 729           [&](const semantics::ObjectEntityDetails &object) {
 730             if (IsImpliedShape(symbol) && object.init()) {
 731               return (*this)(object.init());
 732             } else if (IsAssumedRank(symbol)) {
 733               return Result{};
 734             } else {
 735               int n{object.shape().Rank()};
 736               NamedEntity base{symbol};
 737               return Result{CreateShape(n, base)};
 738             }
 739           },
 740           [](const semantics::EntityDetails &) {
 741             return ScalarShape(); // no dimensions seen
 742           },
 743           [&](const semantics::ProcEntityDetails &proc) {
 744             if (const Symbol * interface{proc.procInterface()}) {
 745               return (*this)(*interface);
 746             } else {
 747               return ScalarShape();
 748             }
 749           },
 750           [&](const semantics::AssocEntityDetails &assoc) {
 751             NamedEntity base{symbol};
 752             if (assoc.rank()) { // SELECT RANK case
 753               int n{assoc.rank().value()};
 754               return Result{CreateShape(n, base)};
 755             } else {
 756               auto exprShape{((*this)(assoc.expr()))};
 757               if (exprShape) {
 758                 int rank{static_cast<int>(exprShape->size())};
 759                 for (int dimension{0}; dimension < rank; ++dimension) {
 760                   auto &extent{(*exprShape)[dimension]};
 761                   if (extent && !IsActuallyConstant(*extent)) {
 762                     extent = GetExtent(base, dimension);
 763                   }
 764                 }
 765               }
 766               return exprShape;
 767             }
 768           },
 769           [&](const semantics::SubprogramDetails &subp) -> Result {
 770             if (subp.isFunction()) {
 771               auto resultShape{(*this)(subp.result())};
 772               if (resultShape && !useResultSymbolShape_) {
 773                 // Ensure the shape is constant. Otherwise, it may be referring
 774                 // to symbols that belong to the function's scope and are
 775                 // meaningless on the caller side without the related call
 776                 // expression.
 777                 for (auto &extent : *resultShape) {
 778                   if (extent && !IsActuallyConstant(*extent)) {
 779                     extent.reset();
 780                   }
 781                 }
 782               }
 783               return resultShape;
 784             } else {
 785               return Result{};
 786             }
 787           },
 788           [&](const semantics::ProcBindingDetails &binding) {
 789             return (*this)(binding.symbol());
 790           },
 791           [](const semantics::TypeParamDetails &) { return ScalarShape(); },
 792           [](const auto &) { return Result{}; },
 793       },
 794       symbol.GetUltimate().details());
 795 }
 796
 797 auto GetShapeHelper::operator()(const Component &component) const -> Result {
 798   const Symbol &symbol{component.GetLastSymbol()};
 799   int rank{symbol.Rank()};
 800   if (rank == 0) {
 801     return (*this)(component.base());
 802   } else if (symbol.has<semantics::ObjectEntityDetails>()) {
 803     NamedEntity base{Component{component}};
 804     return CreateShape(rank, base);
 805   } else {
 806     return (*this)(symbol);
 807   }
 808 }
 809
 810 auto GetShapeHelper::operator()(const ArrayRef &arrayRef) const -> Result {
 811   Shape shape;
 812   int dimension{0};
 813   const NamedEntity &base{arrayRef.base()};
 814   for (const Subscript &ss : arrayRef.subscript()) {
 815     if (ss.Rank() > 0) {
 816       shape.emplace_back(GetExtent(ss, base, dimension));
 817     }
 818     ++dimension;
 819   }
 820   if (shape.empty()) {
 821     if (const Component * component{base.UnwrapComponent()}) {
 822       return (*this)(component->base());
 823     }
 824   }
 825   return shape;
 826 }
 827
 828 auto GetShapeHelper::operator()(const CoarrayRef &coarrayRef) const -> Result {
 829   NamedEntity base{coarrayRef.GetBase()};
 830   if (coarrayRef.subscript().empty()) {
 831     return (*this)(base);
 832   } else {
 833     Shape shape;
 834     int dimension{0};
 835     for (const Subscript &ss : coarrayRef.subscript()) {
 836       if (ss.Rank() > 0) {
 837         shape.emplace_back(GetExtent(ss, base, dimension));
 838       }
 839       ++dimension;
 840     }
 841     return shape;
 842   }
 843 }
 844
 845 auto GetShapeHelper::operator()(const Substring &substring) const -> Result {
 846   return (*this)(substring.parent());
 847 }
 848
 849 auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
 850   if (call.Rank() == 0) {
 851     return ScalarShape();
 852   } else if (call.IsElemental()) {
 853     // Use the shape of an actual array argument associated with a
 854     // non-OPTIONAL dummy object argument.
 855     if (context_) {
 856       if (auto chars{characteristics::Procedure::FromActuals(
 857               call.proc(), call.arguments(), *context_)}) {
 858         std::size_t j{0};
 859         std::size_t anyArrayArgRank{0};
 860         for (const auto &arg : call.arguments()) {
 861           if (arg && arg->Rank() > 0 && j < chars->dummyArguments.size()) {
 862             anyArrayArgRank = arg->Rank();
 863             if (!chars->dummyArguments[j].IsOptional()) {
 864               return (*this)(*arg);
 865             }
 866           }
 867           ++j;
 868         }
 869         if (anyArrayArgRank) {
 870           // All dummy array arguments of the procedure are OPTIONAL.
 871           // We cannot take the shape from just any array argument,
 872           // because all of them might be OPTIONAL dummy arguments
 873           // of the caller. Return unknown shape ranked according
 874           // to the last actual array argument.
 875           return Shape(anyArrayArgRank, MaybeExtentExpr{});
 876         }
 877       }
 878     }
 879     return ScalarShape();
 880   } else if (const Symbol * symbol{call.proc().GetSymbol()}) {
 881     auto restorer{common::ScopedSet(useResultSymbolShape_, false)};
 882     return (*this)(*symbol);
 883   } else if (const auto *intrinsic{call.proc().GetSpecificIntrinsic()}) {
 884     if (intrinsic->name == "shape" || intrinsic->name == "lbound" ||
 885         intrinsic->name == "ubound") {
 886       // For LBOUND/UBOUND, these are the array-valued cases (no DIM=)
 887       if (!call.arguments().empty() && call.arguments().front()) {
 888         if (IsAssumedRank(*call.arguments().front())) {
 889           return Shape{MaybeExtentExpr{}};
 890         } else {
 891           return Shape{
 892               MaybeExtentExpr{ExtentExpr{call.arguments().front()->Rank()}}};
 893         }
 894       }
 895     } else if (intrinsic->name == "all" || intrinsic->name == "any" ||
 896         intrinsic->name == "count" || intrinsic->name == "iall" ||
 897         intrinsic->name == "iany" || intrinsic->name == "iparity" ||
 898         intrinsic->name == "maxval" || intrinsic->name == "minval" ||
 899         intrinsic->name == "norm2" || intrinsic->name == "parity" ||
 900         intrinsic->name == "product" || intrinsic->name == "sum") {
 901       // Reduction with DIM=
 902       if (call.arguments().size() >= 2) {
 903         auto arrayShape{
 904             (*this)(UnwrapExpr<Expr<SomeType>>(call.arguments().at(0)))};
 905         const auto *dimArg{UnwrapExpr<Expr<SomeType>>(call.arguments().at(1))};
 906         if (arrayShape && dimArg) {
 907           if (auto dim{ToInt64(*dimArg)}) {
 908             if (*dim >= 1 &&
 909                 static_cast<std::size_t>(*dim) <= arrayShape->size()) {
 910               arrayShape->erase(arrayShape->begin() + (*dim - 1));
 911               return std::move(*arrayShape);
 912             }
 913           }
 914         }
 915       }
 916     } else if (intrinsic->name == "findloc" || intrinsic->name == "maxloc" ||
 917         intrinsic->name == "minloc") {
 918       std::size_t dimIndex{intrinsic->name == "findloc" ? 2u : 1u};
 919       if (call.arguments().size() > dimIndex) {
 920         if (auto arrayShape{
 921                 (*this)(UnwrapExpr<Expr<SomeType>>(call.arguments().at(0)))}) {
 922           auto rank{static_cast<int>(arrayShape->size())};
 923           if (const auto *dimArg{
 924                   UnwrapExpr<Expr<SomeType>>(call.arguments()[dimIndex])}) {
 925             auto dim{ToInt64(*dimArg)};
 926             if (dim && *dim >= 1 && *dim <= rank) {
 927               arrayShape->erase(arrayShape->begin() + (*dim - 1));
 928               return std::move(*arrayShape);
 929             }
 930           } else {
 931             // xxxLOC(no DIM=) result is vector(1:RANK(ARRAY=))
 932             return Shape{ExtentExpr{rank}};
 933           }
 934         }
 935       }
 936     } else if (intrinsic->name == "cshift" || intrinsic->name == "eoshift") {
 937       if (!call.arguments().empty()) {
 938         return (*this)(call.arguments()[0]);
 939       }
 940     } else if (intrinsic->name == "matmul") {
 941       if (call.arguments().size() == 2) {
 942         if (auto ashape{(*this)(call.arguments()[0])}) {
 943           if (auto bshape{(*this)(call.arguments()[1])}) {
 944             if (ashape->size() == 1 && bshape->size() == 2) {
 945               bshape->erase(bshape->begin());
 946               return std::move(*bshape); // matmul(vector, matrix)
 947             } else if (ashape->size() == 2 && bshape->size() == 1) {
 948               ashape->pop_back();
 949               return std::move(*ashape); // matmul(matrix, vector)
 950             } else if (ashape->size() == 2 && bshape->size() == 2) {
 951               (*ashape)[1] = std::move((*bshape)[1]);
 952               return std::move(*ashape); // matmul(matrix, matrix)
 953             }
 954           }
 955         }
 956       }
 957     } else if (intrinsic->name == "pack") {
 958       if (call.arguments().size() >= 3 && call.arguments().at(2)) {
 959         // SHAPE(PACK(,,VECTOR=v)) -> SHAPE(v)
 960         return (*this)(call.arguments().at(2));
 961       } else if (call.arguments().size() >= 2 && context_) {
 962         if (auto maskShape{(*this)(call.arguments().at(1))}) {
 963           if (maskShape->size() == 0) {
 964             // Scalar MASK= -> [MERGE(SIZE(ARRAY=), 0, mask)]
 965             if (auto arrayShape{(*this)(call.arguments().at(0))}) {
 966               if (auto arraySize{GetSize(std::move(*arrayShape))}) {
 967                 ActualArguments toMerge{
 968                     ActualArgument{AsGenericExpr(std::move(*arraySize))},
 969                     ActualArgument{AsGenericExpr(ExtentExpr{0})},
 970                     common::Clone(call.arguments().at(1))};
 971                 auto specific{context_->intrinsics().Probe(
 972                     CallCharacteristics{"merge"}, toMerge, *context_)};
 973                 CHECK(specific);
 974                 return Shape{ExtentExpr{FunctionRef<ExtentType>{
 975                     ProcedureDesignator{std::move(specific->specificIntrinsic)},
 976                     std::move(specific->arguments)}}};
 977               }
 978             }
 979           } else {
 980             // Non-scalar MASK= -> [COUNT(mask, KIND=extent_kind)]
 981             ActualArgument kindArg{
 982                 AsGenericExpr(Constant<ExtentType>{ExtentType::kind})};
 983             kindArg.set_keyword(context_->SaveTempName("kind"));
 984             ActualArguments toCount{
 985                 ActualArgument{common::Clone(
 986                     DEREF(call.arguments().at(1).value().UnwrapExpr()))},
 987                 std::move(kindArg)};
 988             auto specific{context_->intrinsics().Probe(
 989                 CallCharacteristics{"count"}, toCount, *context_)};
 990             CHECK(specific);
 991             return Shape{ExtentExpr{FunctionRef<ExtentType>{
 992                 ProcedureDesignator{std::move(specific->specificIntrinsic)},
 993                 std::move(specific->arguments)}}};
 994           }
 995         }
 996       }
 997     } else if (intrinsic->name == "reshape") {
 998       if (call.arguments().size() >= 2 && call.arguments().at(1)) {
 999         // SHAPE(RESHAPE(array,shape)) -> shape
1000         if (const auto *shapeExpr{
1001                 call.arguments().at(1).value().UnwrapExpr()}) {
1002           auto shapeArg{std::get<Expr<SomeInteger>>(shapeExpr->u)};
1003           if (auto result{AsShapeResult(
1004                   ConvertToType<ExtentType>(std::move(shapeArg)))}) {
1005             return result;
1006           }
1007         }
1008       }
1009     } else if (intrinsic->name == "spread") {
1010       // SHAPE(SPREAD(ARRAY,DIM,NCOPIES)) = SHAPE(ARRAY) with NCOPIES inserted
1011       // at position DIM.
1012       if (call.arguments().size() == 3) {
1013         auto arrayShape{
1014             (*this)(UnwrapExpr<Expr<SomeType>>(call.arguments().at(0)))};
1015         const auto *dimArg{UnwrapExpr<Expr<SomeType>>(call.arguments().at(1))};
1016         const auto *nCopies{
1017             UnwrapExpr<Expr<SomeInteger>>(call.arguments().at(2))};
1018         if (arrayShape && dimArg && nCopies) {
1019           if (auto dim{ToInt64(*dimArg)}) {
1020             if (*dim >= 1 &&
1021                 static_cast<std::size_t>(*dim) <= arrayShape->size() + 1) {
1022               arrayShape->emplace(arrayShape->begin() + *dim - 1,
1023                   ConvertToType<ExtentType>(common::Clone(*nCopies)));
1024               return std::move(*arrayShape);
1025             }
1026           }
1027         }
1028       }
1029     } else if (intrinsic->name == "transfer") {
1030       if (call.arguments().size() == 3 && call.arguments().at(2)) {
1031         // SIZE= is present; shape is vector [SIZE=]
1032         if (const auto *size{
1033                 UnwrapExpr<Expr<SomeInteger>>(call.arguments().at(2))}) {
1034           return Shape{
1035               MaybeExtentExpr{ConvertToType<ExtentType>(common::Clone(*size))}};
1036         }
1037       } else if (context_) {
1038         if (auto moldTypeAndShape{characteristics::TypeAndShape::Characterize(
1039                 call.arguments().at(1), *context_)}) {
1040           if (moldTypeAndShape->Rank() == 0) {
1041             // SIZE= is absent and MOLD= is scalar: result is scalar
1042             return ScalarShape();
1043           } else {
1044             // SIZE= is absent and MOLD= is array: result is vector whose
1045             // length is determined by sizes of types.  See 16.9.193p4 case(ii).
1046             // Note that if sourceBytes is not known to be empty, we
1047             // can fold only when moldElementBytes is known to not be zero;
1048             // the most general case risks a division by zero otherwise.
1049             if (auto sourceTypeAndShape{
1050                     characteristics::TypeAndShape::Characterize(
1051                         call.arguments().at(0), *context_)}) {
1052               if (auto sourceBytes{
1053                       sourceTypeAndShape->MeasureSizeInBytes(*context_)}) {
1054                 *sourceBytes = Fold(*context_, std::move(*sourceBytes));
1055                 if (auto sourceBytesConst{ToInt64(*sourceBytes)}) {
1056                   if (*sourceBytesConst == 0) {
1057                     return Shape{ExtentExpr{0}};
1058                   }
1059                 }
1060                 if (auto moldElementBytes{
1061                         moldTypeAndShape->MeasureElementSizeInBytes(
1062                             *context_, true)}) {
1063                   *moldElementBytes =
1064                       Fold(*context_, std::move(*moldElementBytes));
1065                   auto moldElementBytesConst{ToInt64(*moldElementBytes)};
1066                   if (moldElementBytesConst && *moldElementBytesConst != 0) {
1067                     ExtentExpr extent{Fold(*context_,
1068                         (std::move(*sourceBytes) +
1069                             common::Clone(*moldElementBytes) - ExtentExpr{1}) /
1070                             common::Clone(*moldElementBytes))};
1071                     return Shape{MaybeExtentExpr{std::move(extent)}};
1072                   }
1073                 }
1074               }
1075             }
1076           }
1077         }
1078       }
1079     } else if (intrinsic->name == "transpose") {
1080       if (call.arguments().size() >= 1) {
1081         if (auto shape{(*this)(call.arguments().at(0))}) {
1082           if (shape->size() == 2) {
1083             std::swap((*shape)[0], (*shape)[1]);
1084             return shape;
1085           }
1086         }
1087       }
1088     } else if (intrinsic->name == "unpack") {
1089       if (call.arguments().size() >= 2) {
1090         return (*this)(call.arguments()[1]); // MASK=
1091       }
1092     } else if (intrinsic->characteristics.value().attrs.test(characteristics::
1093                        Procedure::Attr::NullPointer)) { // NULL(MOLD=)
1094       return (*this)(call.arguments());
1095     } else {
1096       // TODO: shapes of other non-elemental intrinsic results
1097     }
1098   }
1099   // The rank is always known even if the extents are not.
1100   return Shape(static_cast<std::size_t>(call.Rank()), MaybeExtentExpr{});
1101 }
1102
1103 void GetShapeHelper::AccumulateExtent(
1104     ExtentExpr &result, ExtentExpr &&n) const {
1105   result = std::move(result) + std::move(n);
1106   if (context_) {
1107     // Fold during expression creation to avoid creating an expression so
1108     // large we can't evaluate it without overflowing the stack.
1109     result = Fold(*context_, std::move(result));
1110   }
1111 }
1112
1113 // Check conformance of the passed shapes.
1114 std::optional<bool> CheckConformance(parser::ContextualMessages &messages,
1115     const Shape &left, const Shape &right, CheckConformanceFlags::Flags flags,
1116     const char *leftIs, const char *rightIs) {
1117   int n{GetRank(left)};
1118   if (n == 0 && (flags & CheckConformanceFlags::LeftScalarExpandable)) {
1119     return true;
1120   }
1121   int rn{GetRank(right)};
1122   if (rn == 0 && (flags & CheckConformanceFlags::RightScalarExpandable)) {
1123     return true;
1124   }
1125   if (n != rn) {
1126     messages.Say("Rank of %1$s is %2$d, but %3$s has rank %4$d"_err_en_US,
1127         leftIs, n, rightIs, rn);
1128     return false;
1129   }
1130   for (int j{0}; j < n; ++j) {
1131     if (auto leftDim{ToInt64(left[j])}) {
1132       if (auto rightDim{ToInt64(right[j])}) {
1133         if (*leftDim != *rightDim) {
1134           messages.Say("Dimension %1$d of %2$s has extent %3$jd, "
1135                        "but %4$s has extent %5$jd"_err_en_US,
1136               j + 1, leftIs, *leftDim, rightIs, *rightDim);
1137           return false;
1138         }
1139       } else if (!(flags & CheckConformanceFlags::RightIsDeferredShape)) {
1140         return std::nullopt;
1141       }
1142     } else if (!(flags & CheckConformanceFlags::LeftIsDeferredShape)) {
1143       return std::nullopt;
1144     }
1145   }
1146   return true;
1147 }
1148
1149 bool IncrementSubscripts(
1150     ConstantSubscripts &indices, const ConstantSubscripts &extents) {
1151   std::size_t rank(indices.size());
1152   CHECK(rank <= extents.size());
1153   for (std::size_t j{0}; j < rank; ++j) {
1154     if (extents[j] < 1) {
1155       return false;
1156     }
1157   }
1158   for (std::size_t j{0}; j < rank; ++j) {
1159     if (indices[j]++ < extents[j]) {
1160       return true;
1161     }
1162     indices[j] = 1;
1163   }
1164   return false;
1165 }
1166
1167 } // namespace Fortran::evaluate