From fef7fcd45f1b8f0af067c853a5387bea5128f3cc Mon Sep 17 00:00:00 2001
From: peter klausler <pklausler@nvidia.com>
Date: Fri, 1 Feb 2019 13:37:49 -0800
Subject: [PATCH] [flang] More value semantics in Constant<> and
 GetScalarConstantValue

Original-commit: flang-compiler/f18@c7acce46854f815e2a1c53d385d8c39bae23098e
Reviewed-on: https://github.com/flang-compiler/f18/pull/271
Tree-same-pre-rewrite: false
---
 flang/lib/evaluate/constant.cc   | 14 ++++++++++++++
 flang/lib/evaluate/constant.h    | 42 ++++++++++++++++++----------------------
 flang/lib/evaluate/expression.cc |  2 +-
 flang/lib/evaluate/fold.cc       | 18 ++++++++---------
 flang/lib/evaluate/fold.h        | 28 +++++++++++++++++----------
 flang/lib/evaluate/type.h        |  8 +++++---
 flang/test/evaluate/folding.cc   |  6 +++---
 7 files changed, 69 insertions(+), 49 deletions(-)

diff --git a/flang/lib/evaluate/constant.cc b/flang/lib/evaluate/constant.cc
index 2cde28b..3350649 100644
--- a/flang/lib/evaluate/constant.cc
+++ b/flang/lib/evaluate/constant.cc
@@ -65,6 +65,20 @@ std::ostream &Constant<T>::AsFortran(std::ostream &o) const {
   return o;
 }
 
