From a9446d3d40a89a4bbdf61bad92c1eccc599053d8 Mon Sep 17 00:00:00 2001
From: peter klausler <pklausler@nvidia.com>
Date: Thu, 23 Aug 2018 10:55:16 -0700
Subject: [PATCH] [flang] work on numeric operations

Original-commit: flang-compiler/f18@e0ab91914c6f20d0e242e80795c35cc858860449
Reviewed-on: https://github.com/flang-compiler/f18/pull/183
Tree-same-pre-rewrite: false
---
 flang/lib/common/fortran.h        |  4 ++
 flang/lib/evaluate/expression.cc  |  2 +-
 flang/lib/evaluate/expression.h   | 12 +++---
 flang/lib/evaluate/tools.cc       | 80 ++++++++++++++++++++++++++++++++++++---
 flang/lib/evaluate/tools.h        | 63 ++++++++++++++++++++++++------
 flang/lib/semantics/expression.cc | 16 ++------
 6 files changed, 140 insertions(+), 37 deletions(-)

diff --git a/flang/lib/common/fortran.h b/flang/lib/common/fortran.h
index 695d04b..4b2a8fa 100644
--- a/flang/lib/common/fortran.h
+++ b/flang/lib/common/fortran.h
@@ -25,6 +25,10 @@ namespace Fortran::common {
 // 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)
 
diff --git a/flang/lib/evaluate/expression.cc b/flang/lib/evaluate/expression.cc
index a4e3261..1fe6544 100644
--- a/flang/lib/evaluate/expression.cc
+++ b/flang/lib/evaluate/expression.cc
@@ -282,7 +282,7 @@ auto Negate<A>::FoldScalar(FoldingContext &context, const Scalar<Operand> &c)
 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>
diff --git a/flang/lib/evaluate/expression.h b/flang/lib/evaluate/expression.h
index aa66ce2..97e4790 100644
--- a/flang/lib/evaluate/expression.h
+++ b/flang/lib/evaluate/expression.h
@@ -129,16 +129,16 @@ struct ComplexComponent
   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>
diff --git a/flang/lib/evaluate/tools.cc b/flang/lib/evaluate/tools.cc
index c490289..a3a03a8 100644
--- a/flang/lib/evaluate/tools.cc
+++ b/flang/lib/evaluate/tools.cc
@@ -13,14 +13,16 @@
 // 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(
@@ -51,13 +53,16 @@ std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>> ConvertRealOperands(
       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) {
@@ -65,4 +70,67 @@ 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
diff --git a/flang/lib/evaluate/tools.h b/flang/lib/evaluate/tools.h
index 36aba3c..9996a8a 100644
--- a/flang/lib/evaluate/tools.h
+++ b/flang/lib/evaluate/tools.h
@@ -103,13 +103,8 @@ Expr<SomeKind<TC>> ConvertToTypeAndKindOf(
       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(
@@ -125,6 +120,16 @@ void ConvertToSameKind(Expr<SomeKind<CAT>> &x, Expr<SomeKind<CAT>> &y) {
       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");
@@ -132,8 +137,8 @@ template<typename A> Expr<TypeOf<A>> ScalarConstantToExpr(const A &x) {
 }
 
 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>
@@ -145,9 +150,9 @@ Expr<SomeKind<CAT>> SomeKindScalarToExpr(const SomeKindScalar<CAT> &x) {
 
 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>
@@ -155,5 +160,39 @@ Expr<SomeType> ToGenericExpr(Expr<SomeKind<CAT>> &&x) {
   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_
diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc
index 1f97135..ecd26bb 100644
--- a/flang/lib/semantics/expression.cc
+++ b/flang/lib/semantics/expression.cc
@@ -431,7 +431,7 @@ MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Divide &x) {
 
 template<>
 MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Add &x) {
-  // TODO
+  // TODO pmk WIP
   return std::nullopt;
 }
 
@@ -567,16 +567,8 @@ ExpressionAnalyzer::KindParam ExpressionAnalyzer::Analyze(
 
 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)>;
@@ -585,7 +577,7 @@ std::optional<Expr<evaluate::SomeComplex>> ExpressionAnalyzer::ConstructComplex(
           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;
 }
-- 
2.7.4