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 || HasNegativeExtent(*extents) || !lower || !elementBytes ||
224 *elementBytes <= 0) {
225 return std::nullopt;
226 }
227 int rank{GetRank(shape)};
228 CHECK(extents->size() == static_cast<std::size_t>(rank) &&
229 lower->size() == extents->size());
230 auto element{offset / static_cast<std::size_t>(*elementBytes)};
231 std::vector<Subscript> subscripts;
232 auto at{element};
233 for (int dim{0}; dim + 1 < rank; ++dim) {
234 auto extent{(*extents)[dim]};
235 if (extent <= 0) {
236 return std::nullopt;
237 }
238 auto quotient{at / extent};
239 auto remainder{at - quotient * extent};
240 subscripts.emplace_back(ExtentExpr{(*lower)[dim] + remainder});
241 at = quotient;
242 }
243 // This final subscript might be out of range for use in error reporting.
244 subscripts.emplace_back(ExtentExpr{(*lower)[rank - 1] + at});
245 offset -= element * static_cast<std::size_t>(*elementBytes);
246 return ArrayRef{std::move(entity), std::move(subscripts)};
247}
248
249// Maps an offset back to a component, when unambiguous.
250static const Symbol *OffsetToUniqueComponent(
251 const semantics::DerivedTypeSpec &spec, ConstantSubscript offset) {
252 const Symbol *result{nullptr};
253 if (const semantics::Scope * scope{spec.scope()}) {
254 for (const auto &pair : *scope) {
255 const Symbol &component{*pair.second};
256 if (offset >= static_cast<ConstantSubscript>(component.offset()) &&
257 offset < static_cast<ConstantSubscript>(
258 component.offset() + component.size())) {
259 if (result) {
260 return nullptr; // MAP overlap or error recovery
261 }
262 result = &component;
263 }
264 }
265 }
266 return result;
267}
268
269// Converts an offset into subscripts &/or component references. Recursive.
270// Any remaining offset is left in place in the "offset" reference argument.
271static std::optional<DataRef> OffsetToDataRef(FoldingContext &context,
272 NamedEntity &&entity, ConstantSubscript &offset, std::size_t size) {
273 const Symbol &symbol{entity.GetLastSymbol()};
274 if (IsAllocatableOrPointer(symbol)) {
275 return entity.IsSymbol() ? DataRef{symbol}
276 : DataRef{std::move(entity.GetComponent())};
277 } else if (std::optional<DynamicType> type{DynamicType::From(symbol)}) {
278 std::optional<DataRef> result;
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 }
302 }
303 }
304 return result;
305 } else {
306 return std::nullopt;
307 }
308}
309
310// Reconstructs a Designator from a symbol, an offset, and a size.
311// Returns a ProcedureDesignator in the case of a whole procedure pointer.
312std::optional<Expr<SomeType>> OffsetToDesignator(FoldingContext &context,
313 const Symbol &baseSymbol, ConstantSubscript offset, std::size_t size) {
314 if (offset < 0) {
315 return std::nullopt;
316 } else if (std::optional<DataRef> dataRef{OffsetToDataRef(
317 context, NamedEntity{baseSymbol}, offset, size)}) {
318 const Symbol &symbol{dataRef->GetLastSymbol()};
319 if (IsProcedurePointer(symbol)) {
320 if (std::holds_alternative<SymbolRef>(dataRef->u)) {
321 return Expr<SomeType>{ProcedureDesignator{symbol}};
322 } else if (auto *component{std::get_if<Component>(&dataRef->u)}) {
323 return Expr<SomeType>{ProcedureDesignator{std::move(*component)}};
324 }
325 } else if (std::optional<Expr<SomeType>> result{
326 AsGenericExpr(std::move(*dataRef))}) {
327 if (IsAllocatableOrPointer(symbol)) {
328 } else if (auto type{DynamicType::From(symbol)}) {
329 if (auto elementBytes{
330 ToInt64(type->MeasureSizeInBytes(context, true))}) {
331 if (auto *zExpr{std::get_if<Expr<SomeComplex>>(&result->u)}) {
332 if (size * 2 > static_cast<std::size_t>(*elementBytes)) {
333 return result;
334 } else if (offset == 0 || offset * 2 == *elementBytes) {
335 // Pick a COMPLEX component
336 auto part{
337 offset == 0 ? ComplexPart::Part::RE : ComplexPart::Part::IM};
338 return common::visit(
339 [&](const auto &z) -> std::optional<Expr<SomeType>> {
340 using PartType = typename ResultType<decltype(z)>::Part;
341 return AsGenericExpr(Designator<PartType>{ComplexPart{
342 ExtractDataRef(std::move(*zExpr)).value(), part}});
343 },
344 zExpr->u);
345 }
346 } else if (auto *cExpr{
347 std::get_if<Expr<SomeCharacter>>(&result->u)}) {
348 if (offset > 0 || size != static_cast<std::size_t>(*elementBytes)) {
349 // Select a substring
350 return common::visit(
351 [&](const auto &x) -> std::optional<Expr<SomeType>> {
352 using T = typename std::decay_t<decltype(x)>::Result;
353 return AsGenericExpr(Designator<T>{
354 Substring{ExtractDataRef(std::move(*cExpr)).value(),
355 std::optional<Expr<SubscriptInteger>>{
356 1 + (offset / T::kind)},
357 std::optional<Expr<SubscriptInteger>>{
358 1 + ((offset + size - 1) / T::kind)}}});
359 },
360 cExpr->u);
361 }
362 }
363 }
364 }
365 if (offset == 0) {
366 return result;
367 }
368 }
369 }
370 return std::nullopt;
371}
372
373std::optional<Expr<SomeType>> OffsetToDesignator(
374 FoldingContext &context, const OffsetSymbol &offsetSymbol) {
375 return OffsetToDesignator(context, offsetSymbol.symbol(),
376 offsetSymbol.offset(), offsetSymbol.size());
377}
378
379ConstantObjectPointer ConstantObjectPointer::From(
380 FoldingContext &context, const Expr<SomeType> &expr) {
381 auto extents{GetConstantExtents(context, expr)};
382 CHECK(extents);
383 std::optional<uint64_t> optElements{TotalElementCount(*extents)};
384 CHECK(optElements);
385 uint64_t elements{*optElements};
386 CHECK(elements > 0);
387 int rank{GetRank(*extents)};
388 ConstantSubscripts at(rank, 1);
389 ConstantObjectPointer::Dimensions dimensions(rank);
390 for (int j{0}; j < rank; ++j) {
391 dimensions[j].extent = (*extents)[j];
392 }
393 DesignatorFolder designatorFolder{context};
394 const Symbol *symbol{nullptr};
395 ConstantSubscript baseOffset{0};
396 std::size_t elementSize{0};
397 for (std::size_t j{0}; j < elements; ++j) {
398 auto folded{designatorFolder.FoldDesignator(expr)};
399 CHECK(folded);
400 if (j == 0) {
401 symbol = &folded->symbol();
402 baseOffset = folded->offset();
403 elementSize = folded->size();
404 } else {
405 CHECK(symbol == &folded->symbol());
406 CHECK(elementSize == folded->size());
407 }
408 int twoDim{-1};
409 for (int k{0}; k < rank; ++k) {
410 if (at[k] == 2 && twoDim == -1) {
411 twoDim = k;
412 } else if (at[k] != 1) {
413 twoDim = -2;
414 }
415 }
416 if (twoDim >= 0) {
417 // Exactly one subscript is a 2 and the rest are 1.
418 dimensions[twoDim].byteStride = folded->offset() - baseOffset;
419 }
420 ConstantSubscript checkOffset{baseOffset};
421 for (int k{0}; k < rank; ++k) {
422 checkOffset += (at[k] - 1) * dimensions[twoDim].byteStride;
423 }
424 CHECK(checkOffset == folded->offset());
425 CHECK(IncrementSubscripts(at, *extents) == (j + 1 < elements));
426 }
427 CHECK(!designatorFolder.FoldDesignator(expr));
428 return ConstantObjectPointer{
429 DEREF(symbol), elementSize, std::move(dimensions)};
430}
431} // namespace Fortran::evaluate
432

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