xref: /llvm-project/flang/lib/Evaluate/shape.cpp (revision 94963919011d77c2f3f9d867cb73067a4f50e87c) 
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 MaybeExtentExpr GetLCOBOUND(
727     const Symbol &symbol0, int dimension, bool invariantOnly) {
728   const Symbol &symbol{ResolveAssociations(symbol0)};
729   if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
730     int corank{object->coshape().Rank()};
731     if (dimension < corank) {
732       const semantics::ShapeSpec &shapeSpec{object->coshape()[dimension]};
733       if (const auto &lcobound{shapeSpec.lbound().GetExplicit()}) {
734         if (!invariantOnly || IsScopeInvariantExpr(*lcobound)) {
735           return *lcobound;
736         }
737       }
738     }
739   }
740   return std::nullopt;
741 }
742 
743 MaybeExtentExpr GetUCOBOUND(
744     const Symbol &symbol0, int dimension, bool invariantOnly) {
745   const Symbol &symbol{ResolveAssociations(symbol0)};
746   if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
747     int corank{object->coshape().Rank()};
748     if (dimension < corank - 1) {
749       const semantics::ShapeSpec &shapeSpec{object->coshape()[dimension]};
750       if (const auto ucobound{shapeSpec.ubound().GetExplicit()}) {
751         if (!invariantOnly || IsScopeInvariantExpr(*ucobound)) {
752           return *ucobound;
753         }
754       }
755     }
756   }
757   return std::nullopt;
758 }
759 
760 Shape GetLCOBOUNDs(const Symbol &symbol, bool invariantOnly) {
761   Shape result;
762   int corank{symbol.Corank()};
763   for (int dim{0}; dim < corank; ++dim) {
764     result.emplace_back(GetLCOBOUND(symbol, dim, invariantOnly));
765   }
766   return result;
767 }
768 
769 Shape GetUCOBOUNDs(const Symbol &symbol, bool invariantOnly) {
770   Shape result;
771   int corank{symbol.Corank()};
772   for (int dim{0}; dim < corank; ++dim) {
773     result.emplace_back(GetUCOBOUND(symbol, dim, invariantOnly));
774   }
775   return result;
776 }
777 
778 auto GetShapeHelper::operator()(const Symbol &symbol) const -> Result {
779   return common::visit(
780       common::visitors{
781           [&](const semantics::ObjectEntityDetails &object) {
782             if (IsImpliedShape(symbol) && object.init()) {
783               return (*this)(object.init());
784             } else if (IsAssumedRank(symbol)) {
785               return Result{};
786             } else {
787               int n{object.shape().Rank()};
788               NamedEntity base{symbol};
789               return Result{CreateShape(n, base)};
790             }
791           },
792           [](const semantics::EntityDetails &) {
793             return ScalarShape(); // no dimensions seen
794           },
795           [&](const semantics::ProcEntityDetails &proc) {
796             if (const Symbol * interface{proc.procInterface()}) {
797               return (*this)(*interface);
798             } else {
799               return ScalarShape();
800             }
801           },
802           [&](const semantics::AssocEntityDetails &assoc) {
803             NamedEntity base{symbol};
804             if (assoc.rank()) { // SELECT RANK case
805               int n{assoc.rank().value()};
806               return Result{CreateShape(n, base)};
807             } else {
808               auto exprShape{((*this)(assoc.expr()))};
809               if (exprShape) {
810                 int rank{static_cast<int>(exprShape->size())};
811                 for (int dimension{0}; dimension < rank; ++dimension) {
812                   auto &extent{(*exprShape)[dimension]};
813                   if (extent && !IsActuallyConstant(*extent)) {
814                     extent = GetExtent(base, dimension);
815                   }
816                 }
817               }
818               return exprShape;
819             }
820           },
821           [&](const semantics::SubprogramDetails &subp) -> Result {
822             if (subp.isFunction()) {
823               auto resultShape{(*this)(subp.result())};
824               if (resultShape && !useResultSymbolShape_) {
825                 // Ensure the shape is constant. Otherwise, it may be referring
826                 // to symbols that belong to the function's scope and are
827                 // meaningless on the caller side without the related call
828                 // expression.
829                 for (auto &extent : *resultShape) {
830                   if (extent && !IsActuallyConstant(*extent)) {
831                     extent.reset();
832                   }
833                 }
834               }
835               return resultShape;
836             } else {
837               return Result{};
838             }
839           },
840           [&](const semantics::ProcBindingDetails &binding) {
841             return (*this)(binding.symbol());
842           },
843           [](const semantics::TypeParamDetails &) { return ScalarShape(); },
844           [](const auto &) { return Result{}; },
845       },
846       symbol.GetUltimate().details());
847 }
848 
849 auto GetShapeHelper::operator()(const Component &component) const -> Result {
850   const Symbol &symbol{component.GetLastSymbol()};
851   int rank{symbol.Rank()};
852   if (rank == 0) {
853     return (*this)(component.base());
854   } else if (symbol.has<semantics::ObjectEntityDetails>()) {
855     NamedEntity base{Component{component}};
856     return CreateShape(rank, base);
857   } else {
858     return (*this)(symbol);
859   }
860 }
861 
862 auto GetShapeHelper::operator()(const ArrayRef &arrayRef) const -> Result {
863   Shape shape;
864   int dimension{0};
865   const NamedEntity &base{arrayRef.base()};
866   for (const Subscript &ss : arrayRef.subscript()) {
867     if (ss.Rank() > 0) {
868       shape.emplace_back(GetExtent(ss, base, dimension));
869     }
870     ++dimension;
871   }
872   if (shape.empty()) {
873     if (const Component * component{base.UnwrapComponent()}) {
874       return (*this)(component->base());
875     }
876   }
877   return shape;
878 }
879 
880 auto GetShapeHelper::operator()(const CoarrayRef &coarrayRef) const -> Result {
881   NamedEntity base{coarrayRef.GetBase()};
882   if (coarrayRef.subscript().empty()) {
883     return (*this)(base);
884   } else {
885     Shape shape;
886     int dimension{0};
887     for (const Subscript &ss : coarrayRef.subscript()) {
888       if (ss.Rank() > 0) {
889         shape.emplace_back(GetExtent(ss, base, dimension));
890       }
891       ++dimension;
892     }
893     return shape;
894   }
895 }
896 
897 auto GetShapeHelper::operator()(const Substring &substring) const -> Result {
898   return (*this)(substring.parent());
899 }
900 
901 auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
902   if (call.Rank() == 0) {
903     return ScalarShape();
904   } else if (call.IsElemental()) {
905     // Use the shape of an actual array argument associated with a
906     // non-OPTIONAL dummy object argument.
907     if (context_) {
908       if (auto chars{characteristics::Procedure::FromActuals(
909               call.proc(), call.arguments(), *context_)}) {
910         std::size_t j{0};
911         std::size_t anyArrayArgRank{0};
912         for (const auto &arg : call.arguments()) {
913           if (arg && arg->Rank() > 0 && j < chars->dummyArguments.size()) {
914             anyArrayArgRank = arg->Rank();
915             if (!chars->dummyArguments[j].IsOptional()) {
916               return (*this)(*arg);
917             }
918           }
919           ++j;
920         }
921         if (anyArrayArgRank) {
922           // All dummy array arguments of the procedure are OPTIONAL.
923           // We cannot take the shape from just any array argument,
924           // because all of them might be OPTIONAL dummy arguments
925           // of the caller. Return unknown shape ranked according
926           // to the last actual array argument.
927           return Shape(anyArrayArgRank, MaybeExtentExpr{});
928         }
929       }
930     }
931     return ScalarShape();
932   } else if (const Symbol * symbol{call.proc().GetSymbol()}) {
933     auto restorer{common::ScopedSet(useResultSymbolShape_, false)};
934     return (*this)(*symbol);
935   } else if (const auto *intrinsic{call.proc().GetSpecificIntrinsic()}) {
936     if (intrinsic->name == "shape" || intrinsic->name == "lbound" ||
937         intrinsic->name == "ubound") {
938       // For LBOUND/UBOUND, these are the array-valued cases (no DIM=)
939       if (!call.arguments().empty() && call.arguments().front()) {
940         if (IsAssumedRank(*call.arguments().front())) {
941           return Shape{MaybeExtentExpr{}};
942         } else {
943           return Shape{
944               MaybeExtentExpr{ExtentExpr{call.arguments().front()->Rank()}}};
945         }
946       }
947     } else if (intrinsic->name == "all" || intrinsic->name == "any" ||
948         intrinsic->name == "count" || intrinsic->name == "iall" ||
949         intrinsic->name == "iany" || intrinsic->name == "iparity" ||
950         intrinsic->name == "maxval" || intrinsic->name == "minval" ||
951         intrinsic->name == "norm2" || intrinsic->name == "parity" ||
952         intrinsic->name == "product" || intrinsic->name == "sum") {
953       // Reduction with DIM=
954       if (call.arguments().size() >= 2) {
955         auto arrayShape{
956             (*this)(UnwrapExpr<Expr<SomeType>>(call.arguments().at(0)))};
957         const auto *dimArg{UnwrapExpr<Expr<SomeType>>(call.arguments().at(1))};
958         if (arrayShape && dimArg) {
959           if (auto dim{ToInt64(*dimArg)}) {
960             if (*dim >= 1 &&
961                 static_cast<std::size_t>(*dim) <= arrayShape->size()) {
962               arrayShape->erase(arrayShape->begin() + (*dim - 1));
963               return std::move(*arrayShape);
964             }
965           }
966         }
967       }
968     } else if (intrinsic->name == "findloc" || intrinsic->name == "maxloc" ||
969         intrinsic->name == "minloc") {
970       std::size_t dimIndex{intrinsic->name == "findloc" ? 2u : 1u};
971       if (call.arguments().size() > dimIndex) {
972         if (auto arrayShape{
973                 (*this)(UnwrapExpr<Expr<SomeType>>(call.arguments().at(0)))}) {
974           auto rank{static_cast<int>(arrayShape->size())};
975           if (const auto *dimArg{
976                   UnwrapExpr<Expr<SomeType>>(call.arguments()[dimIndex])}) {
977             auto dim{ToInt64(*dimArg)};
978             if (dim && *dim >= 1 && *dim <= rank) {
979               arrayShape->erase(arrayShape->begin() + (*dim - 1));
980               return std::move(*arrayShape);
981             }
982           } else {
983             // xxxLOC(no DIM=) result is vector(1:RANK(ARRAY=))
984             return Shape{ExtentExpr{rank}};
985           }
986         }
987       }
988     } else if (intrinsic->name == "cshift" || intrinsic->name == "eoshift") {
989       if (!call.arguments().empty()) {
990         return (*this)(call.arguments()[0]);
991       }
992     } else if (intrinsic->name == "matmul") {
993       if (call.arguments().size() == 2) {
994         if (auto ashape{(*this)(call.arguments()[0])}) {
995           if (auto bshape{(*this)(call.arguments()[1])}) {
996             if (ashape->size() == 1 && bshape->size() == 2) {
997               bshape->erase(bshape->begin());
998               return std::move(*bshape); // matmul(vector, matrix)
999             } else if (ashape->size() == 2 && bshape->size() == 1) {
1000               ashape->pop_back();
1001               return std::move(*ashape); // matmul(matrix, vector)
1002             } else if (ashape->size() == 2 && bshape->size() == 2) {
1003               (*ashape)[1] = std::move((*bshape)[1]);
1004               return std::move(*ashape); // matmul(matrix, matrix)
1005             }
1006           }
1007         }
1008       }
1009     } else if (intrinsic->name == "pack") {
1010       if (call.arguments().size() >= 3 && call.arguments().at(2)) {
1011         // SHAPE(PACK(,,VECTOR=v)) -> SHAPE(v)
1012         return (*this)(call.arguments().at(2));
1013       } else if (call.arguments().size() >= 2 && context_) {
1014         if (auto maskShape{(*this)(call.arguments().at(1))}) {
1015           if (maskShape->size() == 0) {
1016             // Scalar MASK= -> [MERGE(SIZE(ARRAY=), 0, mask)]
1017             if (auto arrayShape{(*this)(call.arguments().at(0))}) {
1018               if (auto arraySize{GetSize(std::move(*arrayShape))}) {
1019                 ActualArguments toMerge{
1020                     ActualArgument{AsGenericExpr(std::move(*arraySize))},
1021                     ActualArgument{AsGenericExpr(ExtentExpr{0})},
1022                     common::Clone(call.arguments().at(1))};
1023                 auto specific{context_->intrinsics().Probe(
1024                     CallCharacteristics{"merge"}, toMerge, *context_)};
1025                 CHECK(specific);
1026                 return Shape{ExtentExpr{FunctionRef<ExtentType>{
1027                     ProcedureDesignator{std::move(specific->specificIntrinsic)},
1028                     std::move(specific->arguments)}}};
1029               }
1030             }
1031           } else {
1032             // Non-scalar MASK= -> [COUNT(mask, KIND=extent_kind)]
1033             ActualArgument kindArg{
1034                 AsGenericExpr(Constant<ExtentType>{ExtentType::kind})};
1035             kindArg.set_keyword(context_->SaveTempName("kind"));
1036             ActualArguments toCount{
1037                 ActualArgument{common::Clone(
1038                     DEREF(call.arguments().at(1).value().UnwrapExpr()))},
1039                 std::move(kindArg)};
1040             auto specific{context_->intrinsics().Probe(
1041                 CallCharacteristics{"count"}, toCount, *context_)};
1042             CHECK(specific);
1043             return Shape{ExtentExpr{FunctionRef<ExtentType>{
1044                 ProcedureDesignator{std::move(specific->specificIntrinsic)},
1045                 std::move(specific->arguments)}}};
1046           }
1047         }
1048       }
1049     } else if (intrinsic->name == "reshape") {
1050       if (call.arguments().size() >= 2 && call.arguments().at(1)) {
1051         // SHAPE(RESHAPE(array,shape)) -> shape
1052         if (const auto *shapeExpr{
1053                 call.arguments().at(1).value().UnwrapExpr()}) {
1054           auto shapeArg{std::get<Expr<SomeInteger>>(shapeExpr->u)};
1055           if (auto result{AsShapeResult(
1056                   ConvertToType<ExtentType>(std::move(shapeArg)))}) {
1057             return result;
1058           }
1059         }
1060       }
1061     } else if (intrinsic->name == "spread") {
1062       // SHAPE(SPREAD(ARRAY,DIM,NCOPIES)) = SHAPE(ARRAY) with NCOPIES inserted
1063       // at position DIM.
1064       if (call.arguments().size() == 3) {
1065         auto arrayShape{
1066             (*this)(UnwrapExpr<Expr<SomeType>>(call.arguments().at(0)))};
1067         const auto *dimArg{UnwrapExpr<Expr<SomeType>>(call.arguments().at(1))};
1068         const auto *nCopies{
1069             UnwrapExpr<Expr<SomeInteger>>(call.arguments().at(2))};
1070         if (arrayShape && dimArg && nCopies) {
1071           if (auto dim{ToInt64(*dimArg)}) {
1072             if (*dim >= 1 &&
1073                 static_cast<std::size_t>(*dim) <= arrayShape->size() + 1) {
1074               arrayShape->emplace(arrayShape->begin() + *dim - 1,
1075                   ConvertToType<ExtentType>(common::Clone(*nCopies)));
1076               return std::move(*arrayShape);
1077             }
1078           }
1079         }
1080       }
1081     } else if (intrinsic->name == "transfer") {
1082       if (call.arguments().size() == 3 && call.arguments().at(2)) {
1083         // SIZE= is present; shape is vector [SIZE=]
1084         if (const auto *size{
1085                 UnwrapExpr<Expr<SomeInteger>>(call.arguments().at(2))}) {
1086           return Shape{
1087               MaybeExtentExpr{ConvertToType<ExtentType>(common::Clone(*size))}};
1088         }
1089       } else if (context_) {
1090         if (auto moldTypeAndShape{characteristics::TypeAndShape::Characterize(
1091                 call.arguments().at(1), *context_)}) {
1092           if (moldTypeAndShape->Rank() == 0) {
1093             // SIZE= is absent and MOLD= is scalar: result is scalar
1094             return ScalarShape();
1095           } else {
1096             // SIZE= is absent and MOLD= is array: result is vector whose
1097             // length is determined by sizes of types.  See 16.9.193p4 case(ii).
1098             // Note that if sourceBytes is not known to be empty, we
1099             // can fold only when moldElementBytes is known to not be zero;
1100             // the most general case risks a division by zero otherwise.
1101             if (auto sourceTypeAndShape{
1102                     characteristics::TypeAndShape::Characterize(
1103                         call.arguments().at(0), *context_)}) {
1104               if (auto sourceBytes{
1105                       sourceTypeAndShape->MeasureSizeInBytes(*context_)}) {
1106                 *sourceBytes = Fold(*context_, std::move(*sourceBytes));
1107                 if (auto sourceBytesConst{ToInt64(*sourceBytes)}) {
1108                   if (*sourceBytesConst == 0) {
1109                     return Shape{ExtentExpr{0}};
1110                   }
1111                 }
1112                 if (auto moldElementBytes{
1113                         moldTypeAndShape->MeasureElementSizeInBytes(
1114                             *context_, true)}) {
1115                   *moldElementBytes =
1116                       Fold(*context_, std::move(*moldElementBytes));
1117                   auto moldElementBytesConst{ToInt64(*moldElementBytes)};
1118                   if (moldElementBytesConst && *moldElementBytesConst != 0) {
1119                     ExtentExpr extent{Fold(*context_,
1120                         (std::move(*sourceBytes) +
1121                             common::Clone(*moldElementBytes) - ExtentExpr{1}) /
1122                             common::Clone(*moldElementBytes))};
1123                     return Shape{MaybeExtentExpr{std::move(extent)}};
1124                   }
1125                 }
1126               }
1127             }
1128           }
1129         }
1130       }
1131     } else if (intrinsic->name == "transpose") {
1132       if (call.arguments().size() >= 1) {
1133         if (auto shape{(*this)(call.arguments().at(0))}) {
1134           if (shape->size() == 2) {
1135             std::swap((*shape)[0], (*shape)[1]);
1136             return shape;
1137           }
1138         }
1139       }
1140     } else if (intrinsic->name == "unpack") {
1141       if (call.arguments().size() >= 2) {
1142         return (*this)(call.arguments()[1]); // MASK=
1143       }
1144     } else if (intrinsic->characteristics.value().attrs.test(characteristics::
1145                        Procedure::Attr::NullPointer)) { // NULL(MOLD=)
1146       return (*this)(call.arguments());
1147     } else {
1148       // TODO: shapes of other non-elemental intrinsic results
1149     }
1150   }
1151   // The rank is always known even if the extents are not.
1152   return Shape(static_cast<std::size_t>(call.Rank()), MaybeExtentExpr{});
1153 }
1154 
1155 void GetShapeHelper::AccumulateExtent(
1156     ExtentExpr &result, ExtentExpr &&n) const {
1157   result = std::move(result) + std::move(n);
1158   if (context_) {
1159     // Fold during expression creation to avoid creating an expression so
1160     // large we can't evaluate it without overflowing the stack.
1161     result = Fold(*context_, std::move(result));
1162   }
1163 }
1164 
1165 // Check conformance of the passed shapes.
1166 std::optional<bool> CheckConformance(parser::ContextualMessages &messages,
1167     const Shape &left, const Shape &right, CheckConformanceFlags::Flags flags,
1168     const char *leftIs, const char *rightIs) {
1169   int n{GetRank(left)};
1170   if (n == 0 && (flags & CheckConformanceFlags::LeftScalarExpandable)) {
1171     return true;
1172   }
1173   int rn{GetRank(right)};
1174   if (rn == 0 && (flags & CheckConformanceFlags::RightScalarExpandable)) {
1175     return true;
1176   }
1177   if (n != rn) {
1178     messages.Say("Rank of %1$s is %2$d, but %3$s has rank %4$d"_err_en_US,
1179         leftIs, n, rightIs, rn);
1180     return false;
1181   }
1182   for (int j{0}; j < n; ++j) {
1183     if (auto leftDim{ToInt64(left[j])}) {
1184       if (auto rightDim{ToInt64(right[j])}) {
1185         if (*leftDim != *rightDim) {
1186           messages.Say("Dimension %1$d of %2$s has extent %3$jd, "
1187                        "but %4$s has extent %5$jd"_err_en_US,
1188               j + 1, leftIs, *leftDim, rightIs, *rightDim);
1189           return false;
1190         }
1191       } else if (!(flags & CheckConformanceFlags::RightIsDeferredShape)) {
1192         return std::nullopt;
1193       }
1194     } else if (!(flags & CheckConformanceFlags::LeftIsDeferredShape)) {
1195       return std::nullopt;
1196     }
1197   }
1198   return true;
1199 }
1200 
1201 bool IncrementSubscripts(
1202     ConstantSubscripts &indices, const ConstantSubscripts &extents) {
1203   std::size_t rank(indices.size());
1204   CHECK(rank <= extents.size());
1205   for (std::size_t j{0}; j < rank; ++j) {
1206     if (extents[j] < 1) {
1207       return false;
1208     }
1209   }
1210   for (std::size_t j{0}; j < rank; ++j) {
1211     if (indices[j]++ < extents[j]) {
1212       return true;
1213     }
1214     indices[j] = 1;
1215   }
1216   return false;
1217 }
1218 
1219 } // namespace Fortran::evaluate
1220