1 | //===-- lib/Evaluate/fold-complex.cpp -------------------------------------===// |
2 | // |
3 | // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
4 | // See https://llvm.org/LICENSE.txt for license information. |
5 | // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
6 | // |
7 | //===----------------------------------------------------------------------===// |
8 | |
9 | #include "fold-implementation.h" |
10 | #include "fold-matmul.h" |
11 | #include "fold-reduction.h" |
12 | |
13 | namespace Fortran::evaluate { |
14 | |
15 | template <int KIND> |
16 | Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction( |
17 | FoldingContext &context, |
18 | FunctionRef<Type<TypeCategory::Complex, KIND>> &&funcRef) { |
19 | using T = Type<TypeCategory::Complex, KIND>; |
20 | using Part = typename T::Part; |
21 | ActualArguments &args{funcRef.arguments()}; |
22 | auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)}; |
23 | CHECK(intrinsic); |
24 | std::string name{intrinsic->name}; |
25 | if (name == "acos" || name == "acosh" || name == "asin" || name == "asinh" || |
26 | name == "atan" || name == "atanh" || name == "cos" || name == "cosh" || |
27 | name == "exp" || name == "log" || name == "sin" || name == "sinh" || |
28 | name == "sqrt" || name == "tan" || name == "tanh" ) { |
29 | if (auto callable{GetHostRuntimeWrapper<T, T>(name)}) { |
30 | return FoldElementalIntrinsic<T, T>( |
31 | context, std::move(funcRef), *callable); |
32 | } else { |
33 | context.messages().Say( |
34 | "%s(complex(kind=%d)) cannot be folded on host"_warn_en_US , name, |
35 | KIND); |
36 | } |
37 | } else if (name == "conjg" ) { |
38 | return FoldElementalIntrinsic<T, T>( |
39 | context, std::move(funcRef), &Scalar<T>::CONJG); |
40 | } else if (name == "cmplx" ) { |
41 | if (args.size() > 0 && args[0].has_value()) { |
42 | if (auto *x{UnwrapExpr<Expr<SomeComplex>>(args[0])}) { |
43 | // CMPLX(X [, KIND]) with complex X |
44 | return Fold(context, ConvertToType<T>(std::move(*x))); |
45 | } else { |
46 | if (args.size() >= 2 && args[1].has_value()) { |
47 | // Do not fold CMPLX with an Y argument that may be absent at runtime |
48 | // into a complex constructor so that lowering can deal with the |
49 | // optional aspect (there is no optional aspect with the complex |
50 | // constructor). |
51 | if (MayBePassedAsAbsentOptional(*args[1]->UnwrapExpr())) { |
52 | return Expr<T>{std::move(funcRef)}; |
53 | } |
54 | } |
55 | // CMPLX(X [, Y [, KIND]]) with non-complex X |
56 | Expr<SomeType> re{std::move(*args[0].value().UnwrapExpr())}; |
57 | Expr<SomeType> im{args.size() >= 2 && args[1].has_value() |
58 | ? std::move(*args[1]->UnwrapExpr()) |
59 | : AsGenericExpr(Constant<Part>{Scalar<Part>{}})}; |
60 | return Fold(context, |
61 | Expr<T>{ |
62 | ComplexConstructor<KIND>{ToReal<KIND>(context, std::move(re)), |
63 | ToReal<KIND>(context, std::move(im))}}); |
64 | } |
65 | } |
66 | } else if (name == "dot_product" ) { |
67 | return FoldDotProduct<T>(context, std::move(funcRef)); |
68 | } else if (name == "matmul" ) { |
69 | return FoldMatmul(context, std::move(funcRef)); |
70 | } else if (name == "product" ) { |
71 | auto one{Scalar<Part>::FromInteger(value::Integer<8>{1}).value}; |
72 | return FoldProduct<T>(context, std::move(funcRef), Scalar<T>{one}); |
73 | } else if (name == "sum" ) { |
74 | return FoldSum<T>(context, std::move(funcRef)); |
75 | } |
76 | return Expr<T>{std::move(funcRef)}; |
77 | } |
78 | |
79 | template <int KIND> |
80 | Expr<Type<TypeCategory::Complex, KIND>> FoldOperation( |
81 | FoldingContext &context, ComplexConstructor<KIND> &&x) { |
82 | if (auto array{ApplyElementwise(context, x)}) { |
83 | return *array; |
84 | } |
85 | using Result = Type<TypeCategory::Complex, KIND>; |
86 | if (auto folded{OperandsAreConstants(x)}) { |
87 | return Expr<Result>{ |
88 | Constant<Result>{Scalar<Result>{folded->first, folded->second}}}; |
89 | } |
90 | return Expr<Result>{std::move(x)}; |
91 | } |
92 | |
93 | #ifdef _MSC_VER // disable bogus warning about missing definitions |
94 | #pragma warning(disable : 4661) |
95 | #endif |
96 | FOR_EACH_COMPLEX_KIND(template class ExpressionBase, ) |
97 | template class ExpressionBase<SomeComplex>; |
98 | } // namespace Fortran::evaluate |
99 | |