108 lines · cpp
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-exception6//7//===----------------------------------------------------------------------===//8 9#include "fold-implementation.h"10#include "fold-matmul.h"11#include "fold-reduction.h"12 13namespace Fortran::evaluate {14 15template <int KIND>16Expr<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.Warn(common::UsageWarning::FoldingFailure,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 X44 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 runtime48 // into a complex constructor so that lowering can deal with the49 // optional aspect (there is no optional aspect with the complex50 // constructor).51 if (MayBePassedAsAbsentOptional(*args[1]->UnwrapExpr())) {52 return Expr<T>{std::move(funcRef)};53 }54 }55 // CMPLX(X [, Y [, KIND]]) with non-complex X56 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 79template <int KIND>80Expr<Type<TypeCategory::Complex, KIND>> FoldOperation(81 FoldingContext &context, ComplexConstructor<KIND> &&x) {82 if (auto array{ApplyElementwise(context, x)}) {83 return *array;84 }85 using ComplexType = Type<TypeCategory::Complex, KIND>;86 if (auto folded{OperandsAreConstants(x)}) {87 using RealType = typename ComplexType::Part;88 Constant<ComplexType> result{89 Scalar<ComplexType>{folded->first, folded->second}};90 if (const auto *re{UnwrapConstantValue<RealType>(x.left())};91 re && re->result().isFromInexactLiteralConversion()) {92 result.result().set_isFromInexactLiteralConversion();93 } else if (const auto *im{UnwrapConstantValue<RealType>(x.right())};94 im && im->result().isFromInexactLiteralConversion()) {95 result.result().set_isFromInexactLiteralConversion();96 }97 return Expr<ComplexType>{std::move(result)};98 }99 return Expr<ComplexType>{std::move(x)};100}101 102#ifdef _MSC_VER // disable bogus warning about missing definitions103#pragma warning(disable : 4661)104#endif105FOR_EACH_COMPLEX_KIND(template class ExpressionBase, )106template class ExpressionBase<SomeComplex>;107} // namespace Fortran::evaluate108