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 
13 namespace Fortran::evaluate {
14 
15 characteristics::TypeAndShape Fold(
16     FoldingContext &context, characteristics::TypeAndShape &&x) {
17   x.Rewrite(context);
18   return std::move(x);
19 }
20 
21 std::optional<Constant<SubscriptInteger>> GetConstantSubscript(
22     FoldingContext &context, Subscript &ss, const NamedEntity &base, int dim) {
23   ss = FoldOperation(context, std::move(ss));
24   return common::visit(
25       common::visitors{
26           [](IndirectSubscriptIntegerExpr &expr)
27               -> std::optional<Constant<SubscriptInteger>> {
28             if (const auto *constant{
29                     UnwrapConstantValue<SubscriptInteger>(expr.value())}) {
30               return *constant;
31             } else {
32               return std::nullopt;
33             }
34           },
35           [&](Triplet &triplet) -> std::optional<Constant<SubscriptInteger>> {
36             auto lower{triplet.lower()}, upper{triplet.upper()};
37             std::optional<ConstantSubscript> stride{ToInt64(triplet.stride())};
38             if (!lower) {
39               lower = GetLBOUND(context, base, dim);
40             }
41             if (!upper) {
42               if (auto lb{GetLBOUND(context, base, dim)}) {
43                 upper = ComputeUpperBound(
44                     context, std::move(*lb), GetExtent(context, base, dim));
45               }
46             }
47             auto lbi{ToInt64(lower)}, ubi{ToInt64(upper)};
48             if (lbi && ubi && stride && *stride != 0) {
49               std::vector<SubscriptInteger::Scalar> values;
50               while ((*stride > 0 && *lbi <= *ubi) ||
51                   (*stride < 0 && *lbi >= *ubi)) {
52                 values.emplace_back(*lbi);
53                 *lbi += *stride;
54               }
55               return Constant<SubscriptInteger>{std::move(values),
56                   ConstantSubscripts{
57                       static_cast<ConstantSubscript>(values.size())}};
58             } else {
59               return std::nullopt;
60             }
61           },
62       },
63       ss.u);
64 }
65 
66 Expr<SomeDerived> FoldOperation(
67     FoldingContext &context, StructureConstructor &&structure) {
68   StructureConstructor ctor{structure.derivedTypeSpec()};
69   bool isConstant{true};
70   for (auto &&[symbol, value] : std::move(structure)) {
71     auto expr{Fold(context, std::move(value.value()))};
72     if (IsPointer(symbol)) {
73       if (IsProcedure(symbol)) {
74         isConstant &= IsInitialProcedureTarget(expr);
75       } else {
76         isConstant &= IsInitialDataTarget(expr);
77       }
78     } else {
79       isConstant &= IsActuallyConstant(expr);
80       if (auto valueShape{GetConstantExtents(context, expr)}) {
81         if (auto componentShape{GetConstantExtents(context, symbol)}) {
82           if (GetRank(*componentShape) > 0 && GetRank(*valueShape) == 0) {
83             expr = ScalarConstantExpander{std::move(*componentShape)}.Expand(
84                 std::move(expr));
85             isConstant &= expr.Rank() > 0;
86           } else {
87             isConstant &= *valueShape == *componentShape;
88           }
89         }
90       }
91     }
92     ctor.Add(symbol, std::move(expr));
93   }
94   if (isConstant) {
95     return Expr<SomeDerived>{Constant<SomeDerived>{std::move(ctor)}};
96   } else {
97     return Expr<SomeDerived>{std::move(ctor)};
98   }
99 }
100 
101 Component FoldOperation(FoldingContext &context, Component &&component) {
102   return {FoldOperation(context, std::move(component.base())),
103       component.GetLastSymbol()};
104 }
105 
106 NamedEntity FoldOperation(FoldingContext &context, NamedEntity &&x) {
107   if (Component * c{x.UnwrapComponent()}) {
108     return NamedEntity{FoldOperation(context, std::move(*c))};
109   } else {
110     return std::move(x);
111   }
112 }
113 
114 Triplet FoldOperation(FoldingContext &context, Triplet &&triplet) {
115   MaybeExtentExpr lower{triplet.lower()};
116   MaybeExtentExpr upper{triplet.upper()};
117   return {Fold(context, std::move(lower)), Fold(context, std::move(upper)),
118       Fold(context, triplet.stride())};
119 }
120 
121 Subscript FoldOperation(FoldingContext &context, Subscript &&subscript) {
122   return common::visit(
123       common::visitors{
124           [&](IndirectSubscriptIntegerExpr &&expr) {
125             expr.value() = Fold(context, std::move(expr.value()));
126             return Subscript(std::move(expr));
127           },
128           [&](Triplet &&triplet) {
129             return Subscript(FoldOperation(context, std::move(triplet)));
130           },
131       },
132       std::move(subscript.u));
133 }
134 
135 ArrayRef FoldOperation(FoldingContext &context, ArrayRef &&arrayRef) {
136   NamedEntity base{FoldOperation(context, std::move(arrayRef.base()))};
137   for (Subscript &subscript : arrayRef.subscript()) {
138     subscript = FoldOperation(context, std::move(subscript));
139   }
140   return ArrayRef{std::move(base), std::move(arrayRef.subscript())};
141 }
142 
143 CoarrayRef FoldOperation(FoldingContext &context, CoarrayRef &&coarrayRef) {
144   std::vector<Subscript> subscript;
145   for (Subscript x : coarrayRef.subscript()) {
146     subscript.emplace_back(FoldOperation(context, std::move(x)));
147   }
148   std::vector<Expr<SubscriptInteger>> cosubscript;
149   for (Expr<SubscriptInteger> x : coarrayRef.cosubscript()) {
150     cosubscript.emplace_back(Fold(context, std::move(x)));
151   }
152   CoarrayRef folded{std::move(coarrayRef.base()), std::move(subscript),
153       std::move(cosubscript)};
154   if (std::optional<Expr<SomeInteger>> stat{coarrayRef.stat()}) {
155     folded.set_stat(Fold(context, std::move(*stat)));
156   }
157   if (std::optional<Expr<SomeInteger>> team{coarrayRef.team()}) {
158     folded.set_team(
159         Fold(context, std::move(*team)), coarrayRef.teamIsTeamNumber());
160   }
161   return folded;
162 }
163 
164 DataRef FoldOperation(FoldingContext &context, DataRef &&dataRef) {
165   return common::visit(common::visitors{
166                            [&](SymbolRef symbol) { return DataRef{*symbol}; },
167                            [&](auto &&x) {
168                              return DataRef{
169                                  FoldOperation(context, std::move(x))};
170                            },
171                        },
172       std::move(dataRef.u));
173 }
174 
175 Substring FoldOperation(FoldingContext &context, Substring &&substring) {
176   auto lower{Fold(context, substring.lower())};
177   auto upper{Fold(context, substring.upper())};
178   if (const DataRef * dataRef{substring.GetParentIf<DataRef>()}) {
179     return Substring{FoldOperation(context, DataRef{*dataRef}),
180         std::move(lower), std::move(upper)};
181   } else {
182     auto p{*substring.GetParentIf<StaticDataObject::Pointer>()};
183     return Substring{std::move(p), std::move(lower), std::move(upper)};
184   }
185 }
186 
187 ComplexPart FoldOperation(FoldingContext &context, ComplexPart &&complexPart) {
188   DataRef complex{complexPart.complex()};
189   return ComplexPart{
190       FoldOperation(context, std::move(complex)), complexPart.part()};
191 }
192 
193 std::optional<std::int64_t> GetInt64Arg(
194     const std::optional<ActualArgument> &arg) {
195   if (const auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(arg)}) {
196     return ToInt64(*intExpr);
197   } else {
198     return std::nullopt;
199   }
200 }
201 
202 std::optional<std::int64_t> GetInt64ArgOr(
203     const std::optional<ActualArgument> &arg, std::int64_t defaultValue) {
204   if (!arg) {
205     return defaultValue;
206   } else if (const auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(arg)}) {
207     return ToInt64(*intExpr);
208   } else {
209     return std::nullopt;
210   }
211 }
212 
213 Expr<ImpliedDoIndex::Result> FoldOperation(
214     FoldingContext &context, ImpliedDoIndex &&iDo) {
215   if (std::optional<ConstantSubscript> value{context.GetImpliedDo(iDo.name)}) {
216     return Expr<ImpliedDoIndex::Result>{*value};
217   } else {
218     return Expr<ImpliedDoIndex::Result>{std::move(iDo)};
219   }
220 }
221 
222 template class ExpressionBase<SomeDerived>;
223 template class ExpressionBase<SomeType>;
224 
225 } // namespace Fortran::evaluate
226