// Copyright (c) 2018-2019, 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 { // Conversions of complex component expressions to REAL. ConvertRealOperandsResult ConvertRealOperands( parser::ContextualMessages &messages, Expr &&x, Expr &&y, int defaultRealKind) { 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( ConvertToKind( defaultRealKind, std::move(ix)), ConvertToKind( defaultRealKind, 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))}; }, [&](Expr &&ix, BOZLiteralConstant &&by) -> ConvertRealOperandsResult { return {AsSameKindExprs( ConvertToKind( defaultRealKind, std::move(ix)), ConvertToKind( defaultRealKind, std::move(by)))}; }, [&](BOZLiteralConstant &&bx, Expr &&iy) -> ConvertRealOperandsResult { return {AsSameKindExprs( ConvertToKind( defaultRealKind, std::move(bx)), ConvertToKind( defaultRealKind, std::move(iy)))}; }, [&](Expr &&rx, BOZLiteralConstant &&by) -> ConvertRealOperandsResult { return {AsSameKindExprs( std::move(rx), ConvertTo(rx, std::move(by)))}; }, [&](BOZLiteralConstant &&bx, Expr &&ry) -> ConvertRealOperandsResult { return {AsSameKindExprs( ConvertTo(ry, std::move(bx)), std::move(ry))}; }, [&](auto &&, auto &&) -> ConvertRealOperandsResult { messages.Say("operands must be INTEGER or REAL"_err_en_US); return std::nullopt; }, }, std::move(x.u), std::move(y.u)); } // Helpers for NumericOperation and its subroutines below. static std::optional> NoExpr() { return std::nullopt; } 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 NoExpr(); } // Mixed REAL+INTEGER operations. REAL**INTEGER is a special case that // does not require conversion of the exponent expression. template class OPR> std::optional> MixedRealLeft( Expr &&rx, Expr &&iy) { return Package(std::visit( [&](auto &&rxk) -> Expr { using resultType = ResultType; if constexpr (std::is_same_v, Power>) { return AsCategoryExpr( RealToIntPower{std::move(rxk), std::move(iy)}); } // G++ 8.1.0 emits bogus warnings about missing return statements if // this statement is wrapped in an "else", as it should be. return AsCategoryExpr(OPR{ std::move(rxk), ConvertToType(std::move(iy))}); }, std::move(rx.u))); } std::optional> ConstructComplex( parser::ContextualMessages &messages, Expr &&real, Expr &&imaginary, int defaultRealKind) { if (auto converted{ConvertRealOperands( messages, std::move(real), std::move(imaginary), defaultRealKind)}) { 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, int defaultRealKind) { 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)), defaultRealKind); } return std::nullopt; } Expr GetComplexPart(const Expr &z, bool isImaginary) { return std::visit( [&](const auto &zk) { static constexpr int kind{ResultType::kind}; return AsCategoryExpr(ComplexComponent{isImaginary, zk}); }, z.u); } // Handle mixed COMPLEX+REAL (or INTEGER) operations in a better way // than just converting the second operand to COMPLEX and performing the // corresponding COMPLEX+COMPLEX operation. template class OPR, TypeCategory RCAT> std::optional> MixedComplexLeft( parser::ContextualMessages &messages, Expr &&zx, Expr> &&iry, int defaultRealKind) { Expr zr{GetComplexPart(zx, false)}; Expr zi{GetComplexPart(zx, true)}; if constexpr (std::is_same_v, Add> || std::is_same_v, Subtract>) { // (a,b) + x -> (a+x, b) // (a,b) - x -> (a-x, b) if (std::optional> rr{ NumericOperation(messages, AsGenericExpr(std::move(zr)), AsGenericExpr(std::move(iry)), defaultRealKind)}) { return Package(ConstructComplex(messages, std::move(*rr), AsGenericExpr(std::move(zi)), defaultRealKind)); } } else if constexpr (std::is_same_v, Multiply> || std::is_same_v, Divide>) { // (a,b) * x -> (a*x, b*x) // (a,b) / x -> (a/x, b/x) auto copy{iry}; auto rr{NumericOperation(messages, AsGenericExpr(std::move(zr)), AsGenericExpr(std::move(iry)), defaultRealKind)}; auto ri{NumericOperation(messages, AsGenericExpr(std::move(zi)), AsGenericExpr(std::move(copy)), defaultRealKind)}; 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)), defaultRealKind)); } } else if constexpr (RCAT == TypeCategory::Integer && std::is_same_v, Power>) { // COMPLEX**INTEGER is a special case that doesn't convert the exponent. static_assert(RCAT == TypeCategory::Integer); return Package(std::visit( [&](auto &&zxk) { using Ty = ResultType; return AsCategoryExpr( AsExpr(RealToIntPower{std::move(zxk), std::move(iry)})); }, std::move(zx.u))); } else { // (a,b) ** x -> (a,b) ** (x,0) Expr zy{ConvertTo(zx, std::move(iry))}; return Package(PromoteAndCombine(std::move(zx), std::move(zy))); } return NoExpr(); } // Mixed COMPLEX operations with the COMPLEX operand on the right. // x + (a,b) -> (x+a, b) // x - (a,b) -> (x-a, -b) // x * (a,b) -> (x*a, x*b) // x / (a,b) -> (x,0) / (a,b) (and **) template class OPR, TypeCategory LCAT> std::optional> MixedComplexRight( parser::ContextualMessages &messages, Expr> &&irx, Expr &&zy, int defaultRealKind) { if constexpr (std::is_same_v, Add> || std::is_same_v, Multiply>) { // x + (a,b) -> (a,b) + x -> (a+x, b) // x * (a,b) -> (a,b) * x -> (a*x, b*x) return MixedComplexLeft( messages, std::move(zy), std::move(irx), defaultRealKind); } else if constexpr (std::is_same_v, Subtract>) { // x - (a,b) -> (x-a, -b) Expr zr{GetComplexPart(zy, false)}; Expr zi{GetComplexPart(zy, true)}; if (std::optional> rr{ NumericOperation(messages, AsGenericExpr(std::move(irx)), AsGenericExpr(std::move(zr)), defaultRealKind)}) { return Package(ConstructComplex(messages, std::move(*rr), AsGenericExpr(-std::move(zi)), defaultRealKind)); } } else { // x / (a,b) -> (x,0) / (a,b) Expr zx{ConvertTo(zy, std::move(irx))}; return Package(PromoteAndCombine(std::move(zx), std::move(zy))); } return NoExpr(); } // N.B. When a "typeless" BOZ literal constant appears as one (not both!) of // the operands to a dyadic operation where one is permitted, it assumes the // type and kind of the other operand. template class OPR> std::optional> NumericOperation( parser::ContextualMessages &messages, Expr &&x, Expr &&y, int defaultRealKind) { 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))); }, // Mixed REAL/INTEGER operations [](Expr &&rx, Expr &&iy) { return MixedRealLeft(std::move(rx), std::move(iy)); }, [](Expr &&ix, Expr &&ry) { return Package(std::visit( [&](auto &&ryk) -> Expr { using resultType = ResultType; return AsCategoryExpr( OPR{ConvertToType(std::move(ix)), std::move(ryk)}); }, std::move(ry.u))); }, // Homogeneous and mixed COMPLEX operations [](Expr &&zx, Expr &&zy) { return Package(PromoteAndCombine( std::move(zx), std::move(zy))); }, [&](Expr &&zx, Expr &&zy) { return MixedComplexLeft( messages, std::move(zx), std::move(zy), defaultRealKind); }, [&](Expr &&zx, Expr &&zy) { return MixedComplexLeft( messages, std::move(zx), std::move(zy), defaultRealKind); }, [&](Expr &&zx, Expr &&zy) { return MixedComplexRight( messages, std::move(zx), std::move(zy), defaultRealKind); }, [&](Expr &&zx, Expr &&zy) { return MixedComplexRight( messages, std::move(zx), std::move(zy), defaultRealKind); }, // Operations with one typeless operand [&](BOZLiteralConstant &&bx, Expr &&iy) { return NumericOperation(messages, AsGenericExpr(ConvertTo(iy, std::move(bx))), std::move(y), defaultRealKind); }, [&](BOZLiteralConstant &&bx, Expr &&ry) { return NumericOperation(messages, AsGenericExpr(ConvertTo(ry, std::move(bx))), std::move(y), defaultRealKind); }, [&](Expr &&ix, BOZLiteralConstant &&by) { return NumericOperation(messages, std::move(x), AsGenericExpr(ConvertTo(ix, std::move(by))), defaultRealKind); }, [&](Expr &&rx, BOZLiteralConstant &&by) { return NumericOperation(messages, std::move(x), AsGenericExpr(ConvertTo(rx, std::move(by))), defaultRealKind); }, // Default case [&](auto &&, auto &&) { // TODO: defined operator messages.Say("non-numeric operands to numeric operation"_err_en_US); return NoExpr(); }, }, std::move(x.u), std::move(y.u)); } template std::optional> NumericOperation( parser::ContextualMessages &, Expr &&, Expr &&, int defaultRealKind); template std::optional> NumericOperation( parser::ContextualMessages &, Expr &&, Expr &&, int defaultRealKind); template std::optional> NumericOperation( parser::ContextualMessages &, Expr &&, Expr &&, int defaultRealKind); template std::optional> NumericOperation( parser::ContextualMessages &, Expr &&, Expr &&, int defaultRealKind); template std::optional> NumericOperation( parser::ContextualMessages &, Expr &&, Expr &&, int defaultRealKind); std::optional> Negation( parser::ContextualMessages &messages, Expr &&x) { return std::visit( common::visitors{ [&](BOZLiteralConstant &&) { messages.Say("BOZ literal cannot be negated"_err_en_US); return NoExpr(); }, [&](Expr &&x) { return Package(-std::move(x)); }, [&](Expr &&x) { return Package(-std::move(x)); }, [&](Expr &&x) { return Package(-std::move(x)); }, [&](Expr &&x) { // TODO: defined operator messages.Say("CHARACTER cannot be negated"_err_en_US); return NoExpr(); }, [&](Expr &&x) { // TODO: defined operator messages.Say("LOGICAL cannot be negated"_err_en_US); return NoExpr(); }, [&](Expr &&x) { // TODO: defined operator messages.Say("derived type cannot be negated"_err_en_US); return NoExpr(); }, }, std::move(x.u)); } Expr LogicalNegation(Expr &&x) { return std::visit( [](auto &&xk) { return AsCategoryExpr(LogicalNegation(std::move(xk))); }, std::move(x.u)); } template Expr PackageRelation( RelationalOperator opr, Expr &&x, Expr &&y) { static_assert(IsSpecificIntrinsicType); return Expr{ Relational{Relational{opr, std::move(x), std::move(y)}}}; } template Expr PromoteAndRelate( RelationalOperator opr, Expr> &&x, Expr> &&y) { return std::visit( [=](auto &&xy) { return PackageRelation(opr, std::move(xy[0]), std::move(xy[1])); }, AsSameKindExprs(std::move(x), std::move(y))); } std::optional> Relate(parser::ContextualMessages &messages, RelationalOperator opr, Expr &&x, Expr &&y) { return std::visit( common::visitors{ [=](Expr &&ix, Expr &&iy) { return std::make_optional( PromoteAndRelate(opr, std::move(ix), std::move(iy))); }, [=](Expr &&rx, Expr &&ry) { return std::make_optional( PromoteAndRelate(opr, std::move(rx), std::move(ry))); }, [&](Expr &&rx, Expr &&iy) { return Relate(messages, opr, std::move(x), AsGenericExpr(ConvertTo(rx, std::move(iy)))); }, [&](Expr &&ix, Expr &&ry) { return Relate(messages, opr, AsGenericExpr(ConvertTo(ry, std::move(ix))), std::move(y)); }, [&](Expr &&zx, Expr &&zy) { if (opr != RelationalOperator::EQ && opr != RelationalOperator::NE) { messages.Say( "COMPLEX data may be compared only for equality"_err_en_US); return std::optional>{}; } else { auto rr{Relate(messages, opr, AsGenericExpr(GetComplexPart(zx, false)), AsGenericExpr(GetComplexPart(zy, false)))}; auto ri{ Relate(messages, opr, AsGenericExpr(GetComplexPart(zx, true)), AsGenericExpr(GetComplexPart(zy, true)))}; if (auto parts{ common::AllPresent(std::move(rr), std::move(ri))}) { // (a,b)==(c,d) -> (a==c) .AND. (b==d) // (a,b)/=(c,d) -> (a/=c) .OR. (b/=d) LogicalOperator combine{opr == RelationalOperator::EQ ? LogicalOperator::And : LogicalOperator::Or}; return std::make_optional( Expr{LogicalOperation{ combine, std::move(std::get<0>(*parts)), std::move(std::get<1>(*parts))}}); } else { return std::optional>{}; } } }, [&](Expr &&zx, Expr &&iy) { return Relate(messages, opr, std::move(x), AsGenericExpr(ConvertTo(zx, std::move(iy)))); }, [&](Expr &&zx, Expr &&ry) { return Relate(messages, opr, std::move(x), AsGenericExpr(ConvertTo(zx, std::move(ry)))); }, [&](Expr &&ix, Expr &&zy) { return Relate(messages, opr, AsGenericExpr(ConvertTo(zy, std::move(ix))), std::move(y)); }, [&](Expr &&rx, Expr &&zy) { return Relate(messages, opr, AsGenericExpr(ConvertTo(zy, std::move(rx))), std::move(y)); }, [&](Expr &&cx, Expr &&cy) { return std::visit( [&](auto &&cxk, auto &&cyk) { using Ty = ResultType; if constexpr (std::is_same_v>) { return std::make_optional( PackageRelation(opr, std::move(cxk), std::move(cyk))); } else { messages.Say( "CHARACTER operands do not have same KIND"_err_en_US); return std::optional>{}; } }, std::move(cx.u), std::move(cy.u)); }, // Default case [&](auto &&, auto &&) { // TODO: defined operator messages.Say( "relational operands do not have comparable types"_err_en_US); return std::optional>{}; }, }, std::move(x.u), std::move(y.u)); } Expr BinaryLogicalOperation( LogicalOperator opr, Expr &&x, Expr &&y) { return std::visit( [=](auto &&xy) { using Ty = ResultType; return Expr{BinaryLogicalOperation( opr, std::move(xy[0]), std::move(xy[1]))}; }, AsSameKindExprs(std::move(x), std::move(y))); } template std::optional> ConvertToNumeric(int kind, Expr &&x) { static_assert(common::IsNumericTypeCategory(TO)); return std::visit( [=](auto &&cx) -> std::optional> { using cxType = std::decay_t; if constexpr (!std::is_same_v) { if constexpr (IsNumericTypeCategory(ResultType::category)) { return std::make_optional( Expr{ConvertToKind(kind, std::move(cx))}); } } return std::nullopt; }, std::move(x.u)); } std::optional> ConvertToType( const DynamicType &type, Expr &&x) { switch (type.category) { case TypeCategory::Integer: return ConvertToNumeric(type.kind, std::move(x)); case TypeCategory::Real: return ConvertToNumeric(type.kind, std::move(x)); case TypeCategory::Complex: return ConvertToNumeric(type.kind, std::move(x)); case TypeCategory::Character: if (auto fromType{x.GetType()}) { if (fromType->category == TypeCategory::Character && fromType->kind == type.kind) { // TODO pmk: adjusting CHARACTER length via conversion return std::move(x); } } break; case TypeCategory::Logical: if (auto *cx{UnwrapExpr>(x)}) { return Expr{ ConvertToKind(type.kind, std::move(*cx))}; } break; case TypeCategory::Derived: if (auto fromType{x.GetType()}) { if (type == fromType) { return std::move(x); } } break; default: CRASH_NO_CASE; } return std::nullopt; } std::optional> ConvertToType( const DynamicType &type, std::optional> &&x) { if (x.has_value()) { return ConvertToType(type, std::move(*x)); } else { return std::nullopt; } } }