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