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