+template<typename T>
+auto Constant<T>::At(const std::vector<std::int64_t> &index) const -> Value {
+  CHECK(index.size() == static_cast<std::size_t>(Rank()));
+  std::int64_t stride{1}, offset{0};
+  int dim{0};
+  for (std::int64_t j : index) {
+    std::int64_t bound{shape_[dim++]};
+    CHECK(j >= 1 && j <= bound);
+    offset += stride * (j - 1);
+    stride *= bound;
+  }
+  return values_.at(offset);
+}
+
 template<typename T> Constant<SubscriptInteger> Constant<T>::SHAPE() const {
   using IntType = Scalar<SubscriptInteger>;
   std::vector<IntType> result;
diff --git a/flang/lib/evaluate/constant.h b/flang/lib/evaluate/constant.h
index 7af13f9..5c73f96 100644
--- a/flang/lib/evaluate/constant.h
+++ b/flang/lib/evaluate/constant.h
@@ -19,6 +19,7 @@
 #include <ostream>
 
 namespace Fortran::evaluate {
+
 // Wraps a constant value in a class templated by its resolved type.
 // N.B. Generic constants are represented by generic expressions
 // (like Expr<SomeInteger> & Expr<SomeType>) wrapping the appropriate
@@ -43,35 +44,17 @@ public:
   bool operator==(const Constant &that) const {
     return shape_ == that.shape_ && values_ == that.values_;
   }
+  bool empty() const { return values_.empty(); }
   std::size_t size() const { return values_.size(); }
   const std::vector<std::int64_t> &shape() const { return shape_; }
-  std::int64_t LEN() const {
-    if constexpr (T::category != TypeCategory::Character) {
-      common::die("LEN() of non-character Constant");
-    } else if (values_.empty()) {
-      return 0;
-    } else {
-      return static_cast<std::int64_t>(values_[0].size());
-    }
-  }
 
-  const Value &operator*() const {
+  Value operator*() const {
     CHECK(values_.size() == 1);
     return values_.at(0);
   }
 
-  const Value &At(const std::vector<std::int64_t> &index) {
-    CHECK(index.size() == static_cast<std::size_t>(Rank()));
-    std::int64_t stride{1}, offset{0};
-    int dim{0};
-    for (std::int64_t j : index) {
-      std::int64_t bound{shape_[dim++]};
-      CHECK(j >= 1 && j <= bound);
-      offset += stride * (j - 1);
-      stride *= bound;
-    }
-    return values_.at(offset);
-  }
+  // Apply 1-based subscripts
+  Value At(const std::vector<std::int64_t> &) const;
 
   Constant<SubscriptInteger> SHAPE() const;
   std::ostream &AsFortran(std::ostream &) const;
@@ -79,9 +62,22 @@ public:
 private:
   std::vector<Value> values_;
   std::vector<std::int64_t> shape_;
-  // TODO pmk: make CHARACTER values contiguous
+  // TODO pmk: make CHARACTER values contiguous (they're strings now)
 };
 
+// Would prefer to have this be a member function of Constant enabled
+// only for CHARACTER, but std::enable_if<> isn't effective in that context.
+template<int KIND>
+std::int64_t ConstantLEN(
+    const Constant<Type<TypeCategory::Character, KIND>> &c) {
+  if (c.empty()) {
+    return 0;
+  } else {
+    std::vector<std::int64_t> ones(c.Rank(), 1);
+    return c.At(ones).size();
+  }
+}
+
 FOR_EACH_INTRINSIC_KIND(extern template class Constant)
 }
 #endif  // FORTRAN_EVALUATE_CONSTANT_H_
diff --git a/flang/lib/evaluate/expression.cc b/flang/lib/evaluate/expression.cc
index 5123bca..114250c 100644
--- a/flang/lib/evaluate/expression.cc
+++ b/flang/lib/evaluate/expression.cc
@@ -150,7 +150,7 @@ Expr<SubscriptInteger> Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
   return std::visit(
       common::visitors{
           [](const Constant<Result> &c) {
-            return AsExpr(Constant<SubscriptInteger>{c.LEN()});
+            return AsExpr(Constant<SubscriptInteger>{ConstantLEN(c)});
           },
           [](const ArrayConstructor<Result> &a) { return a.LEN(); },
           [](const Parentheses<Result> &x) { return x.left().LEN(); },
diff --git a/flang/lib/evaluate/fold.cc b/flang/lib/evaluate/fold.cc
index 3f6852f..d24e07e 100644
--- a/flang/lib/evaluate/fold.cc
+++ b/flang/lib/evaluate/fold.cc
@@ -191,7 +191,7 @@ Expr<T> FoldOperation(FoldingContext &context, Designator<T> &&designator) {
   if constexpr (T::category == TypeCategory::Character) {
     if (auto *substring{common::Unwrap<Substring>(designator.u)}) {
       if (std::optional<Expr<SomeCharacter>> folded{substring->Fold(context)}) {
-        if (const auto *value{GetScalarConstantValue<T>(*folded)}) {
+        if (auto value{GetScalarConstantValue<T>(*folded)}) {
           return Expr<T>{*value};
         }
       }
@@ -304,7 +304,7 @@ Expr<T> FoldOperation(FoldingContext &context, ArrayConstructor<T> &&array) {
   return result;
 }
 
-// TODO this specializations is a placeholder: don't fold array constructors
+// TODO this specialization is a placeholder: don't fold array constructors
 // of derived type for now
 Expr<SomeDerived> FoldOperation(
     FoldingContext &context, ArrayConstructor<SomeDerived> &&array) {
@@ -358,7 +358,7 @@ Expr<TO> FoldOperation(
         kindExpr = Fold(context, std::move(kindExpr));
         using Operand = ResultType<decltype(kindExpr)>;
         char buffer[64];
-        if (const auto *value{GetScalarConstantValue<Operand>(kindExpr)}) {
+        if (auto value{GetScalarConstantValue<Operand>(kindExpr)}) {
           if constexpr (TO::category == TypeCategory::Integer) {
             if constexpr (Operand::category == TypeCategory::Integer) {
               auto converted{Scalar<TO>::ConvertSigned(*value)};
@@ -417,7 +417,7 @@ template<typename T>
 Expr<T> FoldOperation(FoldingContext &context, Parentheses<T> &&x) {
   auto &operand{x.left()};
   operand = Fold(context, std::move(operand));
-  if (const auto *value{GetScalarConstantValue<T>(operand)}) {
+  if (auto value{GetScalarConstantValue<T>(operand)}) {
     // Preserve parentheses, even around constants.
     return Expr<T>{Parentheses<T>{Expr<T>{Constant<T>{*value}}}};
   }
@@ -428,7 +428,7 @@ template<typename T>
 Expr<T> FoldOperation(FoldingContext &context, Negate<T> &&x) {
   auto &operand{x.left()};
   operand = Fold(context, std::move(operand));
-  if (const auto *value{GetScalarConstantValue<T>(operand)}) {
+  if (auto value{GetScalarConstantValue<T>(operand)}) {
     if constexpr (T::category == TypeCategory::Integer) {
       auto negated{value->Negate()};
       if (negated.overflow) {
@@ -451,7 +451,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldOperation(
   using Part = Type<TypeCategory::Real, KIND>;
   auto &operand{x.left()};
   operand = Fold(context, std::move(operand));
-  if (const auto *value{GetScalarConstantValue<Operand>(operand)}) {
+  if (auto value{GetScalarConstantValue<Operand>(operand)}) {
     if (x.isImaginaryPart) {
       return Expr<Part>{Constant<Part>{value->AIMAG()}};
     } else {
@@ -467,7 +467,7 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldOperation(
   using Ty = Type<TypeCategory::Logical, KIND>;
   auto &operand{x.left()};
   operand = Fold(context, std::move(operand));
-  if (const auto *value{GetScalarConstantValue<Ty>(operand)}) {
+  if (auto value{GetScalarConstantValue<Ty>(operand)}) {
     return Expr<Ty>{Constant<Ty>{value->IsTrue()}};
   }
   return Expr<Ty>{x};
@@ -480,8 +480,8 @@ std::optional<std::pair<Scalar<T1>, Scalar<T2>>> FoldOperands(
     FoldingContext &context, Expr<T1> &x, Expr<T2> &y) {
   x = Fold(context, std::move(x));  // use of std::move() on &x is intentional
   y = Fold(context, std::move(y));
-  if (const auto *xvalue{GetScalarConstantValue<T1>(x)}) {
-    if (const auto *yvalue{GetScalarConstantValue<T2>(y)}) {
+  if (auto xvalue{GetScalarConstantValue<T1>(x)}) {
+    if (auto yvalue{GetScalarConstantValue<T2>(y)}) {
       return {std::make_pair(*xvalue, *yvalue)};
     }
   }
diff --git a/flang/lib/evaluate/fold.h b/flang/lib/evaluate/fold.h
index 6f99bab..469091d 100644
--- a/flang/lib/evaluate/fold.h
+++ b/flang/lib/evaluate/fold.h
@@ -50,35 +50,44 @@ std::optional<Expr<T>> Fold(
 // GetScalarConstantValue() isolates the known constant value of
 // an expression, if it has one.  The value can be parenthesized.
 template<typename T>
-const Scalar<T> *GetScalarConstantValue(const Expr<T> &expr) {
+std::optional<Scalar<T>> GetScalarConstantValue(const Expr<T> &expr) {
   if (const auto *c{UnwrapExpr<Constant<T>>(expr)}) {
     if (c->size() == 1) {
-      return &**c;
+      return **c;
     } else {
-      return nullptr;
+      return std::nullopt;
     }
   } else if (const auto *parens{UnwrapExpr<Parentheses<T>>(expr)}) {
     return GetScalarConstantValue<T>(parens->left());
   } else {
-    return nullptr;
+    return std::nullopt;
   }
 }
 
 template<typename T>
-const Scalar<T> *GetScalarConstantValue(
+std::optional<Scalar<T>> GetScalarConstantValue(
     const Expr<SomeKind<T::category>> &expr) {
   if (const auto *kindExpr{UnwrapExpr<Expr<T>>(expr)}) {
     return GetScalarConstantValue<T>(*kindExpr);
   }
-  return nullptr;
+  return std::nullopt;
 }
 
 template<typename T>
-const Scalar<T> *GetScalarConstantValue(const Expr<SomeType> &expr) {
+std::optional<Scalar<T>> GetScalarConstantValue(const Expr<SomeType> &expr) {
   if (const auto *kindExpr{UnwrapExpr<Expr<T>>(expr)}) {
     return GetScalarConstantValue<T>(*kindExpr);
   }
-  return nullptr;
+  return std::nullopt;
+}
+
+template<typename T, typename A>
+std::optional<Scalar<T>> GetScalarConstantValue(const std::optional<A> &expr) {
+  if (expr.has_value()) {
+    return GetScalarConstantValue(*expr);
+  } else {
+    return std::nullopt;
+  }
 }
 
 // Predicate: true when an expression is a constant expression (in the
@@ -92,8 +101,7 @@ bool IsConstantExpr(const Expr<SomeType> &);
 template<int KIND>
 std::optional<std::int64_t> ToInt64(
     const Expr<Type<TypeCategory::Integer, KIND>> &expr) {
-  using Ty = Type<TypeCategory::Integer, KIND>;
-  if (const Scalar<Ty> *scalar{GetScalarConstantValue(expr)}) {
+  if (auto scalar{GetScalarConstantValue(expr)}) {
     return {scalar->ToInt64()};
   } else {
     return std::nullopt;
diff --git a/flang/lib/evaluate/type.h b/flang/lib/evaluate/type.h
index 5f3fb30a..1fc5a6a 100644
--- a/flang/lib/evaluate/type.h
+++ b/flang/lib/evaluate/type.h
@@ -53,9 +53,11 @@ using LogicalResult = Type<TypeCategory::Logical, 1>;
 using LargestReal = Type<TypeCategory::Real, 16>;
 
 // DynamicType is suitable for use as the result type for
-// GetType() functions and member functions.  It does *not*
-// hold CHARACTER length type parameter expressions -- those
-// must be derived via LEN() member functions or packaged
+// GetType() functions and member functions; consequently,
+// it must be capable of being used in a constexpr context.
+// So it does *not* hold anything requiring a destructor,
+// such as a CHARACTER length type parameter expression.
+// Those must be derived via LEN() member functions or packaged
 // elsewhere (e.g. as in ArrayConstructor).
 struct DynamicType {
   bool operator==(const DynamicType &) const;
diff --git a/flang/test/evaluate/folding.cc b/flang/test/evaluate/folding.cc
index 7c15d53..e0808d1 100644
--- a/flang/test/evaluate/folding.cc
+++ b/flang/test/evaluate/folding.cc
@@ -32,9 +32,9 @@ struct TestGetScalarConstantValue {
     Expr<T> exprFullyTyped{Constant<T>{Scalar<T>{}}};
     Expr<SomeKind<T::category>> exprSomeKind{exprFullyTyped};
     Expr<SomeType> exprSomeType{exprSomeKind};
-    TEST(GetScalarConstantValue<T>(exprFullyTyped) != nullptr);
-    TEST(GetScalarConstantValue<T>(exprSomeKind) != nullptr);
-    TEST(GetScalarConstantValue<T>(exprSomeType) != nullptr);
+    TEST(GetScalarConstantValue<T>(exprFullyTyped).has_value());
+    TEST(GetScalarConstantValue<T>(exprSomeKind).has_value());
+    TEST(GetScalarConstantValue<T>(exprSomeType).has_value());
   }
 };
 
-- 
2.7.4