// Fortran has five kinds of intrinsic data, and the derived types.
ENUM_CLASS(TypeCategory, Integer, Real, Complex, Character, Logical, Derived)
+static constexpr bool IsNumeric(TypeCategory cat) {
+ return cat <= TypeCategory::Complex;
+}
+
// Kinds of IMPORT statements. Default means IMPORT or IMPORT :: names.
ENUM_CLASS(ImportKind, Default, Only, None, All)
template<int KIND>
auto ComplexComponent<KIND>::FoldScalar(FoldingContext &context,
const Scalar<Operand> &z) const -> std::optional<Scalar<Result>> {
- return {isRealPart ? z.REAL() : z.AIMAG()};
+ return {isImaginaryPart ? z.AIMAG() : z.REAL()};
}
template<int KIND>
using typename Base::Result;
using Operand = typename Base::template Operand<0>;
CLASS_BOILERPLATE(ComplexComponent)
- ComplexComponent(bool isReal, const Expr<Operand> &x)
- : Base{x}, isRealPart{isReal} {}
- ComplexComponent(bool isReal, Expr<Operand> &&x)
- : Base{std::move(x)}, isRealPart{isReal} {}
+ ComplexComponent(bool isImaginary, const Expr<Operand> &x)
+ : Base{x}, isImaginaryPart{isImaginary} {}
+ ComplexComponent(bool isImaginary, Expr<Operand> &&x)
+ : Base{std::move(x)}, isImaginaryPart{isImaginary} {}
std::optional<Scalar<Result>> FoldScalar(
FoldingContext &, const Scalar<Operand> &) const;
- const char *suffix() const { return isRealPart ? "%RE)" : "%IM)"; }
+ const char *suffix() const { return isImaginaryPart ? "%IM)" : "%RE)"; }
- bool isRealPart{true};
+ bool isImaginaryPart{true};
};
template<int KIND>
// limitations under the License.
#include "tools.h"
+#include "../common/idioms.h"
#include "../parser/message.h"
+#include <algorithm>
#include <variant>
using namespace Fortran::parser::literals;
namespace Fortran::evaluate {
-std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>> ConvertRealOperands(
+ConvertRealOperandsResult ConvertRealOperands(
parser::ContextualMessages &messages, Expr<SomeType> &&x,
Expr<SomeType> &&y) {
return std::visit(
std::move(x.u), std::move(y.u));
}
-std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>> ConvertRealOperands(
+ConvertRealOperandsResult ConvertRealOperands(
parser::ContextualMessages &messages, std::optional<Expr<SomeType>> &&x,
std::optional<Expr<SomeType>> &&y) {
- if (x.has_value() && y.has_value()) {
- return ConvertRealOperands(messages, std::move(*x), std::move(*y));
- }
- return std::nullopt;
+ auto partial{[&](Expr<SomeType> &&x, Expr<SomeType> &&y) {
+ return ConvertRealOperands(messages, std::move(x), std::move(y));
+ }};
+ using fType = ConvertRealOperandsResult(Expr<SomeType> &&, Expr<SomeType> &&);
+ std::function<fType> f{partial};
+ return common::JoinOptionals(
+ common::MapOptional(f, std::move(x), std::move(y)));
}
Expr<SomeType> GenericScalarToExpr(const Scalar<SomeType> &x) {
[&](const auto &c) { return ToGenericExpr(SomeKindScalarToExpr(c)); },
x.u);
}
+
+template<template<typename> class OPR, TypeCategory CAT>
+std::optional<Expr<SomeType>> PromoteAndCombine(
+ Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
+ return {Expr<SomeType>{std::visit(
+ [&](auto &&xk, auto &&yk) -> Expr<SomeKind<CAT>> {
+ using xt = ResultType<decltype(xk)>;
+ using yt = ResultType<decltype(yk)>;
+ using ToType = Type<CAT, std::max(xt::kind, yt::kind)>;
+ return {Expr<ToType>{OPR<ToType>{EnsureKind<ToType>(std::move(xk)),
+ EnsureKind<ToType>(std::move(yk))}}};
+ },
+ std::move(x.u.u), std::move(y.u.u))}};
+}
+
+template<template<typename> class OPR>
+std::optional<Expr<SomeType>> NumericOperation(
+ parser::ContextualMessages &messages, Expr<SomeType> &&x,
+ Expr<SomeType> &&y) {
+ return std::visit(
+ common::visitors{[](Expr<SomeInteger> &&ix, Expr<SomeInteger> &&iy) {
+ return PromoteAndCombine<OPR, TypeCategory::Integer>(
+ std::move(ix), std::move(iy));
+ },
+ [](Expr<SomeReal> &&rx, Expr<SomeReal> &&ry) {
+ return PromoteAndCombine<OPR, TypeCategory::Real>(
+ std::move(rx), std::move(ry));
+ },
+ [](Expr<SomeReal> &&rx, Expr<SomeInteger> &&iy) {
+ return std::optional{Expr<SomeType>{std::visit(
+ [&](auto &&rxk) -> Expr<SomeReal> {
+ using kindEx = decltype(rxk);
+ using resultType = ResultType<kindEx>;
+ return {kindEx{
+ OPR<resultType>{std::move(rxk), kindEx{std::move(iy)}}}};
+ },
+ std::move(rx.u.u))}};
+ },
+ [](Expr<SomeInteger> &&ix, Expr<SomeReal> &&ry) {
+ return std::optional{Expr<SomeType>{std::visit(
+ [&](auto &&ryk) -> Expr<SomeReal> {
+ using kindEx = decltype(ryk);
+ using resultType = ResultType<kindEx>;
+ return {kindEx{
+ OPR<resultType>{kindEx{std::move(ix)}, std::move(ryk)}}};
+ },
+ std::move(ry.u.u))}};
+ },
+ [](Expr<SomeComplex> &&zx, Expr<SomeComplex> &&zy) {
+ return PromoteAndCombine<OPR, TypeCategory::Complex>(
+ std::move(zx), std::move(zy));
+ },
+ // TODO pmk complex; Add/Sub different from Mult/Div
+ [&](auto &&, auto &&) {
+ messages.Say("non-numeric operands to numeric operation"_err_en_US);
+ return std::optional<Expr<SomeType>>{std::nullopt};
+ }},
+ std::move(x.u), std::move(y.u));
+}
+
+template std::optional<Expr<SomeType>> NumericOperation<Add>(
+ parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
+
} // namespace Fortran::evaluate
to.u.u);
}
-// Ensure that both operands of an intrinsic REAL operation or CMPLX()
-// are INTEGER or REAL, and convert them as necessary to the same REAL type.
-using ConvertRealOperandsResult =
- std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>>;
-ConvertRealOperandsResult ConvertRealOperands(
- parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
-
+// Given two expressions of the same type category, convert one to the
+// kind of the other in place if it has a smaller kind.
template<TypeCategory CAT>
void ConvertToSameKind(Expr<SomeKind<CAT>> &x, Expr<SomeKind<CAT>> &y) {
std::visit(
x.u.u, y.u.u);
}
+// Ensure that both operands of an intrinsic REAL operation (or CMPLX()
+// constructor) are INTEGER or REAL, then convert them as necessary to the
+// same kind of REAL.
+using ConvertRealOperandsResult =
+ std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>>;
+ConvertRealOperandsResult ConvertRealOperands(
+ parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
+ConvertRealOperandsResult ConvertRealOperands(parser::ContextualMessages &,
+ std::optional<Expr<SomeType>> &&, std::optional<Expr<SomeType>> &&);
+
template<typename A> Expr<TypeOf<A>> ScalarConstantToExpr(const A &x) {
static_assert(std::is_same_v<Scalar<TypeOf<A>>, std::decay_t<A>> ||
!"TypeOf<> is broken");
}
template<TypeCategory CAT, int KIND>
-Expr<SomeKind<CAT>> ToSomeKindExpr(const Expr<Type<CAT, KIND>> &x) {
- return {x};
+Expr<SomeKind<CAT>> ToSomeKindExpr(Expr<Type<CAT, KIND>> &&x) {
+ return {std::move(x)};
}
template<TypeCategory CAT>
Expr<SomeType> GenericScalarToExpr(const Scalar<SomeType> &);
-template<TypeCategory CAT>
-Expr<SomeType> ToGenericExpr(const Expr<SomeKind<CAT>> &x) {
- return Expr<SomeType>{x};
+template<TypeCategory CAT, int KIND>
+Expr<SomeType> ToGenericExpr(Expr<Type<CAT, KIND>> &&x) {
+ return Expr<SomeType>{Expr<SomeKind<CAT>>{std::move(x)}};
}
template<TypeCategory CAT>
return Expr<SomeType>{std::move(x)};
}
+// Convert, if necessary, an expression to a specific kind in the same
+// category.
+template<typename TOTYPE>
+Expr<TOTYPE> EnsureKind(Expr<SomeKind<TOTYPE::category>> &&x) {
+ using ToType = TOTYPE;
+ using FromGenericType = SomeKind<ToType::category>;
+ if (auto *p{std::get_if<Expr<ToType>>(&x.u.u)}) {
+ return std::move(*p);
+ }
+ if constexpr (ToType::category == TypeCategory::Complex) {
+ return {std::visit(
+ [](auto &z) -> ComplexConstructor<ToType::kind> {
+ using FromType = ResultType<decltype(z)>;
+ using FromPart = typename FromType::Part;
+ using FromGeneric = SomeKind<TypeCategory::Real>;
+ using ToPart = typename ToType::Part;
+ Convert<ToPart, FromGeneric> re{Expr<FromGeneric>{
+ Expr<FromPart>{ComplexComponent<FromType::kind>{false, z}}}};
+ Convert<ToPart, FromGeneric> im{Expr<FromGeneric>{
+ Expr<FromPart>{ComplexComponent<FromType::kind>{true, z}}}};
+ return {std::move(re), std::move(im)};
+ },
+ x.u.u)};
+ } else {
+ return {Convert<ToType, FromGenericType>{std::move(x)}};
+ }
+}
+
+template<template<typename> class OPR>
+std::optional<Expr<SomeType>> NumericOperation(
+ parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
+extern template std::optional<Expr<SomeType>> NumericOperation<Add>(
+ parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
+
} // namespace Fortran::evaluate
#endif // FORTRAN_EVALUATE_TOOLS_H_
template<>
MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Add &x) {
- // TODO
+ // TODO pmk WIP
return std::nullopt;
}
std::optional<Expr<evaluate::SomeComplex>> ExpressionAnalyzer::ConstructComplex(
MaybeExpr &&real, MaybeExpr &&imaginary) {
- // TODO: pmk abstract further, this will be a common pattern
- auto partial{[&](Expr<SomeType> &&x, Expr<SomeType> &&y) {
- return evaluate::ConvertRealOperands(
- context_.messages, std::move(x), std::move(y));
- }};
- using fType =
- evaluate::ConvertRealOperandsResult(Expr<SomeType> &&, Expr<SomeType> &&);
- std::function<fType> f{partial};
- auto converted{common::MapOptional(f, std::move(real), std::move(imaginary))};
- if (auto joined{common::JoinOptionals(std::move(converted))}) {
+ if (auto converted{evaluate::ConvertRealOperands(
+ context_.messages, std::move(real), std::move(imaginary))}) {
return {std::visit(
[](auto &&rx, auto &&ix) -> Expr<evaluate::SomeComplex> {
using realType = evaluate::ResultType<decltype(rx)>;
return {Expr<zType>{evaluate::ComplexConstructor<kind>{
std::move(rx), std::move(ix)}}};
},
- std::move(joined->first.u.u), std::move(joined->second.u.u))};
+ std::move(converted->first.u.u), std::move(converted->second.u.u))};
}
return std::nullopt;
}
projects / platform / upstream / llvm.git / commitdiff