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