1//===-- lib/Evaluate/fold.cpp ---------------------------------------------===//
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.h"
10#include "fold-implementation.h"
11#include "flang/Evaluate/characteristics.h"
12#include "flang/Evaluate/initial-image.h"
13#include "flang/Evaluate/tools.h"
14
15namespace Fortran::evaluate {
16
17characteristics::TypeAndShape Fold(
18 FoldingContext &context, characteristics::TypeAndShape &&x) {
19 x.Rewrite(context);
20 return std::move(x);
21}
22
23std::optional<Constant<SubscriptInteger>> GetConstantSubscript(
24 FoldingContext &context, Subscript &ss, const NamedEntity &base, int dim) {
25 ss = FoldOperation(context, std::move(ss));
26 return common::visit(
27 common::visitors{
28 [](IndirectSubscriptIntegerExpr &expr)
29 -> std::optional<Constant<SubscriptInteger>> {
30 if (const auto *constant{
31 UnwrapConstantValue<SubscriptInteger>(expr.value())}) {
32 return *constant;
33 } else {
34 return std::nullopt;
35 }
36 },
37 [&](Triplet &triplet) -> std::optional<Constant<SubscriptInteger>> {
38 auto lower{triplet.lower()}, upper{triplet.upper()};
39 std::optional<ConstantSubscript> stride{ToInt64(triplet.stride())};
40 if (!lower) {
41 lower = GetLBOUND(context, base, dim);
42 }
43 if (!upper) {
44 if (auto lb{GetLBOUND(context, base, dim)}) {
45 upper = ComputeUpperBound(
46 context, std::move(*lb), GetExtent(context, base, dim));
47 }
48 }
49 auto lbi{ToInt64(lower)}, ubi{ToInt64(upper)};
50 if (lbi && ubi && stride && *stride != 0) {
51 std::vector<SubscriptInteger::Scalar> values;
52 while ((*stride > 0 && *lbi <= *ubi) ||
53 (*stride < 0 && *lbi >= *ubi)) {
54 values.emplace_back(*lbi);
55 *lbi += *stride;
56 }
57 return Constant<SubscriptInteger>{std::move(values),
58 ConstantSubscripts{
59 static_cast<ConstantSubscript>(values.size())}};
60 } else {
61 return std::nullopt;
62 }
63 },
64 },
65 ss.u);
66}
67
68Expr<SomeDerived> FoldOperation(
69 FoldingContext &context, StructureConstructor &&structure) {
70 StructureConstructor ctor{structure.derivedTypeSpec()};
71 bool isConstant{true};
72 auto restorer{context.WithPDTInstance(structure.derivedTypeSpec())};
73 for (auto &&[symbol, value] : std::move(structure)) {
74 auto expr{Fold(context, std::move(value.value()))};
75 if (IsPointer(symbol)) {
76 if (IsNullPointer(&expr)) {
77 // Handle x%c when x designates a named constant of derived
78 // type and %c is NULL() in that constant.
79 expr = Expr<SomeType>{NullPointer{}};
80 } else if (IsProcedure(symbol)) {
81 isConstant &= IsInitialProcedureTarget(expr);
82 } else {
83 isConstant &= IsInitialDataTarget(expr);
84 }
85 } else if (IsAllocatable(symbol)) {
86 // F2023: 10.1.12 (3)(a)
87 // If comp-spec is not null() for the allocatable component the
88 // structure constructor is not a constant expression.
89 isConstant &= IsNullAllocatable(&expr) || IsBareNullPointer(&expr);
90 } else {
91 isConstant &=
92 IsActuallyConstant(expr) || IsNullPointerOrAllocatable(&expr);
93 if (auto valueShape{GetConstantExtents(context, expr)}) {
94 if (auto componentShape{GetConstantExtents(context, symbol)}) {
95 if (GetRank(*componentShape) > 0 && GetRank(*valueShape) == 0) {
96 expr = ScalarConstantExpander{std::move(*componentShape)}.Expand(
97 std::move(expr));
98 isConstant &= expr.Rank() > 0;
99 } else {
100 isConstant &= *valueShape == *componentShape;
101 }
102 if (*valueShape == *componentShape) {
103 if (auto lbounds{AsConstantExtents(
104 context, GetLBOUNDs(context, NamedEntity{symbol}))}) {
105 expr =
106 ArrayConstantBoundChanger{std::move(*lbounds)}.ChangeLbounds(
107 std::move(expr));
108 }
109 }
110 }
111 }
112 }
113 ctor.Add(symbol, std::move(expr));
114 }
115 if (isConstant) {
116 return Expr<SomeDerived>{Constant<SomeDerived>{std::move(ctor)}};
117 } else {
118 return Expr<SomeDerived>{std::move(ctor)};
119 }
120}
121
122Component FoldOperation(FoldingContext &context, Component &&component) {
123 return {FoldOperation(context, std::move(component.base())),
124 component.GetLastSymbol()};
125}
126
127NamedEntity FoldOperation(FoldingContext &context, NamedEntity &&x) {
128 if (Component * c{x.UnwrapComponent()}) {
129 return NamedEntity{FoldOperation(context, std::move(*c))};
130 } else {
131 return std::move(x);
132 }
133}
134
135Triplet FoldOperation(FoldingContext &context, Triplet &&triplet) {
136 MaybeExtentExpr lower{triplet.lower()};
137 MaybeExtentExpr upper{triplet.upper()};
138 return {Fold(context, std::move(lower)), Fold(context, std::move(upper)),
139 Fold(context, triplet.stride())};
140}
141
142Subscript FoldOperation(FoldingContext &context, Subscript &&subscript) {
143 return common::visit(
144 common::visitors{
145 [&](IndirectSubscriptIntegerExpr &&expr) {
146 expr.value() = Fold(context, std::move(expr.value()));
147 return Subscript(std::move(expr));
148 },
149 [&](Triplet &&triplet) {
150 return Subscript(FoldOperation(context, std::move(triplet)));
151 },
152 },
153 std::move(subscript.u));
154}
155
156ArrayRef FoldOperation(FoldingContext &context, ArrayRef &&arrayRef) {
157 NamedEntity base{FoldOperation(context, std::move(arrayRef.base()))};
158 for (Subscript &subscript : arrayRef.subscript()) {
159 subscript = FoldOperation(context, std::move(subscript));
160 }
161 return ArrayRef{std::move(base), std::move(arrayRef.subscript())};
162}
163
164CoarrayRef FoldOperation(FoldingContext &context, CoarrayRef &&coarrayRef) {
165 DataRef base{FoldOperation(context, std::move(coarrayRef.base()))};
166 std::vector<Expr<SubscriptInteger>> cosubscript;
167 for (Expr<SubscriptInteger> x : coarrayRef.cosubscript()) {
168 cosubscript.emplace_back(Fold(context, std::move(x)));
169 }
170 CoarrayRef folded{std::move(base), std::move(cosubscript)};
171 if (std::optional<Expr<SomeInteger>> stat{coarrayRef.stat()}) {
172 folded.set_stat(Fold(context, std::move(*stat)));
173 }
174 if (std::optional<Expr<SomeType>> team{coarrayRef.team()}) {
175 folded.set_team(Fold(context, std::move(*team)));
176 }
177 return folded;
178}
179
180DataRef FoldOperation(FoldingContext &context, DataRef &&dataRef) {
181 return common::visit(common::visitors{
182 [&](SymbolRef symbol) { return DataRef{*symbol}; },
183 [&](auto &&x) {
184 return DataRef{
185 FoldOperation(context, std::move(x))};
186 },
187 },
188 std::move(dataRef.u));
189}
190
191Substring FoldOperation(FoldingContext &context, Substring &&substring) {
192 auto lower{Fold(context, substring.lower())};
193 auto upper{Fold(context, substring.upper())};
194 if (const DataRef * dataRef{substring.GetParentIf<DataRef>()}) {
195 return Substring{FoldOperation(context, DataRef{*dataRef}),
196 std::move(lower), std::move(upper)};
197 } else {
198 auto p{*substring.GetParentIf<StaticDataObject::Pointer>()};
199 return Substring{std::move(p), std::move(lower), std::move(upper)};
200 }
201}
202
203ComplexPart FoldOperation(FoldingContext &context, ComplexPart &&complexPart) {
204 DataRef complex{complexPart.complex()};
205 return ComplexPart{
206 FoldOperation(context, std::move(complex)), complexPart.part()};
207}
208
209std::optional<std::int64_t> GetInt64ArgOr(
210 const std::optional<ActualArgument> &arg, std::int64_t defaultValue) {
211 return arg ? ToInt64(*arg) : defaultValue;
212}
213
214Expr<ImpliedDoIndex::Result> FoldOperation(
215 FoldingContext &context, ImpliedDoIndex &&iDo) {
216 if (std::optional<ConstantSubscript> value{context.GetImpliedDo(iDo.name)}) {
217 return Expr<ImpliedDoIndex::Result>{*value};
218 } else {
219 return Expr<ImpliedDoIndex::Result>{std::move(iDo)};
220 }
221}
222
223// TRANSFER (F'2018 16.9.193)
224std::optional<Expr<SomeType>> FoldTransfer(
225 FoldingContext &context, const ActualArguments &arguments) {
226 CHECK(arguments.size() == 2 || arguments.size() == 3);
227 const auto *source{UnwrapExpr<Expr<SomeType>>(arguments[0])};
228 std::optional<std::size_t> sourceBytes;
229 if (source) {
230 if (auto sourceTypeAndShape{
231 characteristics::TypeAndShape::Characterize(*source, context)}) {
232 if (auto sourceBytesExpr{
233 sourceTypeAndShape->MeasureSizeInBytes(context)}) {
234 sourceBytes = ToInt64(*sourceBytesExpr);
235 }
236 }
237 }
238 std::optional<DynamicType> moldType;
239 std::optional<std::int64_t> moldLength;
240 if (arguments[1]) { // MOLD=
241 moldType = arguments[1]->GetType();
242 if (moldType && moldType->category() == TypeCategory::Character) {
243 if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(arguments[1])}) {
244 moldLength = ToInt64(Fold(context, chExpr->LEN()));
245 }
246 }
247 }
248 std::optional<ConstantSubscripts> extents;
249 if (arguments.size() == 2) { // no SIZE=
250 if (moldType && sourceBytes) {
251 if (arguments[1]->Rank() == 0) { // scalar MOLD=
252 extents = ConstantSubscripts{}; // empty extents (scalar result)
253 } else if (auto moldBytesExpr{
254 moldType->MeasureSizeInBytes(context, true)}) {
255 if (auto moldBytes{ToInt64(Fold(context, std::move(*moldBytesExpr)))};
256 *moldBytes > 0) {
257 extents = ConstantSubscripts{
258 static_cast<ConstantSubscript>((*sourceBytes) + *moldBytes - 1) /
259 *moldBytes};
260 }
261 }
262 }
263 } else if (arguments[2]) { // SIZE= is present
264 if (const auto *sizeExpr{arguments[2]->UnwrapExpr()}) {
265 if (auto sizeValue{ToInt64(*sizeExpr)}) {
266 extents = ConstantSubscripts{*sizeValue};
267 }
268 }
269 }
270 if (sourceBytes && IsActuallyConstant(*source) && moldType && extents &&
271 !moldType->IsPolymorphic() &&
272 (moldLength || moldType->category() != TypeCategory::Character)) {
273 std::size_t elements{
274 extents->empty() ? 1 : static_cast<std::size_t>((*extents)[0])};
275 std::size_t totalBytes{*sourceBytes * elements};
276 // Don't fold intentional overflow cases from sneaky tests
277 if (totalBytes < std::size_t{1000000} &&
278 (elements == 0 || totalBytes / elements == *sourceBytes)) {
279 InitialImage image{*sourceBytes};
280 auto status{image.Add(0, *sourceBytes, *source, context)};
281 if (status == InitialImage::Ok) {
282 return image.AsConstant(
283 context, *moldType, moldLength, *extents, true /*pad with 0*/);
284 } else {
285 // Can fail due to an allocatable or automatic component;
286 // a warning will also have been produced.
287 CHECK(status == InitialImage::NotAConstant);
288 }
289 }
290 }
291 return std::nullopt;
292}
293
294template class ExpressionBase<SomeDerived>;
295template class ExpressionBase<SomeType>;
296
297} // namespace Fortran::evaluate
298

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