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
22using namespace std::placeholders; // _1, _2, &c. for std::bind()
23
24namespace Fortran::evaluate {
25
26bool 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
33bool 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
45Shape 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
56auto 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
79Shape 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
87std::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
99std::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
110Constant<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
119ConstantSubscripts 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
127std::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
136Shape 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
144std::optional<Shape> AsShape(const std::optional<ConstantSubscripts> &shape) {
145 if (shape) {
146 return AsShape(*shape);
147 } else {
148 return std::nullopt;
149 }
150}
151
152Shape 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
159std::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
168static 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
178ExtentExpr CountTrips(
179 ExtentExpr &&lower, ExtentExpr &&upper, ExtentExpr &&stride) {
180 return ComputeTripCount(
181 std::move(lower), std::move(upper), std::move(stride));
182}
183
184ExtentExpr 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
190MaybeExtentExpr 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
198MaybeExtentExpr 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
210ConstantSubscript 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
219bool 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.
232template <typename RESULT, bool LBOUND_SEMANTICS>
233class GetLowerBoundHelper
234 : public Traverse<GetLowerBoundHelper<RESULT, LBOUND_SEMANTICS>, RESULT> {
235public:
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
377private:
378 int dimension_; // zero-based
379 FoldingContext *context_{nullptr};
380 bool invariantOnly_{false};
381};
382
383ExtentExpr GetRawLowerBound(
384 const NamedEntity &base, int dimension, bool invariantOnly) {
385 return GetLowerBoundHelper<ExtentExpr, false>{
386 dimension, nullptr, invariantOnly}(base);
387}
388
389ExtentExpr 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
396MaybeExtentExpr GetLBOUND(
397 const NamedEntity &base, int dimension, bool invariantOnly) {
398 return GetLowerBoundHelper<MaybeExtentExpr, true>{
399 dimension, nullptr, invariantOnly}(base);
400}
401
402MaybeExtentExpr 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
409Shape 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
418Shape 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
428Shape 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
437Shape 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.
450static 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
480static 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
499MaybeExtentExpr 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
547MaybeExtentExpr GetExtent(FoldingContext &context, const NamedEntity &base,
548 int dimension, bool invariantOnly) {
549 return Fold(context, GetExtent(base, dimension, invariantOnly));
550}
551
552MaybeExtentExpr 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
581MaybeExtentExpr 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
586MaybeExtentExpr 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
599MaybeExtentExpr ComputeUpperBound(
600 FoldingContext &context, ExtentExpr &&lower, MaybeExtentExpr &&extent) {
601 return Fold(context, ComputeUpperBound(std::move(lower), std::move(extent)));
602}
603
604MaybeExtentExpr 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
635MaybeExtentExpr GetRawUpperBound(FoldingContext &context,
636 const NamedEntity &base, int dimension, bool invariantOnly) {
637 return Fold(context, GetRawUpperBound(base, dimension, invariantOnly));
638}
639
640static 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
658static 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
697MaybeExtentExpr GetUBOUND(
698 const NamedEntity &base, int dimension, bool invariantOnly) {
699 return GetUBOUND(nullptr, base, dimension, invariantOnly);
700}
701
702MaybeExtentExpr GetUBOUND(FoldingContext &context, const NamedEntity &base,
703 int dimension, bool invariantOnly) {
704 return Fold(context, GetUBOUND(&context, base, dimension, invariantOnly));
705}
706
707static 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
717Shape GetUBOUNDs(
718 FoldingContext &context, const NamedEntity &base, bool invariantOnly) {
719 return Fold(context, GetUBOUNDs(&context, base, invariantOnly));
720}
721
722Shape GetUBOUNDs(const NamedEntity &base, bool invariantOnly) {
723 return GetUBOUNDs(nullptr, base, invariantOnly);
724}
725
726auto GetShapeHelper::operator()(const Symbol &symbol) const -> Result {
727 return common::visit(
728 common::visitors{
729 [&](const semantics::ObjectEntityDetails &object) {
730 if (IsImpliedShape(symbol) && object.init()) {
731 return (*this)(object.init());
732 } else if (IsAssumedRank(symbol)) {
733 return Result{};
734 } else {
735 int n{object.shape().Rank()};
736 NamedEntity base{symbol};
737 return Result{CreateShape(n, base)};
738 }
739 },
740 [](const semantics::EntityDetails &) {
741 return ScalarShape(); // no dimensions seen
742 },
743 [&](const semantics::ProcEntityDetails &proc) {
744 if (const Symbol * interface{proc.procInterface()}) {
745 return (*this)(*interface);
746 } else {
747 return ScalarShape();
748 }
749 },
750 [&](const semantics::AssocEntityDetails &assoc) {
751 NamedEntity base{symbol};
752 if (assoc.rank()) { // SELECT RANK case
753 int n{assoc.rank().value()};
754 return Result{CreateShape(n, base)};
755 } else {
756 auto exprShape{((*this)(assoc.expr()))};
757 if (exprShape) {
758 int rank{static_cast<int>(exprShape->size())};
759 for (int dimension{0}; dimension < rank; ++dimension) {
760 auto &extent{(*exprShape)[dimension]};
761 if (extent && !IsActuallyConstant(*extent)) {
762 extent = GetExtent(base, dimension);
763 }
764 }
765 }
766 return exprShape;
767 }
768 },
769 [&](const semantics::SubprogramDetails &subp) -> Result {
770 if (subp.isFunction()) {
771 auto resultShape{(*this)(subp.result())};
772 if (resultShape && !useResultSymbolShape_) {
773 // Ensure the shape is constant. Otherwise, it may be referring
774 // to symbols that belong to the function's scope and are
775 // meaningless on the caller side without the related call
776 // expression.
777 for (auto &extent : *resultShape) {
778 if (extent && !IsActuallyConstant(*extent)) {
779 extent.reset();
780 }
781 }
782 }
783 return resultShape;
784 } else {
785 return Result{};
786 }
787 },
788 [&](const semantics::ProcBindingDetails &binding) {
789 return (*this)(binding.symbol());
790 },
791 [](const semantics::TypeParamDetails &) { return ScalarShape(); },
792 [](const auto &) { return Result{}; },
793 },
794 symbol.GetUltimate().details());
795}
796
797auto GetShapeHelper::operator()(const Component &component) const -> Result {
798 const Symbol &symbol{component.GetLastSymbol()};
799 int rank{symbol.Rank()};
800 if (rank == 0) {
801 return (*this)(component.base());
802 } else if (symbol.has<semantics::ObjectEntityDetails>()) {
803 NamedEntity base{Component{component}};
804 return CreateShape(rank, base);
805 } else {
806 return (*this)(symbol);
807 }
808}
809
810auto GetShapeHelper::operator()(const ArrayRef &arrayRef) const -> Result {
811 Shape shape;
812 int dimension{0};
813 const NamedEntity &base{arrayRef.base()};
814 for (const Subscript &ss : arrayRef.subscript()) {
815 if (ss.Rank() > 0) {
816 shape.emplace_back(GetExtent(ss, base, dimension));
817 }
818 ++dimension;
819 }
820 if (shape.empty()) {
821 if (const Component * component{base.UnwrapComponent()}) {
822 return (*this)(component->base());
823 }
824 }
825 return shape;
826}
827
828auto GetShapeHelper::operator()(const CoarrayRef &coarrayRef) const -> Result {
829 NamedEntity base{coarrayRef.GetBase()};
830 if (coarrayRef.subscript().empty()) {
831 return (*this)(base);
832 } else {
833 Shape shape;
834 int dimension{0};
835 for (const Subscript &ss : coarrayRef.subscript()) {
836 if (ss.Rank() > 0) {
837 shape.emplace_back(GetExtent(ss, base, dimension));
838 }
839 ++dimension;
840 }
841 return shape;
842 }
843}
844
845auto GetShapeHelper::operator()(const Substring &substring) const -> Result {
846 return (*this)(substring.parent());
847}
848
849auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
850 if (call.Rank() == 0) {
851 return ScalarShape();
852 } else if (call.IsElemental()) {
853 // Use the shape of an actual array argument associated with a
854 // non-OPTIONAL dummy object argument.
855 if (context_) {
856 if (auto chars{characteristics::Procedure::FromActuals(
857 call.proc(), call.arguments(), *context_)}) {
858 std::size_t j{0};
859 std::size_t anyArrayArgRank{0};
860 for (const auto &arg : call.arguments()) {
861 if (arg && arg->Rank() > 0 && j < chars->dummyArguments.size()) {
862 anyArrayArgRank = arg->Rank();
863 if (!chars->dummyArguments[j].IsOptional()) {
864 return (*this)(*arg);
865 }
866 }
867 ++j;
868 }
869 if (anyArrayArgRank) {
870 // All dummy array arguments of the procedure are OPTIONAL.
871 // We cannot take the shape from just any array argument,
872 // because all of them might be OPTIONAL dummy arguments
873 // of the caller. Return unknown shape ranked according
874 // to the last actual array argument.
875 return Shape(anyArrayArgRank, MaybeExtentExpr{});
876 }
877 }
878 }
879 return ScalarShape();
880 } else if (const Symbol * symbol{call.proc().GetSymbol()}) {
881 auto restorer{common::ScopedSet(useResultSymbolShape_, false)};
882 return (*this)(*symbol);
883 } else if (const auto *intrinsic{call.proc().GetSpecificIntrinsic()}) {
884 if (intrinsic->name == "shape" || intrinsic->name == "lbound" ||
885 intrinsic->name == "ubound") {
886 // For LBOUND/UBOUND, these are the array-valued cases (no DIM=)
887 if (!call.arguments().empty() && call.arguments().front()) {
888 return Shape{
889 MaybeExtentExpr{ExtentExpr{call.arguments().front()->Rank()}}};
890 }
891 } else if (intrinsic->name == "all" || intrinsic->name == "any" ||
892 intrinsic->name == "count" || intrinsic->name == "iall" ||
893 intrinsic->name == "iany" || intrinsic->name == "iparity" ||
894 intrinsic->name == "maxval" || intrinsic->name == "minval" ||
895 intrinsic->name == "norm2" || intrinsic->name == "parity" ||
896 intrinsic->name == "product" || intrinsic->name == "sum") {
897 // Reduction with DIM=
898 if (call.arguments().size() >= 2) {
899 auto arrayShape{
900 (*this)(UnwrapExpr<Expr<SomeType>>(call.arguments().at(0)))};
901 const auto *dimArg{UnwrapExpr<Expr<SomeType>>(call.arguments().at(1))};
902 if (arrayShape && dimArg) {
903 if (auto dim{ToInt64(*dimArg)}) {
904 if (*dim >= 1 &&
905 static_cast<std::size_t>(*dim) <= arrayShape->size()) {
906 arrayShape->erase(arrayShape->begin() + (*dim - 1));
907 return std::move(*arrayShape);
908 }
909 }
910 }
911 }
912 } else if (intrinsic->name == "findloc" || intrinsic->name == "maxloc" ||
913 intrinsic->name == "minloc") {
914 std::size_t dimIndex{intrinsic->name == "findloc" ? 2u : 1u};
915 if (call.arguments().size() > dimIndex) {
916 if (auto arrayShape{
917 (*this)(UnwrapExpr<Expr<SomeType>>(call.arguments().at(0)))}) {
918 auto rank{static_cast<int>(arrayShape->size())};
919 if (const auto *dimArg{
920 UnwrapExpr<Expr<SomeType>>(call.arguments()[dimIndex])}) {
921 auto dim{ToInt64(*dimArg)};
922 if (dim && *dim >= 1 && *dim <= rank) {
923 arrayShape->erase(arrayShape->begin() + (*dim - 1));
924 return std::move(*arrayShape);
925 }
926 } else {
927 // xxxLOC(no DIM=) result is vector(1:RANK(ARRAY=))
928 return Shape{ExtentExpr{rank}};
929 }
930 }
931 }
932 } else if (intrinsic->name == "cshift" || intrinsic->name == "eoshift") {
933 if (!call.arguments().empty()) {
934 return (*this)(call.arguments()[0]);
935 }
936 } else if (intrinsic->name == "matmul") {
937 if (call.arguments().size() == 2) {
938 if (auto ashape{(*this)(call.arguments()[0])}) {
939 if (auto bshape{(*this)(call.arguments()[1])}) {
940 if (ashape->size() == 1 && bshape->size() == 2) {
941 bshape->erase(bshape->begin());
942 return std::move(*bshape); // matmul(vector, matrix)
943 } else if (ashape->size() == 2 && bshape->size() == 1) {
944 ashape->pop_back();
945 return std::move(*ashape); // matmul(matrix, vector)
946 } else if (ashape->size() == 2 && bshape->size() == 2) {
947 (*ashape)[1] = std::move((*bshape)[1]);
948 return std::move(*ashape); // matmul(matrix, matrix)
949 }
950 }
951 }
952 }
953 } else if (intrinsic->name == "pack") {
954 if (call.arguments().size() >= 3 && call.arguments().at(2)) {
955 // SHAPE(PACK(,,VECTOR=v)) -> SHAPE(v)
956 return (*this)(call.arguments().at(2));
957 } else if (call.arguments().size() >= 2 && context_) {
958 if (auto maskShape{(*this)(call.arguments().at(1))}) {
959 if (maskShape->size() == 0) {
960 // Scalar MASK= -> [MERGE(SIZE(ARRAY=), 0, mask)]
961 if (auto arrayShape{(*this)(call.arguments().at(0))}) {
962 if (auto arraySize{GetSize(std::move(*arrayShape))}) {
963 ActualArguments toMerge{
964 ActualArgument{AsGenericExpr(std::move(*arraySize))},
965 ActualArgument{AsGenericExpr(ExtentExpr{0})},
966 common::Clone(call.arguments().at(1))};
967 auto specific{context_->intrinsics().Probe(
968 CallCharacteristics{"merge"}, toMerge, *context_)};
969 CHECK(specific);
970 return Shape{ExtentExpr{FunctionRef<ExtentType>{
971 ProcedureDesignator{std::move(specific->specificIntrinsic)},
972 std::move(specific->arguments)}}};
973 }
974 }
975 } else {
976 // Non-scalar MASK= -> [COUNT(mask, KIND=extent_kind)]
977 ActualArgument kindArg{
978 AsGenericExpr(Constant<ExtentType>{ExtentType::kind})};
979 kindArg.set_keyword(context_->SaveTempName("kind"));
980 ActualArguments toCount{
981 ActualArgument{common::Clone(
982 DEREF(call.arguments().at(1).value().UnwrapExpr()))},
983 std::move(kindArg)};
984 auto specific{context_->intrinsics().Probe(
985 CallCharacteristics{"count"}, toCount, *context_)};
986 CHECK(specific);
987 return Shape{ExtentExpr{FunctionRef<ExtentType>{
988 ProcedureDesignator{std::move(specific->specificIntrinsic)},
989 std::move(specific->arguments)}}};
990 }
991 }
992 }
993 } else if (intrinsic->name == "reshape") {
994 if (call.arguments().size() >= 2 && call.arguments().at(1)) {
995 // SHAPE(RESHAPE(array,shape)) -> shape
996 if (const auto *shapeExpr{
997 call.arguments().at(1).value().UnwrapExpr()}) {
998 auto shapeArg{std::get<Expr<SomeInteger>>(shapeExpr->u)};
999 if (auto result{AsShapeResult(
1000 ConvertToType<ExtentType>(std::move(shapeArg)))}) {
1001 return result;
1002 }
1003 }
1004 }
1005 } else if (intrinsic->name == "spread") {
1006 // SHAPE(SPREAD(ARRAY,DIM,NCOPIES)) = SHAPE(ARRAY) with NCOPIES inserted
1007 // at position DIM.
1008 if (call.arguments().size() == 3) {
1009 auto arrayShape{
1010 (*this)(UnwrapExpr<Expr<SomeType>>(call.arguments().at(0)))};
1011 const auto *dimArg{UnwrapExpr<Expr<SomeType>>(call.arguments().at(1))};
1012 const auto *nCopies{
1013 UnwrapExpr<Expr<SomeInteger>>(call.arguments().at(2))};
1014 if (arrayShape && dimArg && nCopies) {
1015 if (auto dim{ToInt64(*dimArg)}) {
1016 if (*dim >= 1 &&
1017 static_cast<std::size_t>(*dim) <= arrayShape->size() + 1) {
1018 arrayShape->emplace(arrayShape->begin() + *dim - 1,
1019 ConvertToType<ExtentType>(common::Clone(*nCopies)));
1020 return std::move(*arrayShape);
1021 }
1022 }
1023 }
1024 }
1025 } else if (intrinsic->name == "transfer") {
1026 if (call.arguments().size() == 3 && call.arguments().at(2)) {
1027 // SIZE= is present; shape is vector [SIZE=]
1028 if (const auto *size{
1029 UnwrapExpr<Expr<SomeInteger>>(call.arguments().at(2))}) {
1030 return Shape{
1031 MaybeExtentExpr{ConvertToType<ExtentType>(common::Clone(*size))}};
1032 }
1033 } else if (context_) {
1034 if (auto moldTypeAndShape{characteristics::TypeAndShape::Characterize(
1035 call.arguments().at(1), *context_)}) {
1036 if (GetRank(moldTypeAndShape->shape()) == 0) {
1037 // SIZE= is absent and MOLD= is scalar: result is scalar
1038 return ScalarShape();
1039 } else {
1040 // SIZE= is absent and MOLD= is array: result is vector whose
1041 // length is determined by sizes of types. See 16.9.193p4 case(ii).
1042 // Note that if sourceBytes is not known to be empty, we
1043 // can fold only when moldElementBytes is known to not be zero;
1044 // the most general case risks a division by zero otherwise.
1045 if (auto sourceTypeAndShape{
1046 characteristics::TypeAndShape::Characterize(
1047 call.arguments().at(0), *context_)}) {
1048 if (auto sourceBytes{
1049 sourceTypeAndShape->MeasureSizeInBytes(*context_)}) {
1050 *sourceBytes = Fold(*context_, std::move(*sourceBytes));
1051 if (auto sourceBytesConst{ToInt64(*sourceBytes)}) {
1052 if (*sourceBytesConst == 0) {
1053 return Shape{ExtentExpr{0}};
1054 }
1055 }
1056 if (auto moldElementBytes{
1057 moldTypeAndShape->MeasureElementSizeInBytes(
1058 *context_, true)}) {
1059 *moldElementBytes =
1060 Fold(*context_, std::move(*moldElementBytes));
1061 auto moldElementBytesConst{ToInt64(*moldElementBytes)};
1062 if (moldElementBytesConst && *moldElementBytesConst != 0) {
1063 ExtentExpr extent{Fold(*context_,
1064 (std::move(*sourceBytes) +
1065 common::Clone(*moldElementBytes) - ExtentExpr{1}) /
1066 common::Clone(*moldElementBytes))};
1067 return Shape{MaybeExtentExpr{std::move(extent)}};
1068 }
1069 }
1070 }
1071 }
1072 }
1073 }
1074 }
1075 } else if (intrinsic->name == "transpose") {
1076 if (call.arguments().size() >= 1) {
1077 if (auto shape{(*this)(call.arguments().at(0))}) {
1078 if (shape->size() == 2) {
1079 std::swap((*shape)[0], (*shape)[1]);
1080 return shape;
1081 }
1082 }
1083 }
1084 } else if (intrinsic->name == "unpack") {
1085 if (call.arguments().size() >= 2) {
1086 return (*this)(call.arguments()[1]); // MASK=
1087 }
1088 } else if (intrinsic->characteristics.value().attrs.test(characteristics::
1089 Procedure::Attr::NullPointer)) { // NULL(MOLD=)
1090 return (*this)(call.arguments());
1091 } else {
1092 // TODO: shapes of other non-elemental intrinsic results
1093 }
1094 }
1095 // The rank is always known even if the extents are not.
1096 return Shape(static_cast<std::size_t>(call.Rank()), MaybeExtentExpr{});
1097}
1098
1099void GetShapeHelper::AccumulateExtent(
1100 ExtentExpr &result, ExtentExpr &&n) const {
1101 result = std::move(result) + std::move(n);
1102 if (context_) {
1103 // Fold during expression creation to avoid creating an expression so
1104 // large we can't evaluate it without overflowing the stack.
1105 result = Fold(*context_, std::move(result));
1106 }
1107}
1108
1109// Check conformance of the passed shapes.
1110std::optional<bool> CheckConformance(parser::ContextualMessages &messages,
1111 const Shape &left, const Shape &right, CheckConformanceFlags::Flags flags,
1112 const char *leftIs, const char *rightIs) {
1113 int n{GetRank(left)};
1114 if (n == 0 && (flags & CheckConformanceFlags::LeftScalarExpandable)) {
1115 return true;
1116 }
1117 int rn{GetRank(right)};
1118 if (rn == 0 && (flags & CheckConformanceFlags::RightScalarExpandable)) {
1119 return true;
1120 }
1121 if (n != rn) {
1122 messages.Say("Rank of %1$s is %2$d, but %3$s has rank %4$d"_err_en_US,
1123 leftIs, n, rightIs, rn);
1124 return false;
1125 }
1126 for (int j{0}; j < n; ++j) {
1127 if (auto leftDim{ToInt64(left[j])}) {
1128 if (auto rightDim{ToInt64(right[j])}) {
1129 if (*leftDim != *rightDim) {
1130 messages.Say("Dimension %1$d of %2$s has extent %3$jd, "
1131 "but %4$s has extent %5$jd"_err_en_US,
1132 j + 1, leftIs, *leftDim, rightIs, *rightDim);
1133 return false;
1134 }
1135 } else if (!(flags & CheckConformanceFlags::RightIsDeferredShape)) {
1136 return std::nullopt;
1137 }
1138 } else if (!(flags & CheckConformanceFlags::LeftIsDeferredShape)) {
1139 return std::nullopt;
1140 }
1141 }
1142 return true;
1143}
1144
1145bool IncrementSubscripts(
1146 ConstantSubscripts &indices, const ConstantSubscripts &extents) {
1147 std::size_t rank(indices.size());
1148 CHECK(rank <= extents.size());
1149 for (std::size_t j{0}; j < rank; ++j) {
1150 if (extents[j] < 1) {
1151 return false;
1152 }
1153 }
1154 for (std::size_t j{0}; j < rank; ++j) {
1155 if (indices[j]++ < extents[j]) {
1156 return true;
1157 }
1158 indices[j] = 1;
1159 }
1160 return false;
1161}
1162
1163} // namespace Fortran::evaluate
1164

source code of flang/lib/Evaluate/shape.cpp