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