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
15 namespace Fortran::evaluate {
16
Fold(FoldingContext & context,characteristics::TypeAndShape && x)17 characteristics::TypeAndShape Fold(
18 FoldingContext &context, characteristics::TypeAndShape &&x) {
19 x.Rewrite(context);
20 return std::move(x);
21 }
22
GetConstantSubscript(FoldingContext & context,Subscript & ss,const NamedEntity & base,int dim)23 std::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
FoldOperation(FoldingContext & context,StructureConstructor && structure)68 Expr<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 &= IsNullPointer(expr);
90 } else {
91 isConstant &= IsActuallyConstant(expr) || IsNullPointer(expr);
92 if (auto valueShape{GetConstantExtents(context, expr)}) {
93 if (auto componentShape{GetConstantExtents(context, symbol)}) {
94 if (GetRank(*componentShape) > 0 && GetRank(*valueShape) == 0) {
95 expr = ScalarConstantExpander{std::move(*componentShape)}.Expand(
96 std::move(expr));
97 isConstant &= expr.Rank() > 0;
98 } else {
99 isConstant &= *valueShape == *componentShape;
100 }
101 if (*valueShape == *componentShape) {
102 if (auto lbounds{AsConstantExtents(
103 context, GetLBOUNDs(context, NamedEntity{symbol}))}) {
104 expr =
105 ArrayConstantBoundChanger{std::move(*lbounds)}.ChangeLbounds(
106 std::move(expr));
107 }
108 }
109 }
110 }
111 }
112 ctor.Add(symbol, std::move(expr));
113 }
114 if (isConstant) {
115 return Expr<SomeDerived>{Constant<SomeDerived>{std::move(ctor)}};
116 } else {
117 return Expr<SomeDerived>{std::move(ctor)};
118 }
119 }
120
FoldOperation(FoldingContext & context,Component && component)121 Component FoldOperation(FoldingContext &context, Component &&component) {
122 return {FoldOperation(context, std::move(component.base())),
123 component.GetLastSymbol()};
124 }
125
FoldOperation(FoldingContext & context,NamedEntity && x)126 NamedEntity FoldOperation(FoldingContext &context, NamedEntity &&x) {
127 if (Component * c{x.UnwrapComponent()}) {
128 return NamedEntity{FoldOperation(context, std::move(*c))};
129 } else {
130 return std::move(x);
131 }
132 }
133
FoldOperation(FoldingContext & context,Triplet && triplet)134 Triplet FoldOperation(FoldingContext &context, Triplet &&triplet) {
135 MaybeExtentExpr lower{triplet.lower()};
136 MaybeExtentExpr upper{triplet.upper()};
137 return {Fold(context, std::move(lower)), Fold(context, std::move(upper)),
138 Fold(context, triplet.stride())};
139 }
140
FoldOperation(FoldingContext & context,Subscript && subscript)141 Subscript FoldOperation(FoldingContext &context, Subscript &&subscript) {
142 return common::visit(
143 common::visitors{
144 [&](IndirectSubscriptIntegerExpr &&expr) {
145 expr.value() = Fold(context, std::move(expr.value()));
146 return Subscript(std::move(expr));
147 },
148 [&](Triplet &&triplet) {
149 return Subscript(FoldOperation(context, std::move(triplet)));
150 },
151 },
152 std::move(subscript.u));
153 }
154
FoldOperation(FoldingContext & context,ArrayRef && arrayRef)155 ArrayRef FoldOperation(FoldingContext &context, ArrayRef &&arrayRef) {
156 NamedEntity base{FoldOperation(context, std::move(arrayRef.base()))};
157 for (Subscript &subscript : arrayRef.subscript()) {
158 subscript = FoldOperation(context, std::move(subscript));
159 }
160 return ArrayRef{std::move(base), std::move(arrayRef.subscript())};
161 }
162
FoldOperation(FoldingContext & context,CoarrayRef && coarrayRef)163 CoarrayRef FoldOperation(FoldingContext &context, CoarrayRef &&coarrayRef) {
164 std::vector<Subscript> subscript;
165 for (Subscript x : coarrayRef.subscript()) {
166 subscript.emplace_back(FoldOperation(context, std::move(x)));
167 }
168 std::vector<Expr<SubscriptInteger>> cosubscript;
169 for (Expr<SubscriptInteger> x : coarrayRef.cosubscript()) {
170 cosubscript.emplace_back(Fold(context, std::move(x)));
171 }
172 CoarrayRef folded{std::move(coarrayRef.base()), std::move(subscript),
173 std::move(cosubscript)};
174 if (std::optional<Expr<SomeInteger>> stat{coarrayRef.stat()}) {
175 folded.set_stat(Fold(context, std::move(*stat)));
176 }
177 if (std::optional<Expr<SomeInteger>> team{coarrayRef.team()}) {
178 folded.set_team(
179 Fold(context, std::move(*team)), coarrayRef.teamIsTeamNumber());
180 }
181 return folded;
182 }
183
FoldOperation(FoldingContext & context,DataRef && dataRef)184 DataRef FoldOperation(FoldingContext &context, DataRef &&dataRef) {
185 return common::visit(common::visitors{
186 [&](SymbolRef symbol) { return DataRef{*symbol}; },
187 [&](auto &&x) {
188 return DataRef{
189 FoldOperation(context, std::move(x))};
190 },
191 },
192 std::move(dataRef.u));
193 }
194
FoldOperation(FoldingContext & context,Substring && substring)195 Substring FoldOperation(FoldingContext &context, Substring &&substring) {
196 auto lower{Fold(context, substring.lower())};
197 auto upper{Fold(context, substring.upper())};
198 if (const DataRef * dataRef{substring.GetParentIf<DataRef>()}) {
199 return Substring{FoldOperation(context, DataRef{*dataRef}),
200 std::move(lower), std::move(upper)};
201 } else {
202 auto p{*substring.GetParentIf<StaticDataObject::Pointer>()};
203 return Substring{std::move(p), std::move(lower), std::move(upper)};
204 }
205 }
206
FoldOperation(FoldingContext & context,ComplexPart && complexPart)207 ComplexPart FoldOperation(FoldingContext &context, ComplexPart &&complexPart) {
208 DataRef complex{complexPart.complex()};
209 return ComplexPart{
210 FoldOperation(context, std::move(complex)), complexPart.part()};
211 }
212
GetInt64ArgOr(const std::optional<ActualArgument> & arg,std::int64_t defaultValue)213 std::optional<std::int64_t> GetInt64ArgOr(
214 const std::optional<ActualArgument> &arg, std::int64_t defaultValue) {
215 return arg ? ToInt64(*arg) : defaultValue;
216 }
217
FoldOperation(FoldingContext & context,ImpliedDoIndex && iDo)218 Expr<ImpliedDoIndex::Result> FoldOperation(
219 FoldingContext &context, ImpliedDoIndex &&iDo) {
220 if (std::optional<ConstantSubscript> value{context.GetImpliedDo(iDo.name)}) {
221 return Expr<ImpliedDoIndex::Result>{*value};
222 } else {
223 return Expr<ImpliedDoIndex::Result>{std::move(iDo)};
224 }
225 }
226
227 // TRANSFER (F'2018 16.9.193)
FoldTransfer(FoldingContext & context,const ActualArguments & arguments)228 std::optional<Expr<SomeType>> FoldTransfer(
229 FoldingContext &context, const ActualArguments &arguments) {
230 CHECK(arguments.size() == 2 || arguments.size() == 3);
231 const auto *source{UnwrapExpr<Expr<SomeType>>(arguments[0])};
232 std::optional<std::size_t> sourceBytes;
233 if (source) {
234 if (auto sourceTypeAndShape{
235 characteristics::TypeAndShape::Characterize(*source, context)}) {
236 if (auto sourceBytesExpr{
237 sourceTypeAndShape->MeasureSizeInBytes(context)}) {
238 sourceBytes = ToInt64(*sourceBytesExpr);
239 }
240 }
241 }
242 std::optional<DynamicType> moldType;
243 std::optional<std::int64_t> moldLength;
244 if (arguments[1]) { // MOLD=
245 moldType = arguments[1]->GetType();
246 if (moldType && moldType->category() == TypeCategory::Character) {
247 if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(arguments[1])}) {
248 moldLength = ToInt64(Fold(context, chExpr->LEN()));
249 }
250 }
251 }
252 std::optional<ConstantSubscripts> extents;
253 if (arguments.size() == 2) { // no SIZE=
254 if (moldType && sourceBytes) {
255 if (arguments[1]->Rank() == 0) { // scalar MOLD=
256 extents = ConstantSubscripts{}; // empty extents (scalar result)
257 } else if (auto moldBytesExpr{
258 moldType->MeasureSizeInBytes(context, true)}) {
259 if (auto moldBytes{ToInt64(Fold(context, std::move(*moldBytesExpr)))};
260 *moldBytes > 0) {
261 extents = ConstantSubscripts{
262 static_cast<ConstantSubscript>((*sourceBytes) + *moldBytes - 1) /
263 *moldBytes};
264 }
265 }
266 }
267 } else if (arguments[2]) { // SIZE= is present
268 if (const auto *sizeExpr{arguments[2]->UnwrapExpr()}) {
269 if (auto sizeValue{ToInt64(*sizeExpr)}) {
270 extents = ConstantSubscripts{*sizeValue};
271 }
272 }
273 }
274 if (sourceBytes && IsActuallyConstant(*source) && moldType && extents &&
275 !moldType->IsPolymorphic() &&
276 (moldLength || moldType->category() != TypeCategory::Character)) {
277 std::size_t elements{
278 extents->empty() ? 1 : static_cast<std::size_t>((*extents)[0])};
279 std::size_t totalBytes{*sourceBytes * elements};
280 // Don't fold intentional overflow cases from sneaky tests
281 if (totalBytes < std::size_t{1000000} &&
282 (elements == 0 || totalBytes / elements == *sourceBytes)) {
283 InitialImage image{*sourceBytes};
284 auto status{image.Add(0, *sourceBytes, *source, context)};
285 if (status == InitialImage::Ok) {
286 return image.AsConstant(
287 context, *moldType, moldLength, *extents, true /*pad with 0*/);
288 } else {
289 // Can fail due to an allocatable or automatic component;
290 // a warning will also have been produced.
291 CHECK(status == InitialImage::NotAConstant);
292 }
293 }
294 }
295 return std::nullopt;
296 }
297
298 template class ExpressionBase<SomeDerived>;
299 template class ExpressionBase<SomeType>;
300
301 } // namespace Fortran::evaluate
302