// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved. // // Licensed under the Apache License, Version 2.0 (the "License"); // you may not use this file except in compliance with the License. // You may obtain a copy of the License at // // http://www.apache.org/licenses/LICENSE-2.0 // // Unless required by applicable law or agreed to in writing, software // distributed under the License is distributed on an "AS IS" BASIS, // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. // See the License for the specific language governing permissions and // limitations under the License. #include "tools.h" #include "../common/idioms.h" #include "../parser/message.h" #include #include using namespace Fortran::parser::literals; namespace Fortran::evaluate { ConvertRealOperandsResult ConvertRealOperands( parser::ContextualMessages &messages, Expr &&x, Expr &&y) { return std::visit( common::visitors{[&](Expr &&ix, Expr &&iy) -> ConvertRealOperandsResult { // Can happen in a CMPLX() constructor. Per F'2018, // both integer operands are converted to default REAL. return {AsSameKindExprs( ConvertToType(std::move(ix)), ConvertToType(std::move(iy)))}; }, [&](Expr &&ix, Expr &&ry) -> ConvertRealOperandsResult { return {AsSameKindExprs( ConvertTo(ry, std::move(ix)), std::move(ry))}; }, [&](Expr &&rx, Expr &&iy) -> ConvertRealOperandsResult { return {AsSameKindExprs( std::move(rx), ConvertTo(rx, std::move(iy)))}; }, [&](Expr &&rx, Expr &&ry) -> ConvertRealOperandsResult { return {AsSameKindExprs( std::move(rx), std::move(ry))}; }, [&](auto &&, auto &&) -> ConvertRealOperandsResult { // TODO: allow BOZ here? messages.Say("operands must be INTEGER or REAL"_err_en_US); return std::nullopt; }}, std::move(x.u), std::move(y.u)); } // A helper template for NumericOperation and its subroutines. template std::optional> Package(Expr> &&catExpr) { return {AsGenericExpr(std::move(catExpr))}; } template std::optional> Package( std::optional>> &&catExpr) { if (catExpr.has_value()) { return {AsGenericExpr(std::move(*catExpr))}; } return std::nullopt; } std::optional> ConstructComplex( parser::ContextualMessages &messages, Expr &&real, Expr &&imaginary) { if (auto converted{ConvertRealOperands( messages, std::move(real), std::move(imaginary))}) { return {std::visit( [](auto &&pair) { return MakeComplex(std::move(pair[0]), std::move(pair[1])); }, std::move(*converted))}; } return std::nullopt; } std::optional> ConstructComplex( parser::ContextualMessages &messages, std::optional> &&real, std::optional> &&imaginary) { if (auto parts{common::AllPresent(std::move(real), std::move(imaginary))}) { return ConstructComplex(messages, std::move(std::get<0>(*parts)), std::move(std::get<1>(*parts))); } return std::nullopt; } Expr GetComplexPart(const Expr &z, bool isImaginary) { return std::visit( [&](const auto &zk) { static constexpr int kind{ResultType::kind}; return AsCategoryExpr(AsExpr(ComplexComponent{isImaginary, zk})); }, z.u); } template class OPR> std::optional> MixedComplex(parser::ContextualMessages &messages, Expr &&zx, Expr &&iry) { Expr zr{GetComplexPart(zx, false)}; Expr zi{GetComplexPart(zx, true)}; if constexpr (std::is_same_v, Add> || std::is_same_v, Subtract>) { // Addition and subtraction: apply the operation to the real part of the // complex operand, and a transfer/convert its imaginary part. // i.e., (a,b) + c = (a+c, b) if (std::optional> rr{ NumericOperation(messages, std::move(zr), std::move(iry))}) { return Package(ConstructComplex(messages, AsGenericExpr(std::move(*rr)), AsGenericExpr(std::move(zi)))); } } else if constexpr (std::is_same_v, Multiply> || std::is_same_v, Divide>) { // Multiplication and division of a COMPLEX value by an INTEGER or REAL // operand: apply the operation to both components of the COMPLEX value, // then convert and recombine them. // i.e., (a,b) * c = (a*c, b*c) auto copy{iry}; auto rr{NumericOperation(messages, std::move(zr), std::move(iry))}; auto ri{NumericOperation(messages, std::move(zi), std::move(copy))}; if (auto parts{common::AllPresent(std::move(rr), std::move(ri))}) { return Package(ConstructComplex(messages, std::move(std::get<0>(*parts)), std::move(std::get<1>(*parts)))); } } return std::nullopt; } // N.B. When a "typeless" BOZ literal constant appears as one (not both!) of // the operands to a dyadic INTEGER or REAL operation, it assumes the type // and kind of the other operand. template class OPR> std::optional> NumericOperation( parser::ContextualMessages &messages, Expr &&x, Expr &&y) { return std::visit( common::visitors{[](Expr &&ix, Expr &&iy) { return Package( PromoteAndCombine( std::move(ix), std::move(iy))); }, [](Expr &&rx, Expr &&ry) { return Package(PromoteAndCombine( std::move(rx), std::move(ry))); }, [](Expr &&rx, Expr &&iy) { return Package(std::visit( [&](auto &&rxk) -> Expr { using resultType = ResultType; return AsCategoryExpr(AsExpr(OPR{std::move(rxk), ConvertToType(std::move(iy))})); }, std::move(rx.u))); }, [](Expr &&ix, Expr &&ry) { return Package(std::visit( [&](auto &&ryk) -> Expr { using resultType = ResultType; return AsCategoryExpr(AsExpr( OPR{ConvertToType(std::move(ix)), std::move(ryk)})); }, std::move(ry.u))); }, [](Expr &&zx, Expr &&zy) { return Package(PromoteAndCombine( std::move(zx), std::move(zy))); }, [&](Expr &&zx, Expr &&zy) { return MixedComplex(messages, std::move(zx), std::move(zy)); }, [&](Expr &&zx, Expr &&zy) { return MixedComplex(messages, std::move(zx), std::move(zy)); }, // TODO pmk: mixed r+complex, &c.; r/z is tricky // TODO pmk: mixed complex + boz? yes but what about COMPLEX*16? [&](BOZLiteralConstant &&bx, Expr &&iy) { return NumericOperation( messages, ConvertTo(iy, std::move(bx)), std::move(y)); }, [&](BOZLiteralConstant &&bx, Expr &&ry) { return NumericOperation( messages, ConvertTo(ry, std::move(bx)), std::move(y)); }, [&](Expr &&ix, BOZLiteralConstant &&by) { return NumericOperation( messages, std::move(x), ConvertTo(ix, std::move(by))); }, [&](Expr &&rx, BOZLiteralConstant &&by) { return NumericOperation( messages, std::move(x), ConvertTo(rx, std::move(by))); }, [&](auto &&, auto &&) { messages.Say("non-numeric operands to numeric operation"_err_en_US); return std::optional>{std::nullopt}; }}, std::move(x.u), std::move(y.u)); } template std::optional> NumericOperation( parser::ContextualMessages &, Expr &&, Expr &&); template std::optional> NumericOperation( parser::ContextualMessages &, Expr &&, Expr &&); template std::optional> NumericOperation( parser::ContextualMessages &, Expr &&, Expr &&); template std::optional> NumericOperation( parser::ContextualMessages &, Expr &&, Expr &&); } // namespace Fortran::evaluate