From a99e9c99f3e983d6de2a6fab377b6ef922e0ba89 Mon Sep 17 00:00:00 2001
From: peter klausler <pklausler@nvidia.com>
Date: Wed, 24 Oct 2018 14:06:46 -0700
Subject: [PATCH] [flang] complete new Fold

Original-commit: flang-compiler/f18@4d1726778f193c8813a8cc63fad0b46faf8d2fec
Reviewed-on: https://github.com/flang-compiler/f18/pull/219
Tree-same-pre-rewrite: false
---
 flang/lib/evaluate/common.h     |  32 +++++++++
 flang/lib/evaluate/expression.h |  10 ++-
 flang/lib/evaluate/fold.h       | 139 ++++++++++++++++++++++++++++++----------
 3 files changed, 143 insertions(+), 38 deletions(-)

diff --git a/flang/lib/evaluate/common.h b/flang/lib/evaluate/common.h
index 785068c..701c58b 100644
--- a/flang/lib/evaluate/common.h
+++ b/flang/lib/evaluate/common.h
@@ -16,6 +16,7 @@
 #define FORTRAN_EVALUATE_COMMON_H_
 
 #include "../common/enum-set.h"
+#include "../common/fortran.h"
 #include "../common/idioms.h"
 #include "../common/indirection.h"
 #include "../parser/message.h"
@@ -23,6 +24,8 @@
 
 namespace Fortran::evaluate {
 
+using common::RelationalOperator;
+
 // Integers are always ordered; reals may not be.
 ENUM_CLASS(Ordering, Less, Equal, Greater)
 ENUM_CLASS(Relation, Less, Equal, Greater, Unordered)
@@ -67,6 +70,35 @@ static constexpr Relation Reverse(Relation relation) {
   }
 }
 
+static constexpr bool Satisfies(RelationalOperator op, Ordering order) {
+  switch (order) {
+  case Ordering::Less:
+    return op == RelationalOperator::LT || op == RelationalOperator::LE ||
+        op == RelationalOperator::NE;
+  case Ordering::Equal:
+    return op == RelationalOperator::LE || op == RelationalOperator::EQ ||
+        op == RelationalOperator::GE;
+  case Ordering::Greater:
+    return op == RelationalOperator::NE || op == RelationalOperator::GE ||
+        op == RelationalOperator::GT;
+  }
+}
+
+static constexpr bool Satisfies(RelationalOperator op, Relation relation) {
+  switch (relation) {
+  case Relation::Less:
+    return op == RelationalOperator::LT || op == RelationalOperator::LE ||
+        op == RelationalOperator::NE;
+  case Relation::Equal:
+    return op == RelationalOperator::LE || op == RelationalOperator::EQ ||
+        op == RelationalOperator::GE;
+  case Relation::Greater:
+    return op == RelationalOperator::NE || op == RelationalOperator::GE ||
+        op == RelationalOperator::GT;
+  case Relation::Unordered: return false;
+  }
+}
+
 ENUM_CLASS(
     RealFlag, Overflow, DivideByZero, InvalidArgument, Underflow, Inexact)
 
