1//===-- lib/Evaluate/designate.cpp ------------------------------*- C++ -*-===//
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/fold-designator.h"
10#include "flang/Semantics/tools.h"
11
12namespace Fortran::evaluate {
13
14DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(OffsetSymbol)
15
16std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
17 const Symbol &symbol, ConstantSubscript which) {
18 if (!getLastComponent_ && IsAllocatableOrPointer(symbol)) {
19 // A pointer may appear as a DATA statement object if it is the
20 // rightmost symbol in a designator and has no subscripts.
21 // An allocatable may appear if its initializer is NULL().
22 if (which > 0) {
23 isEmpty_ = true;
24 } else {
25 return OffsetSymbol{symbol, symbol.size()};
26 }
27 } else if (symbol.has<semantics::ObjectEntityDetails>() &&
28 !IsNamedConstant(symbol)) {
29 if (auto type{DynamicType::From(symbol)}) {
30 if (auto extents{GetConstantExtents(context_, symbol)}) {
31 if (auto bytes{ToInt64(
32 type->MeasureSizeInBytes(context_, GetRank(*extents) > 0))}) {
33 OffsetSymbol result{symbol, static_cast<std::size_t>(*bytes)};
34 if (which < GetSize(*extents)) {
35 result.Augment(*bytes * which);
36 return result;
37 } else {
38 isEmpty_ = true;
39 }
40 }
41 }
42 }
43 }
44 return std::nullopt;
45}
46
47std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
48 const ArrayRef &x, ConstantSubscript which) {
49 const Symbol &array{x.base().GetLastSymbol()};
50 if (auto type{DynamicType::From(array)}) {
51 if (auto extents{GetConstantExtents(context_, array)}) {
52 if (auto bytes{ToInt64(type->MeasureSizeInBytes(context_, true))}) {
53 Shape lbs{GetLBOUNDs(context_, x.base())};
54 if (auto lowerBounds{AsConstantExtents(context_, lbs)}) {
55 std::optional<OffsetSymbol> result;
56 if (!x.base().IsSymbol() &&
57 x.base().GetComponent().base().Rank() > 0) {
58 // A(:)%B(1) - apply elementNumber_ to base
59 result = FoldDesignator(x.base(), which);
60 which = 0;
61 } else { // A(1)%B(:) - apply elementNumber_ to subscripts
62 result = FoldDesignator(x.base(), 0);
63 }
64 if (!result) {
65 return std::nullopt;
66 }
67 auto stride{*bytes};
68 int dim{0};
69 for (const Subscript &subscript : x.subscript()) {
70 ConstantSubscript lower{lowerBounds->at(dim)};
71 ConstantSubscript extent{extents->at(dim)};
72 ConstantSubscript upper{lower + extent - 1};
73 if (!common::visit(
74 common::visitors{
75 [&](const IndirectSubscriptIntegerExpr &expr) {
76 auto folded{
77 Fold(context_, common::Clone(expr.value()))};
78 if (auto value{UnwrapConstantValue<SubscriptInteger>(
79 folded)}) {
80 CHECK(value->Rank() <= 1);
81 if (value->size() != 0) {
82 // Apply subscript, possibly vector-valued
83 auto quotient{which / value->size()};
84 auto remainder{which - value->size() * quotient};
85 ConstantSubscript at{
86 value->values().at(remainder).ToInt64()};
87 if (at < lower || at > upper) {
88 isOutOfRange_ = true;
89 }
90 result->Augment((at - lower) * stride);
91 which = quotient;
92 return true;
93 } else {
94 isEmpty_ = true;
95 }
96 }
97 return false;
98 },
99 [&](const Triplet &triplet) {
100 auto start{ToInt64(Fold(context_,
101 triplet.lower().value_or(ExtentExpr{lower})))};
102 auto end{ToInt64(Fold(context_,
103 triplet.upper().value_or(ExtentExpr{upper})))};
104 auto step{ToInt64(Fold(context_, triplet.stride()))};
105 if (start && end && step) {
106 if (*step != 0) {
107 ConstantSubscript range{
108 (*end - *start + *step) / *step};
109 if (range > 0) {
110 auto quotient{which / range};
111 auto remainder{which - range * quotient};
112 auto j{*start + remainder * *step};
113 result->Augment((j - lower) * stride);
114 which = quotient;
115 return true;
116 } else {
117 isEmpty_ = true;
118 }
119 }
120 }
121 return false;
122 },
123 },
124 subscript.u)) {
125 return std::nullopt;
126 }
127 ++dim;
128 stride *= extent;
129 }
130 if (which > 0) {
131 isEmpty_ = true;
132 } else {
133 return result;
134 }
135 }
136 }
137 }
138 }
139 return std::nullopt;
140}
141
142std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
143 const Component &component, ConstantSubscript which) {
144 const Symbol &comp{component.GetLastSymbol()};
145 if (getLastComponent_) {
146 return FoldDesignator(comp, which);
147 } else {
148 const DataRef &base{component.base()};
149 std::optional<OffsetSymbol> baseResult, compResult;
150 if (base.Rank() == 0) { // A%X(:) - apply "which" to component
151 baseResult = FoldDesignator(base, 0);
152 compResult = FoldDesignator(comp, which);
153 } else { // A(:)%X - apply "which" to base
154 baseResult = FoldDesignator(base, which);
155 compResult = FoldDesignator(comp, 0);
156 }
157 if (baseResult && compResult) {
158 OffsetSymbol result{baseResult->symbol(), compResult->size()};
159 result.Augment(
160 baseResult->offset() + compResult->offset() + comp.offset());
161 return {std::move(result)};
162 } else {
163 return std::nullopt;
164 }
165 }
166}
167
168std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
169 const ComplexPart &z, ConstantSubscript which) {
170 if (auto result{FoldDesignator(z.complex(), which)}) {
171 result->set_size(result->size() >> 1);
172 if (z.part() == ComplexPart::Part::IM) {
173 result->Augment(result->size());
174 }
175 return result;
176 } else {
177 return std::nullopt;
178 }
179}
180
181std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
182 const DataRef &dataRef, ConstantSubscript which) {
183 return common::visit(
184 [&](const auto &x) { return FoldDesignator(x, which); }, dataRef.u);
185}
186
187std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
188 const NamedEntity &entity, ConstantSubscript which) {
189 return entity.IsSymbol() ? FoldDesignator(entity.GetLastSymbol(), which)
190 : FoldDesignator(entity.GetComponent(), which);
191}
192
193std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
194 const CoarrayRef &, ConstantSubscript) {
195 return std::nullopt;
196}
197
198std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
199 const ProcedureDesignator &proc, ConstantSubscript which) {
200 if (const Symbol * symbol{proc.GetSymbol()}) {
201 if (const Component * component{proc.GetComponent()}) {
202 return FoldDesignator(*component, which);
203 } else if (which > 0) {
204 isEmpty_ = true;
205 } else {
206 return FoldDesignator(*symbol, 0);
207 }
208 }
209 return std::nullopt;
210}
211
212// Conversions of offset symbols (back) to Designators
213
214// Reconstructs subscripts.
215// "offset" is decremented in place to hold remaining component offset.
216static std::optional<ArrayRef> OffsetToArrayRef(FoldingContext &context,
217 NamedEntity &&entity, const Shape &shape, const DynamicType &elementType,
218 ConstantSubscript &offset) {
219 auto extents{AsConstantExtents(context, shape)};
220 Shape lbs{GetRawLowerBounds(context, entity)};
221 auto lower{AsConstantExtents(context, lbs)};
222 auto elementBytes{ToInt64(elementType.MeasureSizeInBytes(context, true))};
223 if (!extents || !lower || !elementBytes || *elementBytes <= 0) {
224 return std::nullopt;
225 }
226 int rank{GetRank(shape)};
227 CHECK(extents->size() == static_cast<std::size_t>(rank) &&
228 lower->size() == extents->size());
229 auto element{offset / static_cast<std::size_t>(*elementBytes)};
230 std::vector<Subscript> subscripts;
231 auto at{element};
232 for (int dim{0}; dim + 1 < rank; ++dim) {
233 auto extent{(*extents)[dim]};
234 if (extent <= 0) {
235 return std::nullopt;
236 }
237 auto quotient{at / extent};
238 auto remainder{at - quotient * extent};
239 subscripts.emplace_back(ExtentExpr{(*lower)[dim] + remainder});
240 at = quotient;
241 }
242 // This final subscript might be out of range for use in error reporting.
243 subscripts.emplace_back(ExtentExpr{(*lower)[rank - 1] + at});
244 offset -= element * static_cast<std::size_t>(*elementBytes);
245 return ArrayRef{std::move(entity), std::move(subscripts)};
246}
247
248// Maps an offset back to a component, when unambiguous.
249static const Symbol *OffsetToUniqueComponent(
250 const semantics::DerivedTypeSpec &spec, ConstantSubscript offset) {
251 const Symbol *result{nullptr};
252 if (const semantics::Scope * scope{spec.scope()}) {
253 for (const auto &pair : *scope) {
254 const Symbol &component{*pair.second};
255 if (offset >= static_cast<ConstantSubscript>(component.offset()) &&
256 offset < static_cast<ConstantSubscript>(
257 component.offset() + component.size())) {
258 if (result) {
259 return nullptr; // MAP overlap or error recovery
260 }
261 result = &component;
262 }
263 }
264 }
265 return result;
266}
267
268// Converts an offset into subscripts &/or component references. Recursive.
269// Any remaining offset is left in place in the "offset" reference argument.
270static std::optional<DataRef> OffsetToDataRef(FoldingContext &context,
271 NamedEntity &&entity, ConstantSubscript &offset, std::size_t size) {
272 const Symbol &symbol{entity.GetLastSymbol()};
273 if (IsAllocatableOrPointer(symbol)) {
274 return entity.IsSymbol() ? DataRef{symbol}
275 : DataRef{std::move(entity.GetComponent())};
276 }
277 std::optional<DataRef> result;
278 if (std::optional<DynamicType> type{DynamicType::From(symbol)}) {
279 if (!type->IsUnlimitedPolymorphic()) {
280 if (std::optional<Shape> shape{GetShape(context, symbol)}) {
281 if (GetRank(*shape) > 0) {
282 if (auto aref{OffsetToArrayRef(
283 context, std::move(entity), *shape, *type, offset)}) {
284 result = DataRef{std::move(*aref)};
285 }
286 } else {
287 result = entity.IsSymbol()
288 ? DataRef{symbol}
289 : DataRef{std::move(entity.GetComponent())};
290 }
291 if (result && type->category() == TypeCategory::Derived &&
292 size < result->GetLastSymbol().size()) {
293 if (const Symbol *
294 component{OffsetToUniqueComponent(
295 type->GetDerivedTypeSpec(), offset)}) {
296 offset -= component->offset();
297 return OffsetToDataRef(context,
298 NamedEntity{Component{std::move(*result), *component}}, offset,
299 size);
300 }
301 result.reset();
302 }
303 }
304 }
305 }
306 return result;
307}
308
309// Reconstructs a Designator from a symbol, an offset, and a size.
310std::optional<Expr<SomeType>> OffsetToDesignator(FoldingContext &context,
311 const Symbol &baseSymbol, ConstantSubscript offset, std::size_t size) {
312 if (offset < 0) {
313 return std::nullopt;
314 }
315 if (std::optional<DataRef> dataRef{
316 OffsetToDataRef(context, NamedEntity{baseSymbol}, offset, size)}) {
317 const Symbol &symbol{dataRef->GetLastSymbol()};
318 if (std::optional<Expr<SomeType>> result{
319 AsGenericExpr(std::move(*dataRef))}) {
320 if (IsAllocatableOrPointer(symbol)) {
321 } else if (auto type{DynamicType::From(symbol)}) {
322 if (auto elementBytes{
323 ToInt64(type->MeasureSizeInBytes(context, true))}) {
324 if (auto *zExpr{std::get_if<Expr<SomeComplex>>(&result->u)}) {
325 if (size * 2 > static_cast<std::size_t>(*elementBytes)) {
326 return result;
327 } else if (offset == 0 || offset * 2 == *elementBytes) {
328 // Pick a COMPLEX component
329 auto part{
330 offset == 0 ? ComplexPart::Part::RE : ComplexPart::Part::IM};
331 return common::visit(
332 [&](const auto &z) -> std::optional<Expr<SomeType>> {
333 using PartType = typename ResultType<decltype(z)>::Part;
334 return AsGenericExpr(Designator<PartType>{ComplexPart{
335 ExtractDataRef(std::move(*zExpr)).value(), part}});
336 },
337 zExpr->u);
338 }
339 } else if (auto *cExpr{
340 std::get_if<Expr<SomeCharacter>>(&result->u)}) {
341 if (offset > 0 || size != static_cast<std::size_t>(*elementBytes)) {
342 // Select a substring
343 return common::visit(
344 [&](const auto &x) -> std::optional<Expr<SomeType>> {
345 using T = typename std::decay_t<decltype(x)>::Result;
346 return AsGenericExpr(Designator<T>{
347 Substring{ExtractDataRef(std::move(*cExpr)).value(),
348 std::optional<Expr<SubscriptInteger>>{
349 1 + (offset / T::kind)},
350 std::optional<Expr<SubscriptInteger>>{
351 1 + ((offset + size - 1) / T::kind)}}});
352 },
353 cExpr->u);
354 }
355 }
356 }
357 }
358 if (offset == 0) {
359 return result;
360 }
361 }
362 }
363 return std::nullopt;
364}
365
366std::optional<Expr<SomeType>> OffsetToDesignator(
367 FoldingContext &context, const OffsetSymbol &offsetSymbol) {
368 return OffsetToDesignator(context, offsetSymbol.symbol(),
369 offsetSymbol.offset(), offsetSymbol.size());
370}
371
372ConstantObjectPointer ConstantObjectPointer::From(
373 FoldingContext &context, const Expr<SomeType> &expr) {
374 auto extents{GetConstantExtents(context, expr)};
375 CHECK(extents);
376 std::optional<uint64_t> optElements{TotalElementCount(*extents)};
377 CHECK(optElements);
378 uint64_t elements{*optElements};
379 CHECK(elements > 0);
380 int rank{GetRank(*extents)};
381 ConstantSubscripts at(rank, 1);
382 ConstantObjectPointer::Dimensions dimensions(rank);
383 for (int j{0}; j < rank; ++j) {
384 dimensions[j].extent = (*extents)[j];
385 }
386 DesignatorFolder designatorFolder{context};
387 const Symbol *symbol{nullptr};
388 ConstantSubscript baseOffset{0};
389 std::size_t elementSize{0};
390 for (std::size_t j{0}; j < elements; ++j) {
391 auto folded{designatorFolder.FoldDesignator(expr)};
392 CHECK(folded);
393 if (j == 0) {
394 symbol = &folded->symbol();
395 baseOffset = folded->offset();
396 elementSize = folded->size();
397 } else {
398 CHECK(symbol == &folded->symbol());
399 CHECK(elementSize == folded->size());
400 }
401 int twoDim{-1};
402 for (int k{0}; k < rank; ++k) {
403 if (at[k] == 2 && twoDim == -1) {
404 twoDim = k;
405 } else if (at[k] != 1) {
406 twoDim = -2;
407 }
408 }
409 if (twoDim >= 0) {
410 // Exactly one subscript is a 2 and the rest are 1.
411 dimensions[twoDim].byteStride = folded->offset() - baseOffset;
412 }
413 ConstantSubscript checkOffset{baseOffset};
414 for (int k{0}; k < rank; ++k) {
415 checkOffset += (at[k] - 1) * dimensions[twoDim].byteStride;
416 }
417 CHECK(checkOffset == folded->offset());
418 CHECK(IncrementSubscripts(at, *extents) == (j + 1 < elements));
419 }
420 CHECK(!designatorFolder.FoldDesignator(expr));
421 return ConstantObjectPointer{
422 DEREF(symbol), elementSize, std::move(dimensions)};
423}
424} // namespace Fortran::evaluate
425

source code of flang/lib/Evaluate/fold-designator.cpp