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