diff --git a/flang/lib/evaluate/expression.h b/flang/lib/evaluate/expression.h
index d3f0042..1030dfc 100644
--- a/flang/lib/evaluate/expression.h
+++ b/flang/lib/evaluate/expression.h
@@ -529,9 +529,12 @@ FOR_EACH_CHARACTER_KIND(extern template class Expr)
 
 template<typename A>
 struct Relational : public Operation<Relational<A>, LogicalResult, A, A> {
+  using Result = LogicalResult;
   using Base = Operation<Relational, LogicalResult, A, A>;
-  using typename Base::Result;
   using Operand = typename Base::template Operand<0>;
+  static_assert(Operand::category == TypeCategory::Integer ||
+      Operand::category == TypeCategory::Real ||
+      Operand::category == TypeCategory::Character);
   CLASS_BOILERPLATE(Relational)
   Relational(
       RelationalOperator r, const Expr<Operand> &a, const Expr<Operand> &b)
@@ -570,8 +573,9 @@ FOR_EACH_CHARACTER_KIND(extern template struct Relational)
 extern template struct Relational<SomeType>;
 
 // Logical expressions of a kind bigger than LogicalResult
-// do not include Relational<> operations as possibilities
-// since their results are always LogicalResult (kind=1).
+// do not include Relational<> operations as possibilities,
+// since the results of Relationals are always LogicalResult
+// (kind=1).
 template<int KIND>
 class Expr<Type<TypeCategory::Logical, KIND>>
   : public ExpressionBase<Type<TypeCategory::Logical, KIND>> {
diff --git a/flang/lib/evaluate/fold.h b/flang/lib/evaluate/fold.h
index 4e3dc75..d148dcc 100644
--- a/flang/lib/evaluate/fold.h
+++ b/flang/lib/evaluate/fold.h
@@ -36,45 +36,11 @@ using namespace Fortran::parser::literals;
 // a canonicalized expression.
 // When the operand is an Expr<A>, the result has the same type.
 
-// Base cases
+// Base no-op case
 template<typename A> Expr<ResultType<A>> Fold(FoldingContext &, A &&x) {
   return Expr<ResultType<A>>{std::move(x)};
 }
 
-template<typename A> Expr<A> Fold(FoldingContext &context, Expr<A> &&expr) {
-  static_assert(A::isSpecificIntrinsicType);
-  return std::visit(
-      [&](auto &&x) -> Expr<A> { return Fold(context, std::move(x)); },
-      std::move(expr.u));
-}
-
-template<TypeCategory CAT>
-Expr<SomeKind<CAT>> Fold(FoldingContext &context, Expr<SomeKind<CAT>> &&expr) {
-  return std::visit(
-      [&](auto &&x) -> Expr<SomeKind<CAT>> {
-        if constexpr (CAT == TypeCategory::Derived) {
-          return Fold(context, std::move(x));
-        } else {
-          return Expr<SomeKind<CAT>>{Fold(context, std::move(x))};
-        }
-      },
-      std::move(expr.u));
-}
-
-template<>
-inline Expr<SomeType> Fold(FoldingContext &context, Expr<SomeType> &&expr) {
-  return std::visit(
-      [&](auto &&x) -> Expr<SomeType> {
-        if constexpr (std::is_same_v<std::decay_t<decltype(x)>,
-                          BOZLiteralConstant>) {
-          return std::move(expr);
-        } else {
-          return Expr<SomeType>{Fold(context, std::move(x))};
-        }
-      },
-      std::move(expr.u));
-}
-
 // Unary operations
 
 template<typename TO, TypeCategory FROMCAT>
@@ -329,5 +295,108 @@ template<typename T> Expr<T> Fold(FoldingContext &context, Extremum<T> &&x) {
   return Expr<T>{std::move(x)};
 }
 
+template<int KIND>
+Expr<Type<TypeCategory::Complex, KIND>> Fold(
+    FoldingContext &context, ComplexConstructor<KIND> &&x) {
+  using COMPLEX = Type<TypeCategory::Complex, KIND>;
+  if (auto folded{FoldOperands(context, x.left(), x.right())}) {
+    return Expr<COMPLEX>{
+        Constant<COMPLEX>{Scalar<COMPLEX>{folded->first, folded->second}}};
+  }
+  return Expr<COMPLEX>{std::move(x)};
+}
+
+template<int KIND>
+Expr<Type<TypeCategory::Character, KIND>> Fold(
+    FoldingContext &context, Concat<KIND> &&x) {
+  using CHAR = Type<TypeCategory::Character, KIND>;
+  if (auto folded{FoldOperands(context, x.left(), x.right())}) {
+    return Expr<CHAR>{Constant<CHAR>{folded->first + folded->second}};
+  }
+  return Expr<CHAR>{std::move(x)};
+}
+
+template<typename T>
+Expr<LogicalResult> FoldRelational(
+    FoldingContext &context, Relational<T> &&relation) {
+  if (auto folded{FoldOperands(context, relation.left(), relation.right())}) {
+    bool result{};
+    if constexpr (T::category == TypeCategory::Integer) {
+      result =
+          Satisfies(relation.opr, folded->first.CompareSigned(folded->second));
+    } else if constexpr (T::category == TypeCategory::Real) {
+      result = Satisfies(relation.opr, folded->first.Compare(folded->second));
+    } else if constexpr (T::category == TypeCategory::Character) {
+      result = Satisfies(relation.opr, Compare(folded->first, folded->second));
+    } else {
+      static_assert(T::category != TypeCategory::Complex &&
+          T::category != TypeCategory::Logical);
+    }
+    return Expr<LogicalResult>{Constant<LogicalResult>{result}};
+  }
+  return Expr<LogicalResult>{Relational<SomeType>{std::move(relation)}};
+}
+
+template<>
+inline Expr<LogicalResult> Fold(
+    FoldingContext &context, Relational<SomeType> &&relation) {
+  return std::visit(
+      [&](auto &&x) {
+        return Expr<LogicalResult>{FoldRelational(context, std::move(x))};
+      },
+      std::move(relation.u));
+}
+
+template<int KIND>
+Expr<Type<TypeCategory::Logical, KIND>> Fold(
+    FoldingContext &context, LogicalOperation<KIND> &&x) {
+  using LOGICAL = Type<TypeCategory::Logical, KIND>;
+  if (auto folded{FoldOperands(context, x.left(), x.right())}) {
+    bool xt{folded->first.IsTrue()}, yt{folded->second.IsTrue()}, result{};
+    switch (x.logicalOperator) {
+    case LogicalOperator::And: result = xt && yt; break;
+    case LogicalOperator::Or: result = xt || yt; break;
+    case LogicalOperator::Eqv: result = xt == yt; break;
+    case LogicalOperator::Neqv: result = xt != yt; break;
+    }
+    return Expr<LOGICAL>{Constant<LOGICAL>{result}};
+  }
+  return Expr<LOGICAL>{std::move(x)};
+}
+
+template<typename A> Expr<A> Fold(FoldingContext &context, Expr<A> &&expr) {
+  static_assert(A::isSpecificIntrinsicType);
+  return std::visit(
+      [&](auto &&x) -> Expr<A> { return Fold(context, std::move(x)); },
+      std::move(expr.u));
+}
+
+template<TypeCategory CAT>
+Expr<SomeKind<CAT>> Fold(FoldingContext &context, Expr<SomeKind<CAT>> &&expr) {
+  return std::visit(
+      [&](auto &&x) -> Expr<SomeKind<CAT>> {
+        if constexpr (CAT == TypeCategory::Derived) {
+          return Fold(context, std::move(x));
+        } else {
+          return Expr<SomeKind<CAT>>{Fold(context, std::move(x))};
+        }
+      },
+      std::move(expr.u));
+}
+
+template<>
+inline Expr<SomeType> Fold(FoldingContext &context, Expr<SomeType> &&expr) {
+  return std::visit(
+      [&](auto &&x) -> Expr<SomeType> {
+        if constexpr (std::is_same_v<std::decay_t<decltype(x)>,
+                          BOZLiteralConstant>) {
+          return std::move(expr);
+        } else {
+          return Expr<SomeType>{Fold(context, std::move(x))};
+        }
+      },
+      std::move(expr.u));
+}
+
 }  // namespace Fortran::evaluate
 #endif  // FORTRAN_EVALUATE_FOLD_H_
-- 
2.7.4