1 | //===-- lib/Evaluate/fold-implementation.h --------------------------------===// |
---|---|
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 | #ifndef FORTRAN_EVALUATE_FOLD_IMPLEMENTATION_H_ |
10 | #define FORTRAN_EVALUATE_FOLD_IMPLEMENTATION_H_ |
11 | |
12 | #include "character.h" |
13 | #include "host.h" |
14 | #include "int-power.h" |
15 | #include "flang/Common/indirection.h" |
16 | #include "flang/Common/template.h" |
17 | #include "flang/Common/unwrap.h" |
18 | #include "flang/Evaluate/characteristics.h" |
19 | #include "flang/Evaluate/common.h" |
20 | #include "flang/Evaluate/constant.h" |
21 | #include "flang/Evaluate/expression.h" |
22 | #include "flang/Evaluate/fold.h" |
23 | #include "flang/Evaluate/formatting.h" |
24 | #include "flang/Evaluate/intrinsics-library.h" |
25 | #include "flang/Evaluate/intrinsics.h" |
26 | #include "flang/Evaluate/shape.h" |
27 | #include "flang/Evaluate/tools.h" |
28 | #include "flang/Evaluate/traverse.h" |
29 | #include "flang/Evaluate/type.h" |
30 | #include "flang/Parser/message.h" |
31 | #include "flang/Semantics/scope.h" |
32 | #include "flang/Semantics/symbol.h" |
33 | #include "flang/Semantics/tools.h" |
34 | #include <algorithm> |
35 | #include <cmath> |
36 | #include <complex> |
37 | #include <cstdio> |
38 | #include <optional> |
39 | #include <type_traits> |
40 | #include <variant> |
41 | |
42 | // Some environments, viz. glibc 2.17 and *BSD, allow the macro HUGE |
43 | // to leak out of <math.h>. |
44 | #undef HUGE |
45 | |
46 | namespace Fortran::evaluate { |
47 | |
48 | // Don't use Kahan extended precision summation any more when folding |
49 | // transformational intrinsic functions other than SUM, since it is |
50 | // not used in the runtime implementations of those functions and we |
51 | // want results to match. |
52 | static constexpr bool useKahanSummation{false}; |
53 | |
54 | // Utilities |
55 | template <typename T> class Folder { |
56 | public: |
57 | explicit Folder(FoldingContext &c, bool forOptionalArgument = false) |
58 | : context_{c}, forOptionalArgument_{forOptionalArgument} {} |
59 | std::optional<Constant<T>> GetNamedConstant(const Symbol &); |
60 | std::optional<Constant<T>> ApplySubscripts(const Constant<T> &array, |
61 | const std::vector<Constant<SubscriptInteger>> &subscripts); |
62 | std::optional<Constant<T>> ApplyComponent(Constant<SomeDerived> &&, |
63 | const Symbol &component, |
64 | const std::vector<Constant<SubscriptInteger>> * = nullptr); |
65 | std::optional<Constant<T>> GetConstantComponent( |
66 | Component &, const std::vector<Constant<SubscriptInteger>> * = nullptr); |
67 | std::optional<Constant<T>> Folding(ArrayRef &); |
68 | std::optional<Constant<T>> Folding(DataRef &); |
69 | Expr<T> Folding(Designator<T> &&); |
70 | Constant<T> *Folding(std::optional<ActualArgument> &); |
71 | |
72 | Expr<T> CSHIFT(FunctionRef<T> &&); |
73 | Expr<T> EOSHIFT(FunctionRef<T> &&); |
74 | Expr<T> MERGE(FunctionRef<T> &&); |
75 | Expr<T> PACK(FunctionRef<T> &&); |
76 | Expr<T> RESHAPE(FunctionRef<T> &&); |
77 | Expr<T> SPREAD(FunctionRef<T> &&); |
78 | Expr<T> TRANSPOSE(FunctionRef<T> &&); |
79 | Expr<T> UNPACK(FunctionRef<T> &&); |
80 | |
81 | Expr<T> TRANSFER(FunctionRef<T> &&); |
82 | |
83 | private: |
84 | FoldingContext &context_; |
85 | bool forOptionalArgument_{false}; |
86 | }; |
87 | |
88 | std::optional<Constant<SubscriptInteger>> GetConstantSubscript( |
89 | FoldingContext &, Subscript &, const NamedEntity &, int dim); |
90 | |
91 | // Helper to use host runtime on scalars for folding. |
92 | template <typename TR, typename... TA> |
93 | std::optional<std::function<Scalar<TR>(FoldingContext &, Scalar<TA>...)>> |
94 | GetHostRuntimeWrapper(const std::string &name) { |
95 | std::vector<DynamicType> argTypes{TA{}.GetType()...}; |
96 | if (auto hostWrapper{GetHostRuntimeWrapper(name, TR{}.GetType(), argTypes)}) { |
97 | return [hostWrapper]( |
98 | FoldingContext &context, Scalar<TA>... args) -> Scalar<TR> { |
99 | std::vector<Expr<SomeType>> genericArgs{ |
100 | AsGenericExpr(Constant<TA>{args})...}; |
101 | return GetScalarConstantValue<TR>( |
102 | (*hostWrapper)(context, std::move(genericArgs))) |
103 | .value(); |
104 | }; |
105 | } |
106 | return std::nullopt; |
107 | } |
108 | |
109 | // FoldOperation() rewrites expression tree nodes. |
110 | // If there is any possibility that the rewritten node will |
111 | // not have the same representation type, the result of |
112 | // FoldOperation() will be packaged in an Expr<> of the same |
113 | // specific type. |
114 | |
115 | // no-op base case |
116 | template <typename A> |
117 | common::IfNoLvalue<Expr<ResultType<A>>, A> FoldOperation( |
118 | FoldingContext &, A &&x) { |
119 | static_assert(!std::is_same_v<A, Expr<ResultType<A>>>, |
120 | "call Fold() instead for Expr<>"); |
121 | return Expr<ResultType<A>>{std::move(x)}; |
122 | } |
123 | |
124 | Component FoldOperation(FoldingContext &, Component &&); |
125 | NamedEntity FoldOperation(FoldingContext &, NamedEntity &&); |
126 | Triplet FoldOperation(FoldingContext &, Triplet &&); |
127 | Subscript FoldOperation(FoldingContext &, Subscript &&); |
128 | ArrayRef FoldOperation(FoldingContext &, ArrayRef &&); |
129 | CoarrayRef FoldOperation(FoldingContext &, CoarrayRef &&); |
130 | DataRef FoldOperation(FoldingContext &, DataRef &&); |
131 | Substring FoldOperation(FoldingContext &, Substring &&); |
132 | ComplexPart FoldOperation(FoldingContext &, ComplexPart &&); |
133 | template <typename T> |
134 | Expr<T> FoldOperation(FoldingContext &, FunctionRef<T> &&); |
135 | template <typename T> |
136 | Expr<T> FoldOperation(FoldingContext &context, Designator<T> &&designator) { |
137 | return Folder<T>{context}.Folding(std::move(designator)); |
138 | } |
139 | Expr<TypeParamInquiry::Result> FoldOperation( |
140 | FoldingContext &, TypeParamInquiry &&); |
141 | Expr<ImpliedDoIndex::Result> FoldOperation( |
142 | FoldingContext &context, ImpliedDoIndex &&); |
143 | template <typename T> |
144 | Expr<T> FoldOperation(FoldingContext &, ArrayConstructor<T> &&); |
145 | Expr<SomeDerived> FoldOperation(FoldingContext &, StructureConstructor &&); |
146 | |
147 | template <typename T> |
148 | std::optional<Constant<T>> Folder<T>::GetNamedConstant(const Symbol &symbol0) { |
149 | const Symbol &symbol{ResolveAssociations(symbol0)}; |
150 | if (IsNamedConstant(symbol)) { |
151 | if (const auto *object{ |
152 | symbol.detailsIf<semantics::ObjectEntityDetails>()}) { |
153 | if (const auto *constant{UnwrapConstantValue<T>(object->init())}) { |
154 | return *constant; |
155 | } |
156 | } |
157 | } |
158 | return std::nullopt; |
159 | } |
160 | |
161 | template <typename T> |
162 | std::optional<Constant<T>> Folder<T>::Folding(ArrayRef &aRef) { |
163 | std::vector<Constant<SubscriptInteger>> subscripts; |
164 | int dim{0}; |
165 | for (Subscript &ss : aRef.subscript()) { |
166 | if (auto constant{GetConstantSubscript(context_, ss, aRef.base(), dim++)}) { |
167 | subscripts.emplace_back(std::move(*constant)); |
168 | } else { |
169 | return std::nullopt; |
170 | } |
171 | } |
172 | if (Component * component{aRef.base().UnwrapComponent()}) { |
173 | return GetConstantComponent(*component, &subscripts); |
174 | } else if (std::optional<Constant<T>> array{ |
175 | GetNamedConstant(aRef.base().GetLastSymbol())}) { |
176 | return ApplySubscripts(*array, subscripts); |
177 | } else { |
178 | return std::nullopt; |
179 | } |
180 | } |
181 | |
182 | template <typename T> |
183 | std::optional<Constant<T>> Folder<T>::Folding(DataRef &ref) { |
184 | return common::visit( |
185 | common::visitors{ |
186 | [this](SymbolRef &sym) { return GetNamedConstant(*sym); }, |
187 | [this](Component &comp) { |
188 | comp = FoldOperation(context_, std::move(comp)); |
189 | return GetConstantComponent(comp); |
190 | }, |
191 | [this](ArrayRef &aRef) { |
192 | aRef = FoldOperation(context_, std::move(aRef)); |
193 | return Folding(aRef); |
194 | }, |
195 | [](CoarrayRef &) { return std::optional<Constant<T>>{}; }, |
196 | }, |
197 | ref.u); |
198 | } |
199 | |
200 | // TODO: This would be more natural as a member function of Constant<T>. |
201 | template <typename T> |
202 | std::optional<Constant<T>> Folder<T>::ApplySubscripts(const Constant<T> &array, |
203 | const std::vector<Constant<SubscriptInteger>> &subscripts) { |
204 | const auto &shape{array.shape()}; |
205 | const auto &lbounds{array.lbounds()}; |
206 | int rank{GetRank(shape)}; |
207 | CHECK(rank == static_cast<int>(subscripts.size())); |
208 | std::size_t elements{1}; |
209 | ConstantSubscripts resultShape; |
210 | ConstantSubscripts ssLB; |
211 | for (const auto &ss : subscripts) { |
212 | if (ss.Rank() == 1) { |
213 | resultShape.push_back(static_cast<ConstantSubscript>(ss.size())); |
214 | elements *= ss.size(); |
215 | ssLB.push_back(ss.lbounds().front()); |
216 | } else if (ss.Rank() > 1) { |
217 | return std::nullopt; // error recovery |
218 | } |
219 | } |
220 | ConstantSubscripts ssAt(rank, 0), at(rank, 0), tmp(1, 0); |
221 | std::vector<Scalar<T>> values; |
222 | while (elements-- > 0) { |
223 | bool increment{true}; |
224 | int k{0}; |
225 | for (int j{0}; j < rank; ++j) { |
226 | if (subscripts[j].Rank() == 0) { |
227 | at[j] = subscripts[j].GetScalarValue().value().ToInt64(); |
228 | } else { |
229 | CHECK(k < GetRank(resultShape)); |
230 | tmp[0] = ssLB.at(k) + ssAt.at(k); |
231 | at[j] = subscripts[j].At(tmp).ToInt64(); |
232 | if (increment) { |
233 | if (++ssAt[k] == resultShape[k]) { |
234 | ssAt[k] = 0; |
235 | } else { |
236 | increment = false; |
237 | } |
238 | } |
239 | ++k; |
240 | } |
241 | if (at[j] < lbounds[j] || at[j] >= lbounds[j] + shape[j]) { |
242 | context_.messages().Say( |
243 | "Subscript value (%jd) is out of range on dimension %d in reference to a constant array value"_err_en_US, |
244 | at[j], j + 1); |
245 | return std::nullopt; |
246 | } |
247 | } |
248 | values.emplace_back(array.At(at)); |
249 | CHECK(!increment || elements == 0); |
250 | CHECK(k == GetRank(resultShape)); |
251 | } |
252 | if constexpr (T::category == TypeCategory::Character) { |
253 | return Constant<T>{array.LEN(), std::move(values), std::move(resultShape)}; |
254 | } else if constexpr (std::is_same_v<T, SomeDerived>) { |
255 | return Constant<T>{array.result().derivedTypeSpec(), std::move(values), |
256 | std::move(resultShape)}; |
257 | } else { |
258 | return Constant<T>{std::move(values), std::move(resultShape)}; |
259 | } |
260 | } |
261 | |
262 | template <typename T> |
263 | std::optional<Constant<T>> Folder<T>::ApplyComponent( |
264 | Constant<SomeDerived> &&structures, const Symbol &component, |
265 | const std::vector<Constant<SubscriptInteger>> *subscripts) { |
266 | if (auto scalar{structures.GetScalarValue()}) { |
267 | if (std::optional<Expr<SomeType>> expr{scalar->Find(component)}) { |
268 | if (const Constant<T> *value{UnwrapConstantValue<T>(*expr)}) { |
269 | if (subscripts) { |
270 | return ApplySubscripts(*value, *subscripts); |
271 | } else { |
272 | return *value; |
273 | } |
274 | } |
275 | } |
276 | } else { |
277 | // A(:)%scalar_component & A(:)%array_component(subscripts) |
278 | std::unique_ptr<ArrayConstructor<T>> array; |
279 | if (structures.empty()) { |
280 | return std::nullopt; |
281 | } |
282 | ConstantSubscripts at{structures.lbounds()}; |
283 | do { |
284 | StructureConstructor scalar{structures.At(at)}; |
285 | if (std::optional<Expr<SomeType>> expr{scalar.Find(component)}) { |
286 | if (const Constant<T> *value{UnwrapConstantValue<T>(expr.value())}) { |
287 | if (!array.get()) { |
288 | // This technique ensures that character length or derived type |
289 | // information is propagated to the array constructor. |
290 | auto *typedExpr{UnwrapExpr<Expr<T>>(expr.value())}; |
291 | CHECK(typedExpr); |
292 | array = std::make_unique<ArrayConstructor<T>>(*typedExpr); |
293 | if constexpr (T::category == TypeCategory::Character) { |
294 | array->set_LEN(Expr<SubscriptInteger>{value->LEN()}); |
295 | } |
296 | } |
297 | if (subscripts) { |
298 | if (auto element{ApplySubscripts(*value, *subscripts)}) { |
299 | CHECK(element->Rank() == 0); |
300 | array->Push(Expr<T>{std::move(*element)}); |
301 | } else { |
302 | return std::nullopt; |
303 | } |
304 | } else { |
305 | CHECK(value->Rank() == 0); |
306 | array->Push(Expr<T>{*value}); |
307 | } |
308 | } else { |
309 | return std::nullopt; |
310 | } |
311 | } |
312 | } while (structures.IncrementSubscripts(at)); |
313 | // Fold the ArrayConstructor<> into a Constant<>. |
314 | CHECK(array); |
315 | Expr<T> result{Fold(context_, Expr<T>{std::move(*array)})}; |
316 | if (auto *constant{UnwrapConstantValue<T>(result)}) { |
317 | return constant->Reshape(common::Clone(structures.shape())); |
318 | } |
319 | } |
320 | return std::nullopt; |
321 | } |
322 | |
323 | template <typename T> |
324 | std::optional<Constant<T>> Folder<T>::GetConstantComponent(Component &component, |
325 | const std::vector<Constant<SubscriptInteger>> *subscripts) { |
326 | if (std::optional<Constant<SomeDerived>> structures{common::visit( |
327 | common::visitors{ |
328 | [&](const Symbol &symbol) { |
329 | return Folder<SomeDerived>{context_}.GetNamedConstant(symbol); |
330 | }, |
331 | [&](ArrayRef &aRef) { |
332 | return Folder<SomeDerived>{context_}.Folding(aRef); |
333 | }, |
334 | [&](Component &base) { |
335 | return Folder<SomeDerived>{context_}.GetConstantComponent(base); |
336 | }, |
337 | [&](CoarrayRef &) { |
338 | return std::optional<Constant<SomeDerived>>{}; |
339 | }, |
340 | }, |
341 | component.base().u)}) { |
342 | return ApplyComponent( |
343 | std::move(*structures), component.GetLastSymbol(), subscripts); |
344 | } else { |
345 | return std::nullopt; |
346 | } |
347 | } |
348 | |
349 | template <typename T> Expr<T> Folder<T>::Folding(Designator<T> &&designator) { |
350 | if constexpr (T::category == TypeCategory::Character) { |
351 | if (auto *substring{common::Unwrap<Substring>(designator.u)}) { |
352 | if (std::optional<Expr<SomeCharacter>> folded{ |
353 | substring->Fold(context_)}) { |
354 | if (const auto *specific{std::get_if<Expr<T>>(&folded->u)}) { |
355 | return std::move(*specific); |
356 | } |
357 | } |
358 | // We used to fold zero-length substrings into zero-length |
359 | // constants here, but that led to problems in variable |
360 | // definition contexts. |
361 | } |
362 | } else if constexpr (T::category == TypeCategory::Real) { |
363 | if (auto *zPart{std::get_if<ComplexPart>(&designator.u)}) { |
364 | *zPart = FoldOperation(context_, std::move(*zPart)); |
365 | using ComplexT = Type<TypeCategory::Complex, T::kind>; |
366 | if (auto zConst{Folder<ComplexT>{context_}.Folding(zPart->complex())}) { |
367 | return Fold(context_, |
368 | Expr<T>{ComplexComponent<T::kind>{ |
369 | zPart->part() == ComplexPart::Part::IM, |
370 | Expr<ComplexT>{std::move(*zConst)}}}); |
371 | } else { |
372 | return Expr<T>{Designator<T>{std::move(*zPart)}}; |
373 | } |
374 | } |
375 | } |
376 | return common::visit( |
377 | common::visitors{ |
378 | [&](SymbolRef &&symbol) { |
379 | if (auto constant{GetNamedConstant(*symbol)}) { |
380 | return Expr<T>{std::move(*constant)}; |
381 | } |
382 | return Expr<T>{std::move(designator)}; |
383 | }, |
384 | [&](ArrayRef &&aRef) { |
385 | aRef = FoldOperation(context_, std::move(aRef)); |
386 | if (auto c{Folding(aRef)}) { |
387 | return Expr<T>{std::move(*c)}; |
388 | } else { |
389 | return Expr<T>{Designator<T>{std::move(aRef)}}; |
390 | } |
391 | }, |
392 | [&](Component &&component) { |
393 | component = FoldOperation(context_, std::move(component)); |
394 | if (auto c{GetConstantComponent(component)}) { |
395 | return Expr<T>{std::move(*c)}; |
396 | } else { |
397 | return Expr<T>{Designator<T>{std::move(component)}}; |
398 | } |
399 | }, |
400 | [&](auto &&x) { |
401 | return Expr<T>{ |
402 | Designator<T>{FoldOperation(context_, std::move(x))}}; |
403 | }, |
404 | }, |
405 | std::move(designator.u)); |
406 | } |
407 | |
408 | // Apply type conversion and re-folding if necessary. |
409 | // This is where BOZ arguments are converted. |
410 | template <typename T> |
411 | Constant<T> *Folder<T>::Folding(std::optional<ActualArgument> &arg) { |
412 | if (auto *expr{UnwrapExpr<Expr<SomeType>>(arg)}) { |
413 | *expr = Fold(context_, std::move(*expr)); |
414 | if constexpr (T::category != TypeCategory::Derived) { |
415 | if (!UnwrapExpr<Expr<T>>(*expr)) { |
416 | if (const Symbol * |
417 | var{forOptionalArgument_ |
418 | ? UnwrapWholeSymbolOrComponentDataRef(*expr) |
419 | : nullptr}; |
420 | var && (IsOptional(*var) || IsAllocatableOrObjectPointer(var))) { |
421 | // can't safely convert item that may not be present |
422 | } else if (auto converted{ |
423 | ConvertToType(T::GetType(), std::move(*expr))}) { |
424 | *expr = Fold(context_, std::move(*converted)); |
425 | } |
426 | } |
427 | } |
428 | return UnwrapConstantValue<T>(*expr); |
429 | } |
430 | return nullptr; |
431 | } |
432 | |
433 | template <typename... A, std::size_t... I> |
434 | std::optional<std::tuple<const Constant<A> *...>> GetConstantArgumentsHelper( |
435 | FoldingContext &context, ActualArguments &arguments, |
436 | bool hasOptionalArgument, std::index_sequence<I...>) { |
437 | static_assert(sizeof...(A) > 0); |
438 | std::tuple<const Constant<A> *...> args{ |
439 | Folder<A>{context, hasOptionalArgument}.Folding(arguments.at(I))...}; |
440 | if ((... && (std::get<I>(args)))) { |
441 | return args; |
442 | } else { |
443 | return std::nullopt; |
444 | } |
445 | } |
446 | |
447 | template <typename... A> |
448 | std::optional<std::tuple<const Constant<A> *...>> GetConstantArguments( |
449 | FoldingContext &context, ActualArguments &args, bool hasOptionalArgument) { |
450 | return GetConstantArgumentsHelper<A...>( |
451 | context, args, hasOptionalArgument, std::index_sequence_for<A...>{}); |
452 | } |
453 | |
454 | template <typename... A, std::size_t... I> |
455 | std::optional<std::tuple<Scalar<A>...>> GetScalarConstantArgumentsHelper( |
456 | FoldingContext &context, ActualArguments &args, bool hasOptionalArgument, |
457 | std::index_sequence<I...>) { |
458 | if (auto constArgs{ |
459 | GetConstantArguments<A...>(context, args, hasOptionalArgument)}) { |
460 | return std::tuple<Scalar<A>...>{ |
461 | std::get<I>(*constArgs)->GetScalarValue().value()...}; |
462 | } else { |
463 | return std::nullopt; |
464 | } |
465 | } |
466 | |
467 | template <typename... A> |
468 | std::optional<std::tuple<Scalar<A>...>> GetScalarConstantArguments( |
469 | FoldingContext &context, ActualArguments &args, bool hasOptionalArgument) { |
470 | return GetScalarConstantArgumentsHelper<A...>( |
471 | context, args, hasOptionalArgument, std::index_sequence_for<A...>{}); |
472 | } |
473 | |
474 | // helpers to fold intrinsic function references |
475 | // Define callable types used in a common utility that |
476 | // takes care of array and cast/conversion aspects for elemental intrinsics |
477 | |
478 | template <typename TR, typename... TArgs> |
479 | using ScalarFunc = std::function<Scalar<TR>(const Scalar<TArgs> &...)>; |
480 | template <typename TR, typename... TArgs> |
481 | using ScalarFuncWithContext = |
482 | std::function<Scalar<TR>(FoldingContext &, const Scalar<TArgs> &...)>; |
483 | |
484 | template <template <typename, typename...> typename WrapperType, typename TR, |
485 | typename... TA, std::size_t... I> |
486 | Expr<TR> FoldElementalIntrinsicHelper(FoldingContext &context, |
487 | FunctionRef<TR> &&funcRef, WrapperType<TR, TA...> func, |
488 | bool hasOptionalArgument, std::index_sequence<I...>) { |
489 | if (std::optional<std::tuple<const Constant<TA> *...>> args{ |
490 | GetConstantArguments<TA...>( |
491 | context, funcRef.arguments(), hasOptionalArgument)}) { |
492 | // Compute the shape of the result based on shapes of arguments |
493 | ConstantSubscripts shape; |
494 | int rank{0}; |
495 | const ConstantSubscripts *shapes[]{&std::get<I>(*args)->shape()...}; |
496 | const int ranks[]{std::get<I>(*args)->Rank()...}; |
497 | for (unsigned int i{0}; i < sizeof...(TA); ++i) { |
498 | if (ranks[i] > 0) { |
499 | if (rank == 0) { |
500 | rank = ranks[i]; |
501 | shape = *shapes[i]; |
502 | } else { |
503 | if (shape != *shapes[i]) { |
504 | // TODO: Rank compatibility was already checked but it seems to be |
505 | // the first place where the actual shapes are checked to be the |
506 | // same. Shouldn't this be checked elsewhere so that this is also |
507 | // checked for non constexpr call to elemental intrinsics function? |
508 | context.messages().Say( |
509 | "Arguments in elemental intrinsic function are not conformable"_err_en_US); |
510 | return Expr<TR>{std::move(funcRef)}; |
511 | } |
512 | } |
513 | } |
514 | } |
515 | CHECK(rank == GetRank(shape)); |
516 | // Compute all the scalar values of the results |
517 | std::vector<Scalar<TR>> results; |
518 | std::optional<uint64_t> n{TotalElementCount(shape)}; |
519 | if (!n) { |
520 | context.messages().Say( |
521 | "Too many elements in elemental intrinsic function result"_err_en_US); |
522 | return Expr<TR>{std::move(funcRef)}; |
523 | } |
524 | if (*n > 0) { |
525 | ConstantBounds bounds{shape}; |
526 | ConstantSubscripts resultIndex(rank, 1); |
527 | ConstantSubscripts argIndex[]{std::get<I>(*args)->lbounds()...}; |
528 | do { |
529 | if constexpr (std::is_same_v<WrapperType<TR, TA...>, |
530 | ScalarFuncWithContext<TR, TA...>>) { |
531 | results.emplace_back( |
532 | func(context, std::get<I>(*args)->At(argIndex[I])...)); |
533 | } else if constexpr (std::is_same_v<WrapperType<TR, TA...>, |
534 | ScalarFunc<TR, TA...>>) { |
535 | results.emplace_back(func(std::get<I>(*args)->At(argIndex[I])...)); |
536 | } |
537 | (std::get<I>(*args)->IncrementSubscripts(argIndex[I]), ...); |
538 | } while (bounds.IncrementSubscripts(resultIndex)); |
539 | } |
540 | // Build and return constant result |
541 | if constexpr (TR::category == TypeCategory::Character) { |
542 | auto len{static_cast<ConstantSubscript>( |
543 | results.empty() ? 0 : results[0].length())}; |
544 | return Expr<TR>{Constant<TR>{len, std::move(results), std::move(shape)}}; |
545 | } else if constexpr (TR::category == TypeCategory::Derived) { |
546 | if (!results.empty()) { |
547 | return Expr<TR>{rank == 0 |
548 | ? Constant<TR>{results.front()} |
549 | : Constant<TR>{results.front().derivedTypeSpec(), |
550 | std::move(results), std::move(shape)}}; |
551 | } |
552 | } else { |
553 | return Expr<TR>{Constant<TR>{std::move(results), std::move(shape)}}; |
554 | } |
555 | } |
556 | return Expr<TR>{std::move(funcRef)}; |
557 | } |
558 | |
559 | template <typename TR, typename... TA> |
560 | Expr<TR> FoldElementalIntrinsic(FoldingContext &context, |
561 | FunctionRef<TR> &&funcRef, ScalarFunc<TR, TA...> func, |
562 | bool hasOptionalArgument = false) { |
563 | return FoldElementalIntrinsicHelper<ScalarFunc, TR, TA...>(context, |
564 | std::move(funcRef), func, hasOptionalArgument, |
565 | std::index_sequence_for<TA...>{}); |
566 | } |
567 | template <typename TR, typename... TA> |
568 | Expr<TR> FoldElementalIntrinsic(FoldingContext &context, |
569 | FunctionRef<TR> &&funcRef, ScalarFuncWithContext<TR, TA...> func, |
570 | bool hasOptionalArgument = false) { |
571 | return FoldElementalIntrinsicHelper<ScalarFuncWithContext, TR, TA...>(context, |
572 | std::move(funcRef), func, hasOptionalArgument, |
573 | std::index_sequence_for<TA...>{}); |
574 | } |
575 | |
576 | std::optional<std::int64_t> GetInt64ArgOr( |
577 | const std::optional<ActualArgument> &, std::int64_t defaultValue); |
578 | |
579 | template <typename A, typename B> |
580 | std::optional<std::vector<A>> GetIntegerVector(const B &x) { |
581 | static_assert(std::is_integral_v<A>); |
582 | if (const auto *someInteger{UnwrapExpr<Expr<SomeInteger>>(x)}) { |
583 | return common::visit( |
584 | [](const auto &typedExpr) -> std::optional<std::vector<A>> { |
585 | using T = ResultType<decltype(typedExpr)>; |
586 | if (const auto *constant{UnwrapConstantValue<T>(typedExpr)}) { |
587 | if (constant->Rank() == 1) { |
588 | std::vector<A> result; |
589 | for (const auto &value : constant->values()) { |
590 | result.push_back(static_cast<A>(value.ToInt64())); |
591 | } |
592 | return result; |
593 | } |
594 | } |
595 | return std::nullopt; |
596 | }, |
597 | someInteger->u); |
598 | } |
599 | return std::nullopt; |
600 | } |
601 | |
602 | // Transform an intrinsic function reference that contains user errors |
603 | // into an intrinsic with the same characteristic but the "invalid" name. |
604 | // This to prevent generating warnings over and over if the expression |
605 | // gets re-folded. |
606 | template <typename T> Expr<T> MakeInvalidIntrinsic(FunctionRef<T> &&funcRef) { |
607 | SpecificIntrinsic invalid{std::get<SpecificIntrinsic>(funcRef.proc().u)}; |
608 | invalid.name = IntrinsicProcTable::InvalidName; |
609 | return Expr<T>{FunctionRef<T>{ProcedureDesignator{std::move(invalid)}, |
610 | ActualArguments{std::move(funcRef.arguments())}}}; |
611 | } |
612 | |
613 | template <typename T> Expr<T> Folder<T>::CSHIFT(FunctionRef<T> &&funcRef) { |
614 | auto args{funcRef.arguments()}; |
615 | CHECK(args.size() == 3); |
616 | const auto *array{UnwrapConstantValue<T>(args[0])}; |
617 | const auto *shiftExpr{UnwrapExpr<Expr<SomeInteger>>(args[1])}; |
618 | auto dim{GetInt64ArgOr(args[2], 1)}; |
619 | if (!array || !shiftExpr || !dim) { |
620 | return Expr<T>{std::move(funcRef)}; |
621 | } |
622 | auto convertedShift{Fold(context_, |
623 | ConvertToType<SubscriptInteger>(Expr<SomeInteger>{*shiftExpr}))}; |
624 | const auto *shift{UnwrapConstantValue<SubscriptInteger>(convertedShift)}; |
625 | if (!shift) { |
626 | return Expr<T>{std::move(funcRef)}; |
627 | } |
628 | // Arguments are constant |
629 | if (*dim < 1 || *dim > array->Rank()) { |
630 | context_.messages().Say("Invalid 'dim=' argument (%jd) in CSHIFT"_err_en_US, |
631 | static_cast<std::intmax_t>(*dim)); |
632 | } else if (shift->Rank() > 0 && shift->Rank() != array->Rank() - 1) { |
633 | // message already emitted from intrinsic look-up |
634 | } else { |
635 | int rank{array->Rank()}; |
636 | int zbDim{static_cast<int>(*dim) - 1}; |
637 | bool ok{true}; |
638 | if (shift->Rank() > 0) { |
639 | int k{0}; |
640 | for (int j{0}; j < rank; ++j) { |
641 | if (j != zbDim) { |
642 | if (array->shape()[j] != shift->shape()[k]) { |
643 | context_.messages().Say( |
644 | "Invalid 'shift=' argument in CSHIFT: extent on dimension %d is %jd but must be %jd"_err_en_US, |
645 | k + 1, static_cast<std::intmax_t>(shift->shape()[k]), |
646 | static_cast<std::intmax_t>(array->shape()[j])); |
647 | ok = false; |
648 | } |
649 | ++k; |
650 | } |
651 | } |
652 | } |
653 | if (ok) { |
654 | std::vector<Scalar<T>> resultElements; |
655 | ConstantSubscripts arrayLB{array->lbounds()}; |
656 | ConstantSubscripts arrayAt{arrayLB}; |
657 | ConstantSubscript &dimIndex{arrayAt[zbDim]}; |
658 | ConstantSubscript dimLB{dimIndex}; // initial value |
659 | ConstantSubscript dimExtent{array->shape()[zbDim]}; |
660 | ConstantSubscripts shiftLB{shift->lbounds()}; |
661 | for (auto n{GetSize(array->shape())}; n > 0; --n) { |
662 | ConstantSubscript origDimIndex{dimIndex}; |
663 | ConstantSubscripts shiftAt; |
664 | if (shift->Rank() > 0) { |
665 | int k{0}; |
666 | for (int j{0}; j < rank; ++j) { |
667 | if (j != zbDim) { |
668 | shiftAt.emplace_back(shiftLB[k++] + arrayAt[j] - arrayLB[j]); |
669 | } |
670 | } |
671 | } |
672 | ConstantSubscript shiftCount{shift->At(shiftAt).ToInt64()}; |
673 | dimIndex = dimLB + ((dimIndex - dimLB + shiftCount) % dimExtent); |
674 | if (dimIndex < dimLB) { |
675 | dimIndex += dimExtent; |
676 | } else if (dimIndex >= dimLB + dimExtent) { |
677 | dimIndex -= dimExtent; |
678 | } |
679 | resultElements.push_back(array->At(arrayAt)); |
680 | dimIndex = origDimIndex; |
681 | array->IncrementSubscripts(arrayAt); |
682 | } |
683 | return Expr<T>{PackageConstant<T>( |
684 | std::move(resultElements), *array, array->shape())}; |
685 | } |
686 | } |
687 | // Invalid, prevent re-folding |
688 | return MakeInvalidIntrinsic(std::move(funcRef)); |
689 | } |
690 | |
691 | template <typename T> Expr<T> Folder<T>::EOSHIFT(FunctionRef<T> &&funcRef) { |
692 | auto args{funcRef.arguments()}; |
693 | CHECK(args.size() == 4); |
694 | const auto *array{UnwrapConstantValue<T>(args[0])}; |
695 | const auto *shiftExpr{UnwrapExpr<Expr<SomeInteger>>(args[1])}; |
696 | auto dim{GetInt64ArgOr(args[3], 1)}; |
697 | if (!array || !shiftExpr || !dim) { |
698 | return Expr<T>{std::move(funcRef)}; |
699 | } |
700 | // Apply type conversions to the shift= and boundary= arguments. |
701 | auto convertedShift{Fold(context_, |
702 | ConvertToType<SubscriptInteger>(Expr<SomeInteger>{*shiftExpr}))}; |
703 | const auto *shift{UnwrapConstantValue<SubscriptInteger>(convertedShift)}; |
704 | if (!shift) { |
705 | return Expr<T>{std::move(funcRef)}; |
706 | } |
707 | const Constant<T> *boundary{nullptr}; |
708 | std::optional<Expr<SomeType>> convertedBoundary; |
709 | if (const auto *boundaryExpr{UnwrapExpr<Expr<SomeType>>(args[2])}) { |
710 | convertedBoundary = Fold(context_, |
711 | ConvertToType(array->GetType(), Expr<SomeType>{*boundaryExpr})); |
712 | boundary = UnwrapExpr<Constant<T>>(convertedBoundary); |
713 | if (!boundary) { |
714 | return Expr<T>{std::move(funcRef)}; |
715 | } |
716 | } |
717 | // Arguments are constant |
718 | if (*dim < 1 || *dim > array->Rank()) { |
719 | context_.messages().Say( |
720 | "Invalid 'dim=' argument (%jd) in EOSHIFT"_err_en_US, |
721 | static_cast<std::intmax_t>(*dim)); |
722 | } else if (shift->Rank() > 0 && shift->Rank() != array->Rank() - 1) { |
723 | // message already emitted from intrinsic look-up |
724 | } else if (boundary && boundary->Rank() > 0 && |
725 | boundary->Rank() != array->Rank() - 1) { |
726 | // ditto |
727 | } else { |
728 | int rank{array->Rank()}; |
729 | int zbDim{static_cast<int>(*dim) - 1}; |
730 | bool ok{true}; |
731 | if (shift->Rank() > 0) { |
732 | int k{0}; |
733 | for (int j{0}; j < rank; ++j) { |
734 | if (j != zbDim) { |
735 | if (array->shape()[j] != shift->shape()[k]) { |
736 | context_.messages().Say( |
737 | "Invalid 'shift=' argument in EOSHIFT: extent on dimension %d is %jd but must be %jd"_err_en_US, |
738 | k + 1, static_cast<std::intmax_t>(shift->shape()[k]), |
739 | static_cast<std::intmax_t>(array->shape()[j])); |
740 | ok = false; |
741 | } |
742 | ++k; |
743 | } |
744 | } |
745 | } |
746 | if (boundary && boundary->Rank() > 0) { |
747 | int k{0}; |
748 | for (int j{0}; j < rank; ++j) { |
749 | if (j != zbDim) { |
750 | if (array->shape()[j] != boundary->shape()[k]) { |
751 | context_.messages().Say( |
752 | "Invalid 'boundary=' argument in EOSHIFT: extent on dimension %d is %jd but must be %jd"_err_en_US, |
753 | k + 1, static_cast<std::intmax_t>(boundary->shape()[k]), |
754 | static_cast<std::intmax_t>(array->shape()[j])); |
755 | ok = false; |
756 | } |
757 | ++k; |
758 | } |
759 | } |
760 | } |
761 | if (ok) { |
762 | std::vector<Scalar<T>> resultElements; |
763 | ConstantSubscripts arrayLB{array->lbounds()}; |
764 | ConstantSubscripts arrayAt{arrayLB}; |
765 | ConstantSubscript &dimIndex{arrayAt[zbDim]}; |
766 | ConstantSubscript dimLB{dimIndex}; // initial value |
767 | ConstantSubscript dimExtent{array->shape()[zbDim]}; |
768 | ConstantSubscripts shiftLB{shift->lbounds()}; |
769 | ConstantSubscripts boundaryLB; |
770 | if (boundary) { |
771 | boundaryLB = boundary->lbounds(); |
772 | } |
773 | for (auto n{GetSize(array->shape())}; n > 0; --n) { |
774 | ConstantSubscript origDimIndex{dimIndex}; |
775 | ConstantSubscripts shiftAt; |
776 | if (shift->Rank() > 0) { |
777 | int k{0}; |
778 | for (int j{0}; j < rank; ++j) { |
779 | if (j != zbDim) { |
780 | shiftAt.emplace_back(shiftLB[k++] + arrayAt[j] - arrayLB[j]); |
781 | } |
782 | } |
783 | } |
784 | ConstantSubscript shiftCount{shift->At(shiftAt).ToInt64()}; |
785 | dimIndex += shiftCount; |
786 | if (dimIndex >= dimLB && dimIndex < dimLB + dimExtent) { |
787 | resultElements.push_back(array->At(arrayAt)); |
788 | } else if (boundary) { |
789 | ConstantSubscripts boundaryAt; |
790 | if (boundary->Rank() > 0) { |
791 | for (int j{0}; j < rank; ++j) { |
792 | int k{0}; |
793 | if (j != zbDim) { |
794 | boundaryAt.emplace_back( |
795 | boundaryLB[k++] + arrayAt[j] - arrayLB[j]); |
796 | } |
797 | } |
798 | } |
799 | resultElements.push_back(boundary->At(boundaryAt)); |
800 | } else if constexpr (T::category == TypeCategory::Integer || |
801 | T::category == TypeCategory::Unsigned || |
802 | T::category == TypeCategory::Real || |
803 | T::category == TypeCategory::Complex || |
804 | T::category == TypeCategory::Logical) { |
805 | resultElements.emplace_back(); |
806 | } else if constexpr (T::category == TypeCategory::Character) { |
807 | auto len{static_cast<std::size_t>(array->LEN())}; |
808 | typename Scalar<T>::value_type space{' '}; |
809 | resultElements.emplace_back(len, space); |
810 | } else { |
811 | DIE("no derived type boundary"); |
812 | } |
813 | dimIndex = origDimIndex; |
814 | array->IncrementSubscripts(arrayAt); |
815 | } |
816 | return Expr<T>{PackageConstant<T>( |
817 | std::move(resultElements), *array, array->shape())}; |
818 | } |
819 | } |
820 | // Invalid, prevent re-folding |
821 | return MakeInvalidIntrinsic(std::move(funcRef)); |
822 | } |
823 | |
824 | template <typename T> Expr<T> Folder<T>::MERGE(FunctionRef<T> &&funcRef) { |
825 | return FoldElementalIntrinsic<T, T, T, LogicalResult>(context_, |
826 | std::move(funcRef), |
827 | ScalarFunc<T, T, T, LogicalResult>( |
828 | [](const Scalar<T> &ifTrue, const Scalar<T> &ifFalse, |
829 | const Scalar<LogicalResult> &predicate) -> Scalar<T> { |
830 | return predicate.IsTrue() ? ifTrue : ifFalse; |
831 | })); |
832 | } |
833 | |
834 | template <typename T> Expr<T> Folder<T>::PACK(FunctionRef<T> &&funcRef) { |
835 | auto args{funcRef.arguments()}; |
836 | CHECK(args.size() == 3); |
837 | const auto *array{UnwrapConstantValue<T>(args[0])}; |
838 | const auto *vector{UnwrapConstantValue<T>(args[2])}; |
839 | auto convertedMask{Fold(context_, |
840 | ConvertToType<LogicalResult>( |
841 | Expr<SomeLogical>{DEREF(UnwrapExpr<Expr<SomeLogical>>(args[1]))}))}; |
842 | const auto *mask{UnwrapConstantValue<LogicalResult>(convertedMask)}; |
843 | if (!array || !mask || (args[2] && !vector)) { |
844 | return Expr<T>{std::move(funcRef)}; |
845 | } |
846 | // Arguments are constant. |
847 | ConstantSubscript arrayElements{GetSize(array->shape())}; |
848 | ConstantSubscript truths{0}; |
849 | ConstantSubscripts maskAt{mask->lbounds()}; |
850 | if (mask->Rank() == 0) { |
851 | if (mask->At(maskAt).IsTrue()) { |
852 | truths = arrayElements; |
853 | } |
854 | } else if (array->shape() != mask->shape()) { |
855 | // Error already emitted from intrinsic processing |
856 | return MakeInvalidIntrinsic(std::move(funcRef)); |
857 | } else { |
858 | for (ConstantSubscript j{0}; j < arrayElements; |
859 | ++j, mask->IncrementSubscripts(maskAt)) { |
860 | if (mask->At(maskAt).IsTrue()) { |
861 | ++truths; |
862 | } |
863 | } |
864 | } |
865 | std::vector<Scalar<T>> resultElements; |
866 | ConstantSubscripts arrayAt{array->lbounds()}; |
867 | ConstantSubscript resultSize{truths}; |
868 | if (vector) { |
869 | resultSize = vector->shape().at(0); |
870 | if (resultSize < truths) { |
871 | context_.messages().Say( |
872 | "Invalid 'vector=' argument in PACK: the 'mask=' argument has %jd true elements, but the vector has only %jd elements"_err_en_US, |
873 | static_cast<std::intmax_t>(truths), |
874 | static_cast<std::intmax_t>(resultSize)); |
875 | return MakeInvalidIntrinsic(std::move(funcRef)); |
876 | } |
877 | } |
878 | for (ConstantSubscript j{0}; j < truths;) { |
879 | if (mask->At(maskAt).IsTrue()) { |
880 | resultElements.push_back(array->At(arrayAt)); |
881 | ++j; |
882 | } |
883 | array->IncrementSubscripts(arrayAt); |
884 | mask->IncrementSubscripts(maskAt); |
885 | } |
886 | if (vector) { |
887 | ConstantSubscripts vectorAt{vector->lbounds()}; |
888 | vectorAt.at(0) += truths; |
889 | for (ConstantSubscript j{truths}; j < resultSize; ++j) { |
890 | resultElements.push_back(vector->At(vectorAt)); |
891 | ++vectorAt[0]; |
892 | } |
893 | } |
894 | return Expr<T>{PackageConstant<T>(std::move(resultElements), *array, |
895 | ConstantSubscripts{static_cast<ConstantSubscript>(resultSize)})}; |
896 | } |
897 | |
898 | template <typename T> Expr<T> Folder<T>::RESHAPE(FunctionRef<T> &&funcRef) { |
899 | auto args{funcRef.arguments()}; |
900 | CHECK(args.size() == 4); |
901 | const auto *source{UnwrapConstantValue<T>(args[0])}; |
902 | const auto *pad{UnwrapConstantValue<T>(args[2])}; |
903 | std::optional<std::vector<ConstantSubscript>> shape{ |
904 | GetIntegerVector<ConstantSubscript>(args[1])}; |
905 | std::optional<std::vector<int>> order{GetIntegerVector<int>(args[3])}; |
906 | std::optional<uint64_t> optResultElement; |
907 | std::optional<std::vector<int>> dimOrder; |
908 | bool ok{true}; |
909 | if (shape) { |
910 | if (shape->size() > common::maxRank) { |
911 | context_.messages().Say( |
912 | "Size of 'shape=' argument (%zd) must not be greater than %d"_err_en_US, |
913 | shape->size(), common::maxRank); |
914 | ok = false; |
915 | } else if (HasNegativeExtent(*shape)) { |
916 | context_.messages().Say( |
917 | "'shape=' argument (%s) must not have a negative extent"_err_en_US, |
918 | DEREF(args[1]->UnwrapExpr()).AsFortran()); |
919 | ok = false; |
920 | } else { |
921 | optResultElement = TotalElementCount(*shape); |
922 | if (!optResultElement) { |
923 | context_.messages().Say( |
924 | "'shape=' argument (%s) specifies an array with too many elements"_err_en_US, |
925 | DEREF(args[1]->UnwrapExpr()).AsFortran()); |
926 | ok = false; |
927 | } |
928 | } |
929 | if (order) { |
930 | dimOrder = ValidateDimensionOrder(GetRank(*shape), *order); |
931 | if (!dimOrder) { |
932 | context_.messages().Say( |
933 | "Invalid 'order=' argument (%s) in RESHAPE"_err_en_US, |
934 | DEREF(args[3]->UnwrapExpr()).AsFortran()); |
935 | ok = false; |
936 | } |
937 | } |
938 | } |
939 | if (!ok) { |
940 | // convert into an invalid intrinsic procedure call below |
941 | } else if (!source || !shape || (args[2] && !pad) || (args[3] && !order)) { |
942 | return Expr<T>{std::move(funcRef)}; // Non-constant arguments |
943 | } else { |
944 | uint64_t resultElements{*optResultElement}; |
945 | std::vector<int> *dimOrderPtr{dimOrder ? &dimOrder.value() : nullptr}; |
946 | if (resultElements > source->size() && (!pad || pad->empty())) { |
947 | context_.messages().Say( |
948 | "Too few elements in 'source=' argument and 'pad=' " |
949 | "argument is not present or has null size"_err_en_US); |
950 | ok = false; |
951 | } else { |
952 | Constant<T> result{!source->empty() || !pad |
953 | ? source->Reshape(std::move(shape.value())) |
954 | : pad->Reshape(std::move(shape.value()))}; |
955 | ConstantSubscripts subscripts{result.lbounds()}; |
956 | auto copied{result.CopyFrom(*source, |
957 | std::min(a: static_cast<uint64_t>(source->size()), b: resultElements), |
958 | subscripts, dimOrderPtr)}; |
959 | if (copied < resultElements) { |
960 | CHECK(pad); |
961 | copied += result.CopyFrom( |
962 | *pad, resultElements - copied, subscripts, dimOrderPtr); |
963 | } |
964 | CHECK(copied == resultElements); |
965 | return Expr<T>{std::move(result)}; |
966 | } |
967 | } |
968 | // Invalid, prevent re-folding |
969 | return MakeInvalidIntrinsic(std::move(funcRef)); |
970 | } |
971 | |
972 | template <typename T> Expr<T> Folder<T>::SPREAD(FunctionRef<T> &&funcRef) { |
973 | auto args{funcRef.arguments()}; |
974 | CHECK(args.size() == 3); |
975 | const Constant<T> *source{UnwrapConstantValue<T>(args[0])}; |
976 | auto dim{ToInt64(args[1])}; |
977 | auto ncopies{ToInt64(args[2])}; |
978 | if (!source || !dim) { |
979 | return Expr<T>{std::move(funcRef)}; |
980 | } |
981 | int sourceRank{source->Rank()}; |
982 | if (sourceRank >= common::maxRank) { |
983 | context_.messages().Say( |
984 | "SOURCE= argument to SPREAD has rank %d but must have rank less than %d"_err_en_US, |
985 | sourceRank, common::maxRank); |
986 | } else if (*dim < 1 || *dim > sourceRank + 1) { |
987 | context_.messages().Say( |
988 | "DIM=%d argument to SPREAD must be between 1 and %d"_err_en_US, *dim, |
989 | sourceRank + 1); |
990 | } else if (!ncopies) { |
991 | return Expr<T>{std::move(funcRef)}; |
992 | } else { |
993 | if (*ncopies < 0) { |
994 | ncopies = 0; |
995 | } |
996 | // TODO: Consider moving this implementation (after the user error |
997 | // checks), along with other transformational intrinsics, into |
998 | // constant.h (or a new header) so that the transformationals |
999 | // are available for all Constant<>s without needing to be packaged |
1000 | // as references to intrinsic functions for folding. |
1001 | ConstantSubscripts shape{source->shape()}; |
1002 | shape.insert(shape.begin() + *dim - 1, *ncopies); |
1003 | Constant<T> spread{source->Reshape(std::move(shape))}; |
1004 | std::optional<uint64_t> n{TotalElementCount(spread.shape())}; |
1005 | if (!n) { |
1006 | context_.messages().Say("Too many elements in SPREAD result"_err_en_US); |
1007 | } else { |
1008 | std::vector<int> dimOrder; |
1009 | for (int j{0}; j < sourceRank; ++j) { |
1010 | dimOrder.push_back(j < *dim - 1 ? j : j + 1); |
1011 | } |
1012 | dimOrder.push_back(*dim - 1); |
1013 | ConstantSubscripts at{spread.lbounds()}; // all 1 |
1014 | spread.CopyFrom(*source, *n, at, &dimOrder); |
1015 | return Expr<T>{std::move(spread)}; |
1016 | } |
1017 | } |
1018 | // Invalid, prevent re-folding |
1019 | return MakeInvalidIntrinsic(std::move(funcRef)); |
1020 | } |
1021 | |
1022 | template <typename T> Expr<T> Folder<T>::TRANSPOSE(FunctionRef<T> &&funcRef) { |
1023 | auto args{funcRef.arguments()}; |
1024 | CHECK(args.size() == 1); |
1025 | const auto *matrix{UnwrapConstantValue<T>(args[0])}; |
1026 | if (!matrix) { |
1027 | return Expr<T>{std::move(funcRef)}; |
1028 | } |
1029 | // Argument is constant. Traverse its elements in transposed order. |
1030 | std::vector<Scalar<T>> resultElements; |
1031 | ConstantSubscripts at(2); |
1032 | for (ConstantSubscript j{0}; j < matrix->shape()[0]; ++j) { |
1033 | at[0] = matrix->lbounds()[0] + j; |
1034 | for (ConstantSubscript k{0}; k < matrix->shape()[1]; ++k) { |
1035 | at[1] = matrix->lbounds()[1] + k; |
1036 | resultElements.push_back(matrix->At(at)); |
1037 | } |
1038 | } |
1039 | at = matrix->shape(); |
1040 | std::swap(at[0], at[1]); |
1041 | return Expr<T>{PackageConstant<T>(std::move(resultElements), *matrix, at)}; |
1042 | } |
1043 | |
1044 | template <typename T> Expr<T> Folder<T>::UNPACK(FunctionRef<T> &&funcRef) { |
1045 | auto args{funcRef.arguments()}; |
1046 | CHECK(args.size() == 3); |
1047 | const auto *vector{UnwrapConstantValue<T>(args[0])}; |
1048 | auto convertedMask{Fold(context_, |
1049 | ConvertToType<LogicalResult>( |
1050 | Expr<SomeLogical>{DEREF(UnwrapExpr<Expr<SomeLogical>>(args[1]))}))}; |
1051 | const auto *mask{UnwrapConstantValue<LogicalResult>(convertedMask)}; |
1052 | const auto *field{UnwrapConstantValue<T>(args[2])}; |
1053 | if (!vector || !mask || !field) { |
1054 | return Expr<T>{std::move(funcRef)}; |
1055 | } |
1056 | // Arguments are constant. |
1057 | if (field->Rank() > 0 && field->shape() != mask->shape()) { |
1058 | // Error already emitted from intrinsic processing |
1059 | return MakeInvalidIntrinsic(std::move(funcRef)); |
1060 | } |
1061 | ConstantSubscript maskElements{GetSize(mask->shape())}; |
1062 | ConstantSubscript truths{0}; |
1063 | ConstantSubscripts maskAt{mask->lbounds()}; |
1064 | for (ConstantSubscript j{0}; j < maskElements; |
1065 | ++j, mask->IncrementSubscripts(maskAt)) { |
1066 | if (mask->At(maskAt).IsTrue()) { |
1067 | ++truths; |
1068 | } |
1069 | } |
1070 | if (truths > GetSize(vector->shape())) { |
1071 | context_.messages().Say( |
1072 | "Invalid 'vector=' argument in UNPACK: the 'mask=' argument has %jd true elements, but the vector has only %jd elements"_err_en_US, |
1073 | static_cast<std::intmax_t>(truths), |
1074 | static_cast<std::intmax_t>(GetSize(vector->shape()))); |
1075 | return MakeInvalidIntrinsic(std::move(funcRef)); |
1076 | } |
1077 | std::vector<Scalar<T>> resultElements; |
1078 | ConstantSubscripts vectorAt{vector->lbounds()}; |
1079 | ConstantSubscripts fieldAt{field->lbounds()}; |
1080 | for (ConstantSubscript j{0}; j < maskElements; ++j) { |
1081 | if (mask->At(maskAt).IsTrue()) { |
1082 | resultElements.push_back(vector->At(vectorAt)); |
1083 | vector->IncrementSubscripts(vectorAt); |
1084 | } else { |
1085 | resultElements.push_back(field->At(fieldAt)); |
1086 | } |
1087 | mask->IncrementSubscripts(maskAt); |
1088 | field->IncrementSubscripts(fieldAt); |
1089 | } |
1090 | return Expr<T>{ |
1091 | PackageConstant<T>(std::move(resultElements), *vector, mask->shape())}; |
1092 | } |
1093 | |
1094 | std::optional<Expr<SomeType>> FoldTransfer( |
1095 | FoldingContext &, const ActualArguments &); |
1096 | |
1097 | template <typename T> Expr<T> Folder<T>::TRANSFER(FunctionRef<T> &&funcRef) { |
1098 | if (auto folded{FoldTransfer(context_, funcRef.arguments())}) { |
1099 | return DEREF(UnwrapExpr<Expr<T>>(*folded)); |
1100 | } else { |
1101 | return Expr<T>{std::move(funcRef)}; |
1102 | } |
1103 | } |
1104 | |
1105 | template <typename T> |
1106 | Expr<T> FoldMINorMAX( |
1107 | FoldingContext &context, FunctionRef<T> &&funcRef, Ordering order) { |
1108 | static_assert(T::category == TypeCategory::Integer || |
1109 | T::category == TypeCategory::Unsigned || |
1110 | T::category == TypeCategory::Real || |
1111 | T::category == TypeCategory::Character); |
1112 | auto &args{funcRef.arguments()}; |
1113 | bool ok{true}; |
1114 | std::optional<Expr<T>> result; |
1115 | Folder<T> folder{context}; |
1116 | for (std::optional<ActualArgument> &arg : args) { |
1117 | // Call Folding on all arguments to make operand promotion explicit. |
1118 | if (!folder.Folding(arg)) { |
1119 | // TODO: Lowering can't handle having every FunctionRef for max and min |
1120 | // being converted into Extremum<T>. That needs fixing. Until that |
1121 | // is corrected, however, it is important that max and min references |
1122 | // in module files be converted into Extremum<T> even when not constant; |
1123 | // the Extremum<SubscriptInteger> operations created to normalize the |
1124 | // values of array bounds are formatted as max operations in the |
1125 | // declarations in modules, and need to be read back in as such in |
1126 | // order for expression comparison to not produce false inequalities |
1127 | // when checking function results for procedure interface compatibility. |
1128 | if (!context.moduleFileName()) { |
1129 | ok = false; |
1130 | } |
1131 | } |
1132 | Expr<SomeType> *argExpr{arg ? arg->UnwrapExpr() : nullptr}; |
1133 | if (argExpr) { |
1134 | *argExpr = Fold(context, std::move(*argExpr)); |
1135 | } |
1136 | if (Expr<T> * tExpr{UnwrapExpr<Expr<T>>(argExpr)}) { |
1137 | if (result) { |
1138 | result = FoldOperation( |
1139 | context, Extremum<T>{order, std::move(*result), Expr<T>{*tExpr}}); |
1140 | } else { |
1141 | result = Expr<T>{*tExpr}; |
1142 | } |
1143 | } else { |
1144 | ok = false; |
1145 | } |
1146 | } |
1147 | return ok && result ? std::move(*result) : Expr<T>{std::move(funcRef)}; |
1148 | } |
1149 | |
1150 | // For AMAX0, AMIN0, AMAX1, AMIN1, DMAX1, DMIN1, MAX0, MIN0, MAX1, and MIN1 |
1151 | // a special care has to be taken to insert the conversion on the result |
1152 | // of the MIN/MAX. This is made slightly more complex by the extension |
1153 | // supported by f18 that arguments may have different kinds. This implies |
1154 | // that the created MIN/MAX result type cannot be deduced from the standard but |
1155 | // has to be deduced from the arguments. |
1156 | // e.g. AMAX0(int8, int4) is rewritten to REAL(MAX(int8, INT(int4, 8)))). |
1157 | template <typename T> |
1158 | Expr<T> RewriteSpecificMINorMAX( |
1159 | FoldingContext &context, FunctionRef<T> &&funcRef) { |
1160 | ActualArguments &args{funcRef.arguments()}; |
1161 | auto &intrinsic{DEREF(std::get_if<SpecificIntrinsic>(&funcRef.proc().u))}; |
1162 | // Rewrite MAX1(args) to INT(MAX(args)) and fold. Same logic for MIN1. |
1163 | // Find result type for max/min based on the arguments. |
1164 | std::optional<DynamicType> resultType; |
1165 | ActualArgument *resultTypeArg{nullptr}; |
1166 | for (auto j{args.size()}; j-- > 0;) { |
1167 | if (args[j]) { |
1168 | DynamicType type{args[j]->GetType().value()}; |
1169 | // Handle mixed real/integer arguments: all the previous arguments were |
1170 | // integers and this one is real. The type of the MAX/MIN result will |
1171 | // be the one of the real argument. |
1172 | if (!resultType || |
1173 | (type.category() == resultType->category() && |
1174 | type.kind() > resultType->kind()) || |
1175 | resultType->category() == TypeCategory::Integer) { |
1176 | resultType = type; |
1177 | resultTypeArg = &*args[j]; |
1178 | } |
1179 | } |
1180 | } |
1181 | if (!resultType) { // error recovery |
1182 | return Expr<T>{std::move(funcRef)}; |
1183 | } |
1184 | intrinsic.name = |
1185 | intrinsic.name.find("max") != std::string::npos ? "max"s: "min"s; |
1186 | intrinsic.characteristics.value().functionResult.value().SetType(*resultType); |
1187 | auto insertConversion{[&](const auto &x) -> Expr<T> { |
1188 | using TR = ResultType<decltype(x)>; |
1189 | FunctionRef<TR> maxRef{ |
1190 | ProcedureDesignator{funcRef.proc()}, ActualArguments{args}}; |
1191 | return Fold(context, ConvertToType<T>(AsCategoryExpr(std::move(maxRef)))); |
1192 | }}; |
1193 | if (auto *sx{UnwrapExpr<Expr<SomeReal>>(*resultTypeArg)}) { |
1194 | return common::visit(insertConversion, sx->u); |
1195 | } else if (auto *sx{UnwrapExpr<Expr<SomeInteger>>(*resultTypeArg)}) { |
1196 | return common::visit(insertConversion, sx->u); |
1197 | } else { |
1198 | return Expr<T>{std::move(funcRef)}; // error recovery |
1199 | } |
1200 | } |
1201 | |
1202 | // FoldIntrinsicFunction() |
1203 | template <int KIND> |
1204 | Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction( |
1205 | FoldingContext &context, FunctionRef<Type<TypeCategory::Integer, KIND>> &&); |
1206 | template <int KIND> |
1207 | Expr<Type<TypeCategory::Unsigned, KIND>> FoldIntrinsicFunction( |
1208 | FoldingContext &context, |
1209 | FunctionRef<Type<TypeCategory::Unsigned, KIND>> &&); |
1210 | template <int KIND> |
1211 | Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction( |
1212 | FoldingContext &context, FunctionRef<Type<TypeCategory::Real, KIND>> &&); |
1213 | template <int KIND> |
1214 | Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction( |
1215 | FoldingContext &context, FunctionRef<Type<TypeCategory::Complex, KIND>> &&); |
1216 | template <int KIND> |
1217 | Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction( |
1218 | FoldingContext &context, FunctionRef<Type<TypeCategory::Logical, KIND>> &&); |
1219 | |
1220 | template <typename T> |
1221 | Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) { |
1222 | ActualArguments &args{funcRef.arguments()}; |
1223 | const auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)}; |
1224 | if (!intrinsic || intrinsic->name != "kind") { |
1225 | // Don't fold the argument to KIND(); it might be a TypeParamInquiry |
1226 | // with a forced result type that doesn't match the parameter. |
1227 | for (std::optional<ActualArgument> &arg : args) { |
1228 | if (auto *expr{UnwrapExpr<Expr<SomeType>>(arg)}) { |
1229 | *expr = Fold(context, std::move(*expr)); |
1230 | } |
1231 | } |
1232 | } |
1233 | if (intrinsic) { |
1234 | const std::string name{intrinsic->name}; |
1235 | if (name == "cshift") { |
1236 | return Folder<T>{context}.CSHIFT(std::move(funcRef)); |
1237 | } else if (name == "eoshift") { |
1238 | return Folder<T>{context}.EOSHIFT(std::move(funcRef)); |
1239 | } else if (name == "merge") { |
1240 | return Folder<T>{context}.MERGE(std::move(funcRef)); |
1241 | } else if (name == "pack") { |
1242 | return Folder<T>{context}.PACK(std::move(funcRef)); |
1243 | } else if (name == "reshape") { |
1244 | return Folder<T>{context}.RESHAPE(std::move(funcRef)); |
1245 | } else if (name == "spread") { |
1246 | return Folder<T>{context}.SPREAD(std::move(funcRef)); |
1247 | } else if (name == "transfer") { |
1248 | return Folder<T>{context}.TRANSFER(std::move(funcRef)); |
1249 | } else if (name == "transpose") { |
1250 | return Folder<T>{context}.TRANSPOSE(std::move(funcRef)); |
1251 | } else if (name == "unpack") { |
1252 | return Folder<T>{context}.UNPACK(std::move(funcRef)); |
1253 | } |
1254 | // TODO: extends_type_of, same_type_as |
1255 | if constexpr (!std::is_same_v<T, SomeDerived>) { |
1256 | return FoldIntrinsicFunction(context, std::move(funcRef)); |
1257 | } |
1258 | } |
1259 | return Expr<T>{std::move(funcRef)}; |
1260 | } |
1261 | |
1262 | Expr<ImpliedDoIndex::Result> FoldOperation(FoldingContext &, ImpliedDoIndex &&); |
1263 | |
1264 | // Array constructor folding |
1265 | template <typename T> class ArrayConstructorFolder { |
1266 | public: |
1267 | explicit ArrayConstructorFolder(FoldingContext &c) : context_{c} {} |
1268 | |
1269 | Expr<T> FoldArray(ArrayConstructor<T> &&array) { |
1270 | if constexpr (T::category == TypeCategory::Character) { |
1271 | if (const auto *len{array.LEN()}) { |
1272 | charLength_ = ToInt64(Fold(context_, common::Clone(*len))); |
1273 | knownCharLength_ = charLength_.has_value(); |
1274 | } |
1275 | } |
1276 | // Calls FoldArray(const ArrayConstructorValues<T> &) below |
1277 | if (FoldArray(array)) { |
1278 | auto n{static_cast<ConstantSubscript>(elements_.size())}; |
1279 | if constexpr (std::is_same_v<T, SomeDerived>) { |
1280 | return Expr<T>{Constant<T>{array.GetType().GetDerivedTypeSpec(), |
1281 | std::move(elements_), ConstantSubscripts{n}}}; |
1282 | } else if constexpr (T::category == TypeCategory::Character) { |
1283 | if (charLength_) { |
1284 | return Expr<T>{Constant<T>{ |
1285 | *charLength_, std::move(elements_), ConstantSubscripts{n}}}; |
1286 | } |
1287 | } else { |
1288 | return Expr<T>{ |
1289 | Constant<T>{std::move(elements_), ConstantSubscripts{n}}}; |
1290 | } |
1291 | } |
1292 | return Expr<T>{std::move(array)}; |
1293 | } |
1294 | |
1295 | private: |
1296 | bool FoldArray(const Expr<T> &expr) { |
1297 | Expr<T> folded{Fold(context_, common::Clone(expr))}; |
1298 | if (const auto *c{UnwrapConstantValue<T>(folded)}) { |
1299 | // Copy elements in Fortran array element order |
1300 | if (!c->empty()) { |
1301 | ConstantSubscripts index{c->lbounds()}; |
1302 | do { |
1303 | elements_.emplace_back(c->At(index)); |
1304 | } while (c->IncrementSubscripts(index)); |
1305 | } |
1306 | if constexpr (T::category == TypeCategory::Character) { |
1307 | if (!knownCharLength_) { |
1308 | charLength_ = std::max(c->LEN(), charLength_.value_or(-1)); |
1309 | } |
1310 | } |
1311 | return true; |
1312 | } else { |
1313 | return false; |
1314 | } |
1315 | } |
1316 | bool FoldArray(const common::CopyableIndirection<Expr<T>> &expr) { |
1317 | return FoldArray(expr.value()); |
1318 | } |
1319 | bool FoldArray(const ImpliedDo<T> &iDo) { |
1320 | Expr<SubscriptInteger> lower{ |
1321 | Fold(context_, Expr<SubscriptInteger>{iDo.lower()})}; |
1322 | Expr<SubscriptInteger> upper{ |
1323 | Fold(context_, Expr<SubscriptInteger>{iDo.upper()})}; |
1324 | Expr<SubscriptInteger> stride{ |
1325 | Fold(context_, Expr<SubscriptInteger>{iDo.stride()})}; |
1326 | std::optional<ConstantSubscript> start{ToInt64(lower)}, end{ToInt64(upper)}, |
1327 | step{ToInt64(stride)}; |
1328 | if (start && end && step && *step != 0) { |
1329 | bool result{true}; |
1330 | ConstantSubscript &j{context_.StartImpliedDo(iDo.name(), *start)}; |
1331 | if (*step > 0) { |
1332 | for (; j <= *end; j += *step) { |
1333 | result &= FoldArray(iDo.values()); |
1334 | } |
1335 | } else { |
1336 | for (; j >= *end; j += *step) { |
1337 | result &= FoldArray(iDo.values()); |
1338 | } |
1339 | } |
1340 | context_.EndImpliedDo(iDo.name()); |
1341 | return result; |
1342 | } else { |
1343 | return false; |
1344 | } |
1345 | } |
1346 | bool FoldArray(const ArrayConstructorValue<T> &x) { |
1347 | return common::visit([&](const auto &y) { return FoldArray(y); }, x.u); |
1348 | } |
1349 | bool FoldArray(const ArrayConstructorValues<T> &xs) { |
1350 | for (const auto &x : xs) { |
1351 | if (!FoldArray(x)) { |
1352 | return false; |
1353 | } |
1354 | } |
1355 | return true; |
1356 | } |
1357 | |
1358 | FoldingContext &context_; |
1359 | std::vector<Scalar<T>> elements_; |
1360 | std::optional<ConstantSubscript> charLength_; |
1361 | bool knownCharLength_{false}; |
1362 | }; |
1363 | |
1364 | template <typename T> |
1365 | Expr<T> FoldOperation(FoldingContext &context, ArrayConstructor<T> &&array) { |
1366 | return ArrayConstructorFolder<T>{context}.FoldArray(std::move(array)); |
1367 | } |
1368 | |
1369 | // Array operation elemental application: When all operands to an operation |
1370 | // are constant arrays, array constructors without any implied DO loops, |
1371 | // &/or expanded scalars, pull the operation "into" the array result by |
1372 | // applying it in an elementwise fashion. For example, [A,1]+[B,2] |
1373 | // is rewritten into [A+B,1+2] and then partially folded to [A+B,3]. |
1374 | |
1375 | // If possible, restructures an array expression into an array constructor |
1376 | // that comprises a "flat" ArrayConstructorValues with no implied DO loops. |
1377 | template <typename T> |
1378 | bool ArrayConstructorIsFlat(const ArrayConstructorValues<T> &values) { |
1379 | for (const ArrayConstructorValue<T> &x : values) { |
1380 | if (!std::holds_alternative<Expr<T>>(x.u)) { |
1381 | return false; |
1382 | } |
1383 | } |
1384 | return true; |
1385 | } |
1386 | |
1387 | template <typename T> |
1388 | std::optional<Expr<T>> AsFlatArrayConstructor(const Expr<T> &expr) { |
1389 | if (const auto *c{UnwrapConstantValue<T>(expr)}) { |
1390 | ArrayConstructor<T> result{expr}; |
1391 | if (!c->empty()) { |
1392 | ConstantSubscripts at{c->lbounds()}; |
1393 | do { |
1394 | result.Push(Expr<T>{Constant<T>{c->At(at)}}); |
1395 | } while (c->IncrementSubscripts(at)); |
1396 | } |
1397 | return std::make_optional<Expr<T>>(std::move(result)); |
1398 | } else if (const auto *a{UnwrapExpr<ArrayConstructor<T>>(expr)}) { |
1399 | if (ArrayConstructorIsFlat(*a)) { |
1400 | return std::make_optional<Expr<T>>(expr); |
1401 | } |
1402 | } else if (const auto *p{UnwrapExpr<Parentheses<T>>(expr)}) { |
1403 | return AsFlatArrayConstructor(Expr<T>{p->left()}); |
1404 | } |
1405 | return std::nullopt; |
1406 | } |
1407 | |
1408 | template <TypeCategory CAT> |
1409 | std::enable_if_t<CAT != TypeCategory::Derived, |
1410 | std::optional<Expr<SomeKind<CAT>>>> |
1411 | AsFlatArrayConstructor(const Expr<SomeKind<CAT>> &expr) { |
1412 | return common::visit( |
1413 | [&](const auto &kindExpr) -> std::optional<Expr<SomeKind<CAT>>> { |
1414 | if (auto flattened{AsFlatArrayConstructor(kindExpr)}) { |
1415 | return Expr<SomeKind<CAT>>{std::move(*flattened)}; |
1416 | } else { |
1417 | return std::nullopt; |
1418 | } |
1419 | }, |
1420 | expr.u); |
1421 | } |
1422 | |
1423 | // FromArrayConstructor is a subroutine for MapOperation() below. |
1424 | // Given a flat ArrayConstructor<T> and a shape, it wraps the array |
1425 | // into an Expr<T>, folds it, and returns the resulting wrapped |
1426 | // array constructor or constant array value. |
1427 | template <typename T> |
1428 | std::optional<Expr<T>> FromArrayConstructor( |
1429 | FoldingContext &context, ArrayConstructor<T> &&values, const Shape &shape) { |
1430 | if (auto constShape{AsConstantExtents(context, shape)}; |
1431 | constShape && !HasNegativeExtent(*constShape)) { |
1432 | Expr<T> result{Fold(context, Expr<T>{std::move(values)})}; |
1433 | if (auto *constant{UnwrapConstantValue<T>(result)}) { |
1434 | // Elements and shape are both constant. |
1435 | return Expr<T>{constant->Reshape(std::move(*constShape))}; |
1436 | } |
1437 | if (constShape->size() == 1) { |
1438 | if (auto elements{GetShape(context, result)}) { |
1439 | if (auto constElements{AsConstantExtents(context, *elements)}) { |
1440 | if (constElements->size() == 1 && |
1441 | constElements->at(0) == constShape->at(0)) { |
1442 | // Elements are not constant, but array constructor has |
1443 | // the right known shape and can be simply returned as is. |
1444 | return std::move(result); |
1445 | } |
1446 | } |
1447 | } |
1448 | } |
1449 | } |
1450 | return std::nullopt; |
1451 | } |
1452 | |
1453 | // MapOperation is a utility for various specializations of ApplyElementwise() |
1454 | // that follow. Given one or two flat ArrayConstructor<OPERAND> (wrapped in an |
1455 | // Expr<OPERAND>) for some specific operand type(s), apply a given function f |
1456 | // to each of their corresponding elements to produce a flat |
1457 | // ArrayConstructor<RESULT> (wrapped in an Expr<RESULT>). |
1458 | // Preserves shape. |
1459 | |
1460 | // Unary case |
1461 | template <typename RESULT, typename OPERAND> |
1462 | std::optional<Expr<RESULT>> MapOperation(FoldingContext &context, |
1463 | std::function<Expr<RESULT>(Expr<OPERAND> &&)> &&f, const Shape &shape, |
1464 | [[maybe_unused]] std::optional<Expr<SubscriptInteger>> &&length, |
1465 | Expr<OPERAND> &&values) { |
1466 | ArrayConstructor<RESULT> result{values}; |
1467 | if constexpr (common::HasMember<OPERAND, AllIntrinsicCategoryTypes>) { |
1468 | common::visit( |
1469 | [&](auto &&kindExpr) { |
1470 | using kindType = ResultType<decltype(kindExpr)>; |
1471 | auto &aConst{std::get<ArrayConstructor<kindType>>(kindExpr.u)}; |
1472 | for (auto &acValue : aConst) { |
1473 | auto &scalar{std::get<Expr<kindType>>(acValue.u)}; |
1474 | result.Push(Fold(context, f(Expr<OPERAND>{std::move(scalar)}))); |
1475 | } |
1476 | }, |
1477 | std::move(values.u)); |
1478 | } else { |
1479 | auto &aConst{std::get<ArrayConstructor<OPERAND>>(values.u)}; |
1480 | for (auto &acValue : aConst) { |
1481 | auto &scalar{std::get<Expr<OPERAND>>(acValue.u)}; |
1482 | result.Push(Fold(context, f(std::move(scalar)))); |
1483 | } |
1484 | } |
1485 | if constexpr (RESULT::category == TypeCategory::Character) { |
1486 | if (length) { |
1487 | result.set_LEN(std::move(*length)); |
1488 | } |
1489 | } |
1490 | return FromArrayConstructor(context, std::move(result), shape); |
1491 | } |
1492 | |
1493 | template <typename RESULT, typename A> |
1494 | ArrayConstructor<RESULT> ArrayConstructorFromMold( |
1495 | const A &prototype, std::optional<Expr<SubscriptInteger>> &&length) { |
1496 | ArrayConstructor<RESULT> result{prototype}; |
1497 | if constexpr (RESULT::category == TypeCategory::Character) { |
1498 | if (length) { |
1499 | result.set_LEN(std::move(*length)); |
1500 | } |
1501 | } |
1502 | return result; |
1503 | } |
1504 | |
1505 | template <typename LEFT, typename RIGHT> |
1506 | bool ShapesMatch(FoldingContext &context, |
1507 | const ArrayConstructor<LEFT> &leftArrConst, |
1508 | const ArrayConstructor<RIGHT> &rightArrConst) { |
1509 | auto rightIter{rightArrConst.begin()}; |
1510 | for (auto &leftValue : leftArrConst) { |
1511 | CHECK(rightIter != rightArrConst.end()); |
1512 | auto &leftExpr{std::get<Expr<LEFT>>(leftValue.u)}; |
1513 | auto &rightExpr{std::get<Expr<RIGHT>>(rightIter->u)}; |
1514 | if (leftExpr.Rank() != rightExpr.Rank()) { |
1515 | return false; |
1516 | } |
1517 | std::optional<Shape> leftShape{GetShape(context, leftExpr)}; |
1518 | std::optional<Shape> rightShape{GetShape(context, rightExpr)}; |
1519 | if (!leftShape || !rightShape || *leftShape != *rightShape) { |
1520 | return false; |
1521 | } |
1522 | ++rightIter; |
1523 | } |
1524 | return true; |
1525 | } |
1526 | |
1527 | // array * array case |
1528 | template <typename RESULT, typename LEFT, typename RIGHT> |
1529 | auto MapOperation(FoldingContext &context, |
1530 | std::function<Expr<RESULT>(Expr<LEFT> &&, Expr<RIGHT> &&)> &&f, |
1531 | const Shape &shape, std::optional<Expr<SubscriptInteger>> &&length, |
1532 | Expr<LEFT> &&leftValues, Expr<RIGHT> &&rightValues) |
1533 | -> std::optional<Expr<RESULT>> { |
1534 | auto result{ArrayConstructorFromMold<RESULT>(leftValues, std::move(length))}; |
1535 | auto &leftArrConst{std::get<ArrayConstructor<LEFT>>(leftValues.u)}; |
1536 | if constexpr (common::HasMember<RIGHT, AllIntrinsicCategoryTypes>) { |
1537 | bool mapped{common::visit( |
1538 | [&](auto &&kindExpr) -> bool { |
1539 | using kindType = ResultType<decltype(kindExpr)>; |
1540 | |
1541 | auto &rightArrConst{std::get<ArrayConstructor<kindType>>(kindExpr.u)}; |
1542 | if (!ShapesMatch(context, leftArrConst, rightArrConst)) { |
1543 | return false; |
1544 | } |
1545 | auto rightIter{rightArrConst.begin()}; |
1546 | for (auto &leftValue : leftArrConst) { |
1547 | CHECK(rightIter != rightArrConst.end()); |
1548 | auto &leftScalar{std::get<Expr<LEFT>>(leftValue.u)}; |
1549 | auto &rightScalar{std::get<Expr<kindType>>(rightIter->u)}; |
1550 | result.Push(Fold(context, |
1551 | f(std::move(leftScalar), Expr<RIGHT>{std::move(rightScalar)}))); |
1552 | ++rightIter; |
1553 | } |
1554 | return true; |
1555 | }, |
1556 | std::move(rightValues.u))}; |
1557 | if (!mapped) { |
1558 | return std::nullopt; |
1559 | } |
1560 | } else { |
1561 | auto &rightArrConst{std::get<ArrayConstructor<RIGHT>>(rightValues.u)}; |
1562 | if (!ShapesMatch(context, leftArrConst, rightArrConst)) { |
1563 | return std::nullopt; |
1564 | } |
1565 | auto rightIter{rightArrConst.begin()}; |
1566 | for (auto &leftValue : leftArrConst) { |
1567 | CHECK(rightIter != rightArrConst.end()); |
1568 | auto &leftScalar{std::get<Expr<LEFT>>(leftValue.u)}; |
1569 | auto &rightScalar{std::get<Expr<RIGHT>>(rightIter->u)}; |
1570 | result.Push( |
1571 | Fold(context, f(std::move(leftScalar), std::move(rightScalar)))); |
1572 | ++rightIter; |
1573 | } |
1574 | } |
1575 | return FromArrayConstructor(context, std::move(result), shape); |
1576 | } |
1577 | |
1578 | // array * scalar case |
1579 | template <typename RESULT, typename LEFT, typename RIGHT> |
1580 | auto MapOperation(FoldingContext &context, |
1581 | std::function<Expr<RESULT>(Expr<LEFT> &&, Expr<RIGHT> &&)> &&f, |
1582 | const Shape &shape, std::optional<Expr<SubscriptInteger>> &&length, |
1583 | Expr<LEFT> &&leftValues, const Expr<RIGHT> &rightScalar) |
1584 | -> std::optional<Expr<RESULT>> { |
1585 | auto result{ArrayConstructorFromMold<RESULT>(leftValues, std::move(length))}; |
1586 | auto &leftArrConst{std::get<ArrayConstructor<LEFT>>(leftValues.u)}; |
1587 | for (auto &leftValue : leftArrConst) { |
1588 | auto &leftScalar{std::get<Expr<LEFT>>(leftValue.u)}; |
1589 | result.Push( |
1590 | Fold(context, f(std::move(leftScalar), Expr<RIGHT>{rightScalar}))); |
1591 | } |
1592 | return FromArrayConstructor(context, std::move(result), shape); |
1593 | } |
1594 | |
1595 | // scalar * array case |
1596 | template <typename RESULT, typename LEFT, typename RIGHT> |
1597 | auto MapOperation(FoldingContext &context, |
1598 | std::function<Expr<RESULT>(Expr<LEFT> &&, Expr<RIGHT> &&)> &&f, |
1599 | const Shape &shape, std::optional<Expr<SubscriptInteger>> &&length, |
1600 | const Expr<LEFT> &leftScalar, Expr<RIGHT> &&rightValues) |
1601 | -> std::optional<Expr<RESULT>> { |
1602 | auto result{ArrayConstructorFromMold<RESULT>(leftScalar, std::move(length))}; |
1603 | if constexpr (common::HasMember<RIGHT, AllIntrinsicCategoryTypes>) { |
1604 | common::visit( |
1605 | [&](auto &&kindExpr) { |
1606 | using kindType = ResultType<decltype(kindExpr)>; |
1607 | auto &rightArrConst{std::get<ArrayConstructor<kindType>>(kindExpr.u)}; |
1608 | for (auto &rightValue : rightArrConst) { |
1609 | auto &rightScalar{std::get<Expr<kindType>>(rightValue.u)}; |
1610 | result.Push(Fold(context, |
1611 | f(Expr<LEFT>{leftScalar}, |
1612 | Expr<RIGHT>{std::move(rightScalar)}))); |
1613 | } |
1614 | }, |
1615 | std::move(rightValues.u)); |
1616 | } else { |
1617 | auto &rightArrConst{std::get<ArrayConstructor<RIGHT>>(rightValues.u)}; |
1618 | for (auto &rightValue : rightArrConst) { |
1619 | auto &rightScalar{std::get<Expr<RIGHT>>(rightValue.u)}; |
1620 | result.Push( |
1621 | Fold(context, f(Expr<LEFT>{leftScalar}, std::move(rightScalar)))); |
1622 | } |
1623 | } |
1624 | return FromArrayConstructor(context, std::move(result), shape); |
1625 | } |
1626 | |
1627 | template <typename DERIVED, typename RESULT, typename... OPD> |
1628 | std::optional<Expr<SubscriptInteger>> ComputeResultLength( |
1629 | Operation<DERIVED, RESULT, OPD...> &operation) { |
1630 | if constexpr (RESULT::category == TypeCategory::Character) { |
1631 | return Expr<RESULT>{operation.derived()}.LEN(); |
1632 | } |
1633 | return std::nullopt; |
1634 | } |
1635 | |
1636 | // ApplyElementwise() recursively folds the operand expression(s) of an |
1637 | // operation, then attempts to apply the operation to the (corresponding) |
1638 | // scalar element(s) of those operands. Returns std::nullopt for scalars |
1639 | // or unlinearizable operands. |
1640 | template <typename DERIVED, typename RESULT, typename OPERAND> |
1641 | auto ApplyElementwise(FoldingContext &context, |
1642 | Operation<DERIVED, RESULT, OPERAND> &operation, |
1643 | std::function<Expr<RESULT>(Expr<OPERAND> &&)> &&f) |
1644 | -> std::optional<Expr<RESULT>> { |
1645 | auto &expr{operation.left()}; |
1646 | expr = Fold(context, std::move(expr)); |
1647 | if (expr.Rank() > 0) { |
1648 | if (std::optional<Shape> shape{GetShape(context, expr)}) { |
1649 | if (auto values{AsFlatArrayConstructor(expr)}) { |
1650 | return MapOperation(context, std::move(f), *shape, |
1651 | ComputeResultLength(operation), std::move(*values)); |
1652 | } |
1653 | } |
1654 | } |
1655 | return std::nullopt; |
1656 | } |
1657 | |
1658 | template <typename DERIVED, typename RESULT, typename OPERAND> |
1659 | auto ApplyElementwise( |
1660 | FoldingContext &context, Operation<DERIVED, RESULT, OPERAND> &operation) |
1661 | -> std::optional<Expr<RESULT>> { |
1662 | return ApplyElementwise(context, operation, |
1663 | std::function<Expr<RESULT>(Expr<OPERAND> &&)>{ |
1664 | [](Expr<OPERAND> &&operand) { |
1665 | return Expr<RESULT>{DERIVED{std::move(operand)}}; |
1666 | }}); |
1667 | } |
1668 | |
1669 | template <typename DERIVED, typename RESULT, typename LEFT, typename RIGHT> |
1670 | auto ApplyElementwise(FoldingContext &context, |
1671 | Operation<DERIVED, RESULT, LEFT, RIGHT> &operation, |
1672 | std::function<Expr<RESULT>(Expr<LEFT> &&, Expr<RIGHT> &&)> &&f) |
1673 | -> std::optional<Expr<RESULT>> { |
1674 | auto resultLength{ComputeResultLength(operation)}; |
1675 | auto &leftExpr{operation.left()}; |
1676 | auto &rightExpr{operation.right()}; |
1677 | if (leftExpr.Rank() != rightExpr.Rank() && leftExpr.Rank() != 0 && |
1678 | rightExpr.Rank() != 0) { |
1679 | return std::nullopt; // error recovery |
1680 | } |
1681 | leftExpr = Fold(context, std::move(leftExpr)); |
1682 | rightExpr = Fold(context, std::move(rightExpr)); |
1683 | if (leftExpr.Rank() > 0) { |
1684 | if (std::optional<Shape> leftShape{GetShape(context, leftExpr)}) { |
1685 | if (auto left{AsFlatArrayConstructor(leftExpr)}) { |
1686 | if (rightExpr.Rank() > 0) { |
1687 | if (std::optional<Shape> rightShape{GetShape(context, rightExpr)}) { |
1688 | if (auto right{AsFlatArrayConstructor(rightExpr)}) { |
1689 | if (CheckConformance(context.messages(), *leftShape, *rightShape, |
1690 | CheckConformanceFlags::EitherScalarExpandable) |
1691 | .value_or(false /*fail if not known now to conform*/)) { |
1692 | return MapOperation(context, std::move(f), *leftShape, |
1693 | std::move(resultLength), std::move(*left), |
1694 | std::move(*right)); |
1695 | } else { |
1696 | return std::nullopt; |
1697 | } |
1698 | return MapOperation(context, std::move(f), *leftShape, |
1699 | std::move(resultLength), std::move(*left), std::move(*right)); |
1700 | } |
1701 | } |
1702 | } else if (IsExpandableScalar(rightExpr, context, *leftShape)) { |
1703 | return MapOperation(context, std::move(f), *leftShape, |
1704 | std::move(resultLength), std::move(*left), rightExpr); |
1705 | } |
1706 | } |
1707 | } |
1708 | } else if (rightExpr.Rank() > 0) { |
1709 | if (std::optional<Shape> rightShape{GetShape(context, rightExpr)}) { |
1710 | if (IsExpandableScalar(leftExpr, context, *rightShape)) { |
1711 | if (auto right{AsFlatArrayConstructor(rightExpr)}) { |
1712 | return MapOperation(context, std::move(f), *rightShape, |
1713 | std::move(resultLength), leftExpr, std::move(*right)); |
1714 | } |
1715 | } |
1716 | } |
1717 | } |
1718 | return std::nullopt; |
1719 | } |
1720 | |
1721 | template <typename DERIVED, typename RESULT, typename LEFT, typename RIGHT> |
1722 | auto ApplyElementwise( |
1723 | FoldingContext &context, Operation<DERIVED, RESULT, LEFT, RIGHT> &operation) |
1724 | -> std::optional<Expr<RESULT>> { |
1725 | return ApplyElementwise(context, operation, |
1726 | std::function<Expr<RESULT>(Expr<LEFT> &&, Expr<RIGHT> &&)>{ |
1727 | [](Expr<LEFT> &&left, Expr<RIGHT> &&right) { |
1728 | return Expr<RESULT>{DERIVED{std::move(left), std::move(right)}}; |
1729 | }}); |
1730 | } |
1731 | |
1732 | // Unary operations |
1733 | |
1734 | template <typename TO, typename FROM> |
1735 | common::IfNoLvalue<std::optional<TO>, FROM> ConvertString(FROM &&s) { |
1736 | if constexpr (std::is_same_v<TO, FROM>) { |
1737 | return std::make_optional<TO>(std::move(s)); |
1738 | } else { |
1739 | // Fortran character conversion is well defined between distinct kinds |
1740 | // only when the actual characters are valid 7-bit ASCII. |
1741 | TO str; |
1742 | for (auto iter{s.cbegin()}; iter != s.cend(); ++iter) { |
1743 | if (static_cast<std::uint64_t>(*iter) > 127) { |
1744 | return std::nullopt; |
1745 | } |
1746 | str.push_back(*iter); |
1747 | } |
1748 | return std::make_optional<TO>(std::move(str)); |
1749 | } |
1750 | } |
1751 | |
1752 | template <typename TO, TypeCategory FROMCAT> |
1753 | Expr<TO> FoldOperation( |
1754 | FoldingContext &context, Convert<TO, FROMCAT> &&convert) { |
1755 | if (auto array{ApplyElementwise(context, convert)}) { |
1756 | return *array; |
1757 | } |
1758 | struct { |
1759 | FoldingContext &context; |
1760 | Convert<TO, FROMCAT> &convert; |
1761 | } msvcWorkaround{context, convert}; |
1762 | return common::visit( |
1763 | [&msvcWorkaround](auto &kindExpr) -> Expr<TO> { |
1764 | using Operand = ResultType<decltype(kindExpr)>; |
1765 | // This variable is a workaround for msvc which emits an error when |
1766 | // using the FROMCAT template parameter below. |
1767 | TypeCategory constexpr FromCat{FROMCAT}; |
1768 | static_assert(FromCat == Operand::category); |
1769 | auto &convert{msvcWorkaround.convert}; |
1770 | if (auto value{GetScalarConstantValue<Operand>(kindExpr)}) { |
1771 | FoldingContext &ctx{msvcWorkaround.context}; |
1772 | if constexpr (TO::category == TypeCategory::Integer) { |
1773 | if constexpr (FromCat == TypeCategory::Integer) { |
1774 | auto converted{Scalar<TO>::ConvertSigned(*value)}; |
1775 | if (converted.overflow && |
1776 | msvcWorkaround.context.languageFeatures().ShouldWarn( |
1777 | common::UsageWarning::FoldingException)) { |
1778 | ctx.messages().Say(common::UsageWarning::FoldingException, |
1779 | "conversion of %s_%d to INTEGER(%d) overflowed; result is %s"_warn_en_US, |
1780 | value->SignedDecimal(), Operand::kind, TO::kind, |
1781 | converted.value.SignedDecimal()); |
1782 | } |
1783 | return ScalarConstantToExpr(std::move(converted.value)); |
1784 | } else if constexpr (FromCat == TypeCategory::Unsigned) { |
1785 | auto converted{Scalar<TO>::ConvertUnsigned(*value)}; |
1786 | if ((converted.overflow || converted.value.IsNegative()) && |
1787 | msvcWorkaround.context.languageFeatures().ShouldWarn( |
1788 | common::UsageWarning::FoldingException)) { |
1789 | ctx.messages().Say(common::UsageWarning::FoldingException, |
1790 | "conversion of %s_U%d to INTEGER(%d) overflowed; result is %s"_warn_en_US, |
1791 | value->UnsignedDecimal(), Operand::kind, TO::kind, |
1792 | converted.value.SignedDecimal()); |
1793 | } |
1794 | return ScalarConstantToExpr(std::move(converted.value)); |
1795 | } else if constexpr (FromCat == TypeCategory::Real) { |
1796 | auto converted{value->template ToInteger<Scalar<TO>>()}; |
1797 | if (msvcWorkaround.context.languageFeatures().ShouldWarn( |
1798 | common::UsageWarning::FoldingException)) { |
1799 | if (converted.flags.test(RealFlag::InvalidArgument)) { |
1800 | ctx.messages().Say(common::UsageWarning::FoldingException, |
1801 | "REAL(%d) to INTEGER(%d) conversion: invalid argument"_warn_en_US, |
1802 | Operand::kind, TO::kind); |
1803 | } else if (converted.flags.test(RealFlag::Overflow)) { |
1804 | ctx.messages().Say( |
1805 | "REAL(%d) to INTEGER(%d) conversion overflowed"_warn_en_US, |
1806 | Operand::kind, TO::kind); |
1807 | } |
1808 | } |
1809 | return ScalarConstantToExpr(std::move(converted.value)); |
1810 | } |
1811 | } else if constexpr (TO::category == TypeCategory::Unsigned) { |
1812 | if constexpr (FromCat == TypeCategory::Integer || |
1813 | FromCat == TypeCategory::Unsigned) { |
1814 | return Expr<TO>{ |
1815 | Constant<TO>{Scalar<TO>::ConvertUnsigned(*value).value}}; |
1816 | } else if constexpr (FromCat == TypeCategory::Real) { |
1817 | return Expr<TO>{ |
1818 | Constant<TO>{value->template ToInteger<Scalar<TO>>().value}}; |
1819 | } |
1820 | } else if constexpr (TO::category == TypeCategory::Real) { |
1821 | if constexpr (FromCat == TypeCategory::Integer || |
1822 | FromCat == TypeCategory::Unsigned) { |
1823 | auto converted{Scalar<TO>::FromInteger( |
1824 | *value, FromCat == TypeCategory::Unsigned)}; |
1825 | if (!converted.flags.empty()) { |
1826 | char buffer[64]; |
1827 | std::snprintf(buffer, sizeof buffer, |
1828 | "INTEGER(%d) to REAL(%d) conversion", Operand::kind, |
1829 | TO::kind); |
1830 | RealFlagWarnings(ctx, converted.flags, buffer); |
1831 | } |
1832 | return ScalarConstantToExpr(std::move(converted.value)); |
1833 | } else if constexpr (FromCat == TypeCategory::Real) { |
1834 | auto converted{Scalar<TO>::Convert(*value)}; |
1835 | char buffer[64]; |
1836 | if (!converted.flags.empty()) { |
1837 | std::snprintf(buffer, sizeof buffer, |
1838 | "REAL(%d) to REAL(%d) conversion", Operand::kind, TO::kind); |
1839 | RealFlagWarnings(ctx, converted.flags, buffer); |
1840 | } |
1841 | if (ctx.targetCharacteristics().areSubnormalsFlushedToZero()) { |
1842 | converted.value = converted.value.FlushSubnormalToZero(); |
1843 | } |
1844 | return ScalarConstantToExpr(std::move(converted.value)); |
1845 | } |
1846 | } else if constexpr (TO::category == TypeCategory::Complex) { |
1847 | if constexpr (FromCat == TypeCategory::Complex) { |
1848 | return FoldOperation(ctx, |
1849 | ComplexConstructor<TO::kind>{ |
1850 | AsExpr(Convert<typename TO::Part>{AsCategoryExpr( |
1851 | Constant<typename Operand::Part>{value->REAL()})}), |
1852 | AsExpr(Convert<typename TO::Part>{AsCategoryExpr( |
1853 | Constant<typename Operand::Part>{value->AIMAG()})})}); |
1854 | } |
1855 | } else if constexpr (TO::category == TypeCategory::Character && |
1856 | FromCat == TypeCategory::Character) { |
1857 | if (auto converted{ConvertString<Scalar<TO>>(std::move(*value))}) { |
1858 | return ScalarConstantToExpr(std::move(*converted)); |
1859 | } |
1860 | } else if constexpr (TO::category == TypeCategory::Logical && |
1861 | FromCat == TypeCategory::Logical) { |
1862 | return Expr<TO>{value->IsTrue()}; |
1863 | } |
1864 | } else if constexpr (TO::category == FromCat && |
1865 | FromCat != TypeCategory::Character) { |
1866 | // Conversion of non-constant in same type category |
1867 | if constexpr (std::is_same_v<Operand, TO>) { |
1868 | return std::move(kindExpr); // remove needless conversion |
1869 | } else if constexpr (TO::category == TypeCategory::Logical || |
1870 | TO::category == TypeCategory::Integer) { |
1871 | if (auto *innerConv{ |
1872 | std::get_if<Convert<Operand, TO::category>>(&kindExpr.u)}) { |
1873 | // Conversion of conversion of same category & kind |
1874 | if (auto *x{std::get_if<Expr<TO>>(&innerConv->left().u)}) { |
1875 | if constexpr (TO::category == TypeCategory::Logical || |
1876 | TO::kind <= Operand::kind) { |
1877 | return std::move(*x); // no-op Logical or Integer |
1878 | // widening/narrowing conversion pair |
1879 | } else if constexpr (std::is_same_v<TO, |
1880 | DescriptorInquiry::Result>) { |
1881 | if (std::holds_alternative<DescriptorInquiry>(x->u) || |
1882 | std::holds_alternative<TypeParamInquiry>(x->u)) { |
1883 | // int(int(size(...),kind=k),kind=8) -> size(...) |
1884 | return std::move(*x); |
1885 | } |
1886 | } |
1887 | } |
1888 | } |
1889 | } |
1890 | } |
1891 | return Expr<TO>{std::move(convert)}; |
1892 | }, |
1893 | convert.left().u); |
1894 | } |
1895 | |
1896 | template <typename T> |
1897 | Expr<T> FoldOperation(FoldingContext &context, Parentheses<T> &&x) { |
1898 | auto &operand{x.left()}; |
1899 | operand = Fold(context, std::move(operand)); |
1900 | if (auto value{GetScalarConstantValue<T>(operand)}) { |
1901 | // Preserve parentheses, even around constants. |
1902 | return Expr<T>{Parentheses<T>{Expr<T>{Constant<T>{*value}}}}; |
1903 | } else if (std::holds_alternative<Parentheses<T>>(operand.u)) { |
1904 | // ((x)) -> (x) |
1905 | return std::move(operand); |
1906 | } else { |
1907 | return Expr<T>{Parentheses<T>{std::move(operand)}}; |
1908 | } |
1909 | } |
1910 | |
1911 | template <typename T> |
1912 | Expr<T> FoldOperation(FoldingContext &context, Negate<T> &&x) { |
1913 | if (auto array{ApplyElementwise(context, x)}) { |
1914 | return *array; |
1915 | } |
1916 | auto &operand{x.left()}; |
1917 | if (auto *nn{std::get_if<Negate<T>>(&x.left().u)}) { |
1918 | // -(-x) -> (x) |
1919 | if (IsVariable(nn->left())) { |
1920 | return FoldOperation(context, Parentheses<T>{std::move(nn->left())}); |
1921 | } else { |
1922 | return std::move(nn->left()); |
1923 | } |
1924 | } else if (auto value{GetScalarConstantValue<T>(operand)}) { |
1925 | if constexpr (T::category == TypeCategory::Integer) { |
1926 | auto negated{value->Negate()}; |
1927 | if (negated.overflow && |
1928 | context.languageFeatures().ShouldWarn( |
1929 | common::UsageWarning::FoldingException)) { |
1930 | context.messages().Say(common::UsageWarning::FoldingException, |
1931 | "INTEGER(%d) negation overflowed"_warn_en_US, T::kind); |
1932 | } |
1933 | return Expr<T>{Constant<T>{std::move(negated.value)}}; |
1934 | } else if constexpr (T::category == TypeCategory::Unsigned) { |
1935 | return Expr<T>{Constant<T>{std::move(value->Negate().value)}}; |
1936 | } else { |
1937 | // REAL & COMPLEX negation: no exceptions possible |
1938 | return Expr<T>{Constant<T>{value->Negate()}}; |
1939 | } |
1940 | } |
1941 | return Expr<T>{std::move(x)}; |
1942 | } |
1943 | |
1944 | // Binary (dyadic) operations |
1945 | |
1946 | template <typename LEFT, typename RIGHT> |
1947 | std::optional<std::pair<Scalar<LEFT>, Scalar<RIGHT>>> OperandsAreConstants( |
1948 | const Expr<LEFT> &x, const Expr<RIGHT> &y) { |
1949 | if (auto xvalue{GetScalarConstantValue<LEFT>(x)}) { |
1950 | if (auto yvalue{GetScalarConstantValue<RIGHT>(y)}) { |
1951 | return {std::make_pair(*xvalue, *yvalue)}; |
1952 | } |
1953 | } |
1954 | return std::nullopt; |
1955 | } |
1956 | |
1957 | template <typename DERIVED, typename RESULT, typename LEFT, typename RIGHT> |
1958 | std::optional<std::pair<Scalar<LEFT>, Scalar<RIGHT>>> OperandsAreConstants( |
1959 | const Operation<DERIVED, RESULT, LEFT, RIGHT> &operation) { |
1960 | return OperandsAreConstants(operation.left(), operation.right()); |
1961 | } |
1962 | |
1963 | template <typename T> |
1964 | Expr<T> FoldOperation(FoldingContext &context, Add<T> &&x) { |
1965 | if (auto array{ApplyElementwise(context, x)}) { |
1966 | return *array; |
1967 | } |
1968 | if (auto folded{OperandsAreConstants(x)}) { |
1969 | if constexpr (T::category == TypeCategory::Integer) { |
1970 | auto sum{folded->first.AddSigned(folded->second)}; |
1971 | if (sum.overflow && |
1972 | context.languageFeatures().ShouldWarn( |
1973 | common::UsageWarning::FoldingException)) { |
1974 | context.messages().Say(common::UsageWarning::FoldingException, |
1975 | "INTEGER(%d) addition overflowed"_warn_en_US, T::kind); |
1976 | } |
1977 | return Expr<T>{Constant<T>{sum.value}}; |
1978 | } else if constexpr (T::category == TypeCategory::Unsigned) { |
1979 | return Expr<T>{ |
1980 | Constant<T>{folded->first.AddUnsigned(folded->second).value}}; |
1981 | } else { |
1982 | auto sum{folded->first.Add( |
1983 | folded->second, context.targetCharacteristics().roundingMode())}; |
1984 | RealFlagWarnings(context, sum.flags, "addition"); |
1985 | if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { |
1986 | sum.value = sum.value.FlushSubnormalToZero(); |
1987 | } |
1988 | return Expr<T>{Constant<T>{sum.value}}; |
1989 | } |
1990 | } |
1991 | return Expr<T>{std::move(x)}; |
1992 | } |
1993 | |
1994 | template <typename T> |
1995 | Expr<T> FoldOperation(FoldingContext &context, Subtract<T> &&x) { |
1996 | if (auto array{ApplyElementwise(context, x)}) { |
1997 | return *array; |
1998 | } |
1999 | if (auto folded{OperandsAreConstants(x)}) { |
2000 | if constexpr (T::category == TypeCategory::Integer) { |
2001 | auto difference{folded->first.SubtractSigned(folded->second)}; |
2002 | if (difference.overflow && |
2003 | context.languageFeatures().ShouldWarn( |
2004 | common::UsageWarning::FoldingException)) { |
2005 | context.messages().Say(common::UsageWarning::FoldingException, |
2006 | "INTEGER(%d) subtraction overflowed"_warn_en_US, T::kind); |
2007 | } |
2008 | return Expr<T>{Constant<T>{difference.value}}; |
2009 | } else if constexpr (T::category == TypeCategory::Unsigned) { |
2010 | return Expr<T>{ |
2011 | Constant<T>{folded->first.SubtractSigned(folded->second).value}}; |
2012 | } else { |
2013 | auto difference{folded->first.Subtract( |
2014 | folded->second, context.targetCharacteristics().roundingMode())}; |
2015 | RealFlagWarnings(context, difference.flags, "subtraction"); |
2016 | if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { |
2017 | difference.value = difference.value.FlushSubnormalToZero(); |
2018 | } |
2019 | return Expr<T>{Constant<T>{difference.value}}; |
2020 | } |
2021 | } |
2022 | return Expr<T>{std::move(x)}; |
2023 | } |
2024 | |
2025 | template <typename T> |
2026 | Expr<T> FoldOperation(FoldingContext &context, Multiply<T> &&x) { |
2027 | if (auto array{ApplyElementwise(context, x)}) { |
2028 | return *array; |
2029 | } |
2030 | if (auto folded{OperandsAreConstants(x)}) { |
2031 | if constexpr (T::category == TypeCategory::Integer) { |
2032 | auto product{folded->first.MultiplySigned(folded->second)}; |
2033 | if (product.SignedMultiplicationOverflowed() && |
2034 | context.languageFeatures().ShouldWarn( |
2035 | common::UsageWarning::FoldingException)) { |
2036 | context.messages().Say(common::UsageWarning::FoldingException, |
2037 | "INTEGER(%d) multiplication overflowed"_warn_en_US, T::kind); |
2038 | } |
2039 | return Expr<T>{Constant<T>{product.lower}}; |
2040 | } else if constexpr (T::category == TypeCategory::Unsigned) { |
2041 | return Expr<T>{ |
2042 | Constant<T>{folded->first.MultiplyUnsigned(folded->second).lower}}; |
2043 | } else { |
2044 | auto product{folded->first.Multiply( |
2045 | folded->second, context.targetCharacteristics().roundingMode())}; |
2046 | RealFlagWarnings(context, product.flags, "multiplication"); |
2047 | if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { |
2048 | product.value = product.value.FlushSubnormalToZero(); |
2049 | } |
2050 | return Expr<T>{Constant<T>{product.value}}; |
2051 | } |
2052 | } else if constexpr (T::category == TypeCategory::Integer) { |
2053 | if (auto c{GetScalarConstantValue<T>(x.right())}) { |
2054 | x.right() = std::move(x.left()); |
2055 | x.left() = Expr<T>{std::move(*c)}; |
2056 | } |
2057 | if (auto c{GetScalarConstantValue<T>(x.left())}) { |
2058 | if (c->IsZero() && x.right().Rank() == 0) { |
2059 | return std::move(x.left()); |
2060 | } else if (c->CompareSigned(Scalar<T>{1}) == Ordering::Equal) { |
2061 | if (IsVariable(x.right())) { |
2062 | return FoldOperation(context, Parentheses<T>{std::move(x.right())}); |
2063 | } else { |
2064 | return std::move(x.right()); |
2065 | } |
2066 | } else if (c->CompareSigned(Scalar<T>{-1}) == Ordering::Equal) { |
2067 | return FoldOperation(context, Negate<T>{std::move(x.right())}); |
2068 | } |
2069 | } |
2070 | } |
2071 | return Expr<T>{std::move(x)}; |
2072 | } |
2073 | |
2074 | template <typename T> |
2075 | Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&x) { |
2076 | if (auto array{ApplyElementwise(context, x)}) { |
2077 | return *array; |
2078 | } |
2079 | if (auto folded{OperandsAreConstants(x)}) { |
2080 | if constexpr (T::category == TypeCategory::Integer) { |
2081 | auto quotAndRem{folded->first.DivideSigned(folded->second)}; |
2082 | if (quotAndRem.divisionByZero) { |
2083 | if (context.languageFeatures().ShouldWarn( |
2084 | common::UsageWarning::FoldingException)) { |
2085 | context.messages().Say(common::UsageWarning::FoldingException, |
2086 | "INTEGER(%d) division by zero"_warn_en_US, T::kind); |
2087 | } |
2088 | return Expr<T>{std::move(x)}; |
2089 | } |
2090 | if (quotAndRem.overflow && |
2091 | context.languageFeatures().ShouldWarn( |
2092 | common::UsageWarning::FoldingException)) { |
2093 | context.messages().Say(common::UsageWarning::FoldingException, |
2094 | "INTEGER(%d) division overflowed"_warn_en_US, T::kind); |
2095 | } |
2096 | return Expr<T>{Constant<T>{quotAndRem.quotient}}; |
2097 | } else if constexpr (T::category == TypeCategory::Unsigned) { |
2098 | auto quotAndRem{folded->first.DivideUnsigned(folded->second)}; |
2099 | if (quotAndRem.divisionByZero) { |
2100 | if (context.languageFeatures().ShouldWarn( |
2101 | common::UsageWarning::FoldingException)) { |
2102 | context.messages().Say(common::UsageWarning::FoldingException, |
2103 | "UNSIGNED(%d) division by zero"_warn_en_US, T::kind); |
2104 | } |
2105 | return Expr<T>{std::move(x)}; |
2106 | } |
2107 | return Expr<T>{Constant<T>{quotAndRem.quotient}}; |
2108 | } else { |
2109 | auto quotient{folded->first.Divide( |
2110 | folded->second, context.targetCharacteristics().roundingMode())}; |
2111 | // Don't warn about -1./0., 0./0., or 1./0. from a module file |
2112 | // they are interpreted as canonical Fortran representations of -Inf, |
2113 | // NaN, and Inf respectively. |
2114 | bool isCanonicalNaNOrInf{false}; |
2115 | if constexpr (T::category == TypeCategory::Real) { |
2116 | if (folded->second.IsZero() && context.moduleFileName().has_value()) { |
2117 | using IntType = typename T::Scalar::Word; |
2118 | auto intNumerator{folded->first.template ToInteger<IntType>()}; |
2119 | isCanonicalNaNOrInf = intNumerator.flags == RealFlags{} && |
2120 | intNumerator.value >= IntType{-1} && |
2121 | intNumerator.value <= IntType{1}; |
2122 | } |
2123 | } |
2124 | if (!isCanonicalNaNOrInf) { |
2125 | RealFlagWarnings(context, quotient.flags, "division"); |
2126 | } |
2127 | if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { |
2128 | quotient.value = quotient.value.FlushSubnormalToZero(); |
2129 | } |
2130 | return Expr<T>{Constant<T>{quotient.value}}; |
2131 | } |
2132 | } |
2133 | return Expr<T>{std::move(x)}; |
2134 | } |
2135 | |
2136 | template <typename T> |
2137 | Expr<T> FoldOperation(FoldingContext &context, Power<T> &&x) { |
2138 | if (auto array{ApplyElementwise(context, x)}) { |
2139 | return *array; |
2140 | } |
2141 | if (auto folded{OperandsAreConstants(x)}) { |
2142 | if constexpr (T::category == TypeCategory::Integer) { |
2143 | auto power{folded->first.Power(folded->second)}; |
2144 | if (context.languageFeatures().ShouldWarn( |
2145 | common::UsageWarning::FoldingException)) { |
2146 | if (power.divisionByZero) { |
2147 | context.messages().Say(common::UsageWarning::FoldingException, |
2148 | "INTEGER(%d) zero to negative power"_warn_en_US, T::kind); |
2149 | } else if (power.overflow) { |
2150 | context.messages().Say(common::UsageWarning::FoldingException, |
2151 | "INTEGER(%d) power overflowed"_warn_en_US, T::kind); |
2152 | } else if (power.zeroToZero) { |
2153 | context.messages().Say(common::UsageWarning::FoldingException, |
2154 | "INTEGER(%d) 0**0 is not defined"_warn_en_US, T::kind); |
2155 | } |
2156 | } |
2157 | return Expr<T>{Constant<T>{power.power}}; |
2158 | } else { |
2159 | if (auto callable{GetHostRuntimeWrapper<T, T, T>("pow")}) { |
2160 | return Expr<T>{ |
2161 | Constant<T>{(*callable)(context, folded->first, folded->second)}}; |
2162 | } else if (context.languageFeatures().ShouldWarn( |
2163 | common::UsageWarning::FoldingFailure)) { |
2164 | context.messages().Say(common::UsageWarning::FoldingFailure, |
2165 | "Power for %s cannot be folded on host"_warn_en_US, |
2166 | T{}.AsFortran()); |
2167 | } |
2168 | } |
2169 | } |
2170 | return Expr<T>{std::move(x)}; |
2171 | } |
2172 | |
2173 | template <typename T> |
2174 | Expr<T> FoldOperation(FoldingContext &context, RealToIntPower<T> &&x) { |
2175 | if (auto array{ApplyElementwise(context, x)}) { |
2176 | return *array; |
2177 | } |
2178 | return common::visit( |
2179 | [&](auto &y) -> Expr<T> { |
2180 | if (auto folded{OperandsAreConstants(x.left(), y)}) { |
2181 | auto power{evaluate::IntPower(folded->first, folded->second)}; |
2182 | RealFlagWarnings(context, power.flags, "power with INTEGER exponent"); |
2183 | if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { |
2184 | power.value = power.value.FlushSubnormalToZero(); |
2185 | } |
2186 | return Expr<T>{Constant<T>{power.value}}; |
2187 | } else { |
2188 | return Expr<T>{std::move(x)}; |
2189 | } |
2190 | }, |
2191 | x.right().u); |
2192 | } |
2193 | |
2194 | template <typename T> |
2195 | Expr<T> FoldOperation(FoldingContext &context, Extremum<T> &&x) { |
2196 | if (auto array{ApplyElementwise(context, x, |
2197 | std::function<Expr<T>(Expr<T> &&, Expr<T> &&)>{[=](Expr<T> &&l, |
2198 | Expr<T> &&r) { |
2199 | return Expr<T>{Extremum<T>{x.ordering, std::move(l), std::move(r)}}; |
2200 | }})}) { |
2201 | return *array; |
2202 | } |
2203 | if (auto folded{OperandsAreConstants(x)}) { |
2204 | if constexpr (T::category == TypeCategory::Integer) { |
2205 | if (folded->first.CompareSigned(folded->second) == x.ordering) { |
2206 | return Expr<T>{Constant<T>{folded->first}}; |
2207 | } |
2208 | } else if constexpr (T::category == TypeCategory::Unsigned) { |
2209 | if (folded->first.CompareUnsigned(folded->second) == x.ordering) { |
2210 | return Expr<T>{Constant<T>{folded->first}}; |
2211 | } |
2212 | } else if constexpr (T::category == TypeCategory::Real) { |
2213 | if (folded->first.IsNotANumber() || |
2214 | (folded->first.Compare(folded->second) == Relation::Less) == |
2215 | (x.ordering == Ordering::Less)) { |
2216 | return Expr<T>{Constant<T>{folded->first}}; |
2217 | } |
2218 | } else { |
2219 | static_assert(T::category == TypeCategory::Character); |
2220 | // Result of MIN and MAX on character has the length of |
2221 | // the longest argument. |
2222 | auto maxLen{std::max(folded->first.length(), folded->second.length())}; |
2223 | bool isFirst{x.ordering == Compare(folded->first, folded->second)}; |
2224 | auto res{isFirst ? std::move(folded->first) : std::move(folded->second)}; |
2225 | res = res.length() == maxLen |
2226 | ? std::move(res) |
2227 | : CharacterUtils<T::kind>::Resize(res, maxLen); |
2228 | return Expr<T>{Constant<T>{std::move(res)}}; |
2229 | } |
2230 | return Expr<T>{Constant<T>{folded->second}}; |
2231 | } |
2232 | return Expr<T>{std::move(x)}; |
2233 | } |
2234 | |
2235 | template <int KIND> |
2236 | Expr<Type<TypeCategory::Real, KIND>> ToReal( |
2237 | FoldingContext &context, Expr<SomeType> &&expr) { |
2238 | using Result = Type<TypeCategory::Real, KIND>; |
2239 | std::optional<Expr<Result>> result; |
2240 | common::visit( |
2241 | [&](auto &&x) { |
2242 | using From = std::decay_t<decltype(x)>; |
2243 | if constexpr (std::is_same_v<From, BOZLiteralConstant>) { |
2244 | // Move the bits without any integer->real conversion |
2245 | From original{x}; |
2246 | result = ConvertToType<Result>(std::move(x)); |
2247 | const auto *constant{UnwrapExpr<Constant<Result>>(*result)}; |
2248 | CHECK(constant); |
2249 | Scalar<Result> real{constant->GetScalarValue().value()}; |
2250 | From converted{From::ConvertUnsigned(real.RawBits()).value}; |
2251 | if (original != converted && |
2252 | context.languageFeatures().ShouldWarn( |
2253 | common::UsageWarning::FoldingValueChecks)) { // C1601 |
2254 | context.messages().Say(common::UsageWarning::FoldingValueChecks, |
2255 | "Nonzero bits truncated from BOZ literal constant in REAL intrinsic"_warn_en_US); |
2256 | } |
2257 | } else if constexpr (IsNumericCategoryExpr<From>()) { |
2258 | result = Fold(context, ConvertToType<Result>(std::move(x))); |
2259 | } else { |
2260 | common::die("ToReal: bad argument expression"); |
2261 | } |
2262 | }, |
2263 | std::move(expr.u)); |
2264 | return result.value(); |
2265 | } |
2266 | |
2267 | // REAL(z) and AIMAG(z) |
2268 | template <int KIND> |
2269 | Expr<Type<TypeCategory::Real, KIND>> FoldOperation( |
2270 | FoldingContext &context, ComplexComponent<KIND> &&x) { |
2271 | using Operand = Type<TypeCategory::Complex, KIND>; |
2272 | using Result = Type<TypeCategory::Real, KIND>; |
2273 | if (auto array{ApplyElementwise(context, x, |
2274 | std::function<Expr<Result>(Expr<Operand> &&)>{ |
2275 | [=](Expr<Operand> &&operand) { |
2276 | return Expr<Result>{ComplexComponent<KIND>{ |
2277 | x.isImaginaryPart, std::move(operand)}}; |
2278 | }})}) { |
2279 | return *array; |
2280 | } |
2281 | auto &operand{x.left()}; |
2282 | if (auto value{GetScalarConstantValue<Operand>(operand)}) { |
2283 | if (x.isImaginaryPart) { |
2284 | return Expr<Result>{Constant<Result>{value->AIMAG()}}; |
2285 | } else { |
2286 | return Expr<Result>{Constant<Result>{value->REAL()}}; |
2287 | } |
2288 | } |
2289 | return Expr<Result>{std::move(x)}; |
2290 | } |
2291 | |
2292 | template <typename T> |
2293 | Expr<T> ExpressionBase<T>::Rewrite(FoldingContext &context, Expr<T> &&expr) { |
2294 | return common::visit( |
2295 | [&](auto &&x) -> Expr<T> { |
2296 | if constexpr (IsSpecificIntrinsicType<T>) { |
2297 | return FoldOperation(context, std::move(x)); |
2298 | } else if constexpr (std::is_same_v<T, SomeDerived>) { |
2299 | return FoldOperation(context, std::move(x)); |
2300 | } else if constexpr (common::HasMember<decltype(x), |
2301 | TypelessExpression>) { |
2302 | return std::move(expr); |
2303 | } else { |
2304 | return Expr<T>{Fold(context, std::move(x))}; |
2305 | } |
2306 | }, |
2307 | std::move(expr.u)); |
2308 | } |
2309 | |
2310 | FOR_EACH_TYPE_AND_KIND(extern template class ExpressionBase, ) |
2311 | } // namespace Fortran::evaluate |
2312 | #endif // FORTRAN_EVALUATE_FOLD_IMPLEMENTATION_H_ |
2313 |
Definitions
- useKahanSummation
- Folder
- Folder
- GetHostRuntimeWrapper
- FoldOperation
- FoldOperation
- GetNamedConstant
- Folding
- Folding
- ApplySubscripts
- ApplyComponent
- GetConstantComponent
- Folding
- Folding
- GetConstantArgumentsHelper
- GetConstantArguments
- GetScalarConstantArgumentsHelper
- GetScalarConstantArguments
- FoldElementalIntrinsicHelper
- FoldElementalIntrinsic
- FoldElementalIntrinsic
- GetIntegerVector
- MakeInvalidIntrinsic
- CSHIFT
- EOSHIFT
- MERGE
- PACK
- RESHAPE
- SPREAD
- TRANSPOSE
- UNPACK
- TRANSFER
- FoldMINorMAX
- RewriteSpecificMINorMAX
- FoldOperation
- ArrayConstructorFolder
- ArrayConstructorFolder
- FoldArray
- FoldArray
- FoldArray
- FoldArray
- FoldArray
- FoldArray
- FoldOperation
- ArrayConstructorIsFlat
- AsFlatArrayConstructor
- FromArrayConstructor
- MapOperation
- ArrayConstructorFromMold
- ShapesMatch
- MapOperation
- MapOperation
- MapOperation
- ComputeResultLength
- ApplyElementwise
- ApplyElementwise
- ApplyElementwise
- ApplyElementwise
- ConvertString
- FoldOperation
- FoldOperation
- FoldOperation
- FoldOperation
- FoldOperation
- FoldOperation
- FoldOperation
- FoldOperation
- FoldOperation
- FoldOperation
- ToReal
Update your C++ knowledge – Modern C++11/14/17 Training
Find out more