[flang] Rework Constant<character>

Original-commit: flang-compiler/f18@fc807bfd7d93895b4f097fae9974d11cd8cc170b
Reviewed-on: https://github.com/flang-compiler/f18/pull/287
Tree-same-pre-rewrite: false

diff --git a/flang/lib/common/idioms.h b/flang/lib/common/idioms.h
index a71a6c1..127df70 100644 (file)
--- a/flang/lib/common/idioms.h
+++ b/flang/lib/common/idioms.h
@@ -133,5 +133,9 @@ template<typename A> struct ListItemCount {
     return Fortran::common::EnumIndexToString( \
         static_cast<int>(e), #__VA_ARGS__); \
   }
+
+// Given a const reference to a value, return a copy of the value.
+
+template<typename A> A Clone(const A &x) { return x; }
 }
 #endif  // FORTRAN_COMMON_IDIOMS_H_

diff --git a/flang/lib/evaluate/constant.cc b/flang/lib/evaluate/constant.cc
index 3da6b7e..ce31682 100644 (file)
--- a/flang/lib/evaluate/constant.cc
+++ b/flang/lib/evaluate/constant.cc
@@ -16,12 +16,26 @@
 #include "expression.h"
 #include "type.h"
 #include "../parser/characters.h"
+#include <algorithm>
 
 namespace Fortran::evaluate {
 
 template<typename RESULT, typename VALUE>
 ConstantBase<RESULT, VALUE>::~ConstantBase() {}
 
+static void ShapeAsFortran(
+    std::ostream &o, const std::vector<std::int64_t> &shape) {
+  if (shape.size() > 1) {
+    o << ",shape=";
+    char ch{'['};
+    for (auto dim : shape) {
+      o << ch << dim;
+      ch = ',';
+    }
+    o << "])";
+  }
+}
+
 template<typename RESULT, typename VALUE>
 std::ostream &ConstantBase<RESULT, VALUE>::AsFortran(std::ostream &o) const {
   if (Rank() > 1) {
@@ -58,43 +72,116 @@ std::ostream &ConstantBase<RESULT, VALUE>::AsFortran(std::ostream &o) const {
   if (Rank() > 0) {
     o << ']';
   }
-  if (Rank() > 1) {
-    o << ",shape=";
-    char ch{'['};
-    for (auto dim : shape_) {
-      o << ch << dim;
-      ch = ',';
-    }
-    o << "])";
-  }
+  ShapeAsFortran(o, shape_);
   return o;
 }
 
-template<typename RESULT, typename VALUE>
-auto ConstantBase<RESULT, VALUE>::At(
-    const std::vector<std::int64_t> &index) const -> Value {
-  CHECK(index.size() == static_cast<std::size_t>(Rank()));
+static std::int64_t SubscriptsToOffset(const std::vector<std::int64_t> &index,
+    const std::vector<std::int64_t> &shape) {
+  CHECK(index.size() == shape.size());
   std::int64_t stride{1}, offset{0};
   int dim{0};
   for (std::int64_t j : index) {
-    std::int64_t bound{shape_[dim++]};
+    std::int64_t bound{shape[dim++]};
     CHECK(j >= 1 && j <= bound);
     offset += stride * (j - 1);
     stride *= bound;
   }
-  return values_.at(offset);
+  return offset;
 }
 
 template<typename RESULT, typename VALUE>
-Constant<SubscriptInteger> ConstantBase<RESULT, VALUE>::SHAPE() const {
+auto ConstantBase<RESULT, VALUE>::At(
+    const std::vector<std::int64_t> &index) const -> ScalarValue {
+  return values_.at(SubscriptsToOffset(index, shape_));
+}
+
+static Constant<SubscriptInteger> ShapeAsConstant(
+    const std::vector<std::int64_t> &shape) {
   using IntType = Scalar<SubscriptInteger>;
   std::vector<IntType> result;
-  for (std::int64_t dim : shape_) {
+  for (std::int64_t dim : shape) {
     result.emplace_back(dim);
   }
-  return {std::move(result), std::vector<std::int64_t>{Rank()}};
+  return {std::move(result),
+      std::vector<std::int64_t>{static_cast<std::int64_t>(shape.size())}};
+}
+
+template<typename RESULT, typename VALUE>
+Constant<SubscriptInteger> ConstantBase<RESULT, VALUE>::SHAPE() const {
+  return ShapeAsConstant(shape_);
+}
+
+// Constant<Type<TypeCategory::Character, KIND>  specializations
+
+template<int KIND>
+Constant<Type<TypeCategory::Character, KIND>>::Constant(const ScalarValue &str)
+  : values_{str}, length_{static_cast<std::int64_t>(values_.size())} {}
+
+template<int KIND>
+Constant<Type<TypeCategory::Character, KIND>>::Constant(ScalarValue &&str)
+  : values_{std::move(str)}, length_{
+                                 static_cast<std::int64_t>(values_.size())} {}
+
+template<int KIND>
+Constant<Type<TypeCategory::Character, KIND>>::Constant(std::int64_t len,
+    std::vector<ScalarValue> &&strings, std::vector<std::int64_t> &&dims)
+  : length_{len} {
+  values_.assign(strings.size() * length_,
+      static_cast<typename ScalarValue::value_type>(' '));
+  std::int64_t at{0};
+  for (const auto &str : strings) {
+    values_.replace(
+        at, std::min(length_, static_cast<std::int64_t>(str.size())), str);
+    at += length_;
+  }
+  CHECK(at == static_cast<std::int64_t>(values_.size()));
 }
 
+template<int KIND> Constant<Type<TypeCategory::Character, KIND>>::~Constant() {}
+
+template<int KIND>
+auto Constant<Type<TypeCategory::Character, KIND>>::At(
+    const std::vector<std::int64_t> &index) const -> ScalarValue {
+  auto offset{SubscriptsToOffset(index, shape_)};
+  return values_.substr(offset, length_);
+}
+
+template<int KIND>
+Constant<SubscriptInteger>
+Constant<Type<TypeCategory::Character, KIND>>::SHAPE() const {
+  return ShapeAsConstant(shape_);
+}
+
+template<int KIND>
+std::ostream &Constant<Type<TypeCategory::Character, KIND>>::AsFortran(
+    std::ostream &o) const {
+  if (Rank() > 1) {
+    o << "reshape(";
+  }
+  if (Rank() > 0) {
+    o << '[' << GetType().AsFortran() << "::";
+  }
+  bool first{true};
+  auto total{static_cast<std::int64_t>(size())};
+  for (std::int64_t at{0}; at < total; at += length_) {
+    ScalarValue value{values_.substr(at, length_)};
+    if (first) {
+      first = false;
+    } else {
+      o << ',';
+    }
+    o << Result::kind << '_' << parser::QuoteCharacterLiteral(value);
+  }
+  if (Rank() > 0) {
+    o << ']';
+  }
+  ShapeAsFortran(o, shape_);
+  return o;
+}
+
+// Constant<SomeDerived> specialization
+
 Constant<SomeDerived>::Constant(const StructureConstructor &x)
   : Base{x.values()}, derivedTypeSpec_{&x.derivedTypeSpec()} {}
 
@@ -118,7 +205,7 @@ Constant<SomeDerived>::Constant(const semantics::DerivedTypeSpec &spec,
     std::vector<StructureConstructor> &&x, std::vector<std::int64_t> &&s)
   : Base{GetValues(std::move(x)), std::move(s)}, derivedTypeSpec_{&spec} {}
 
-FOR_EACH_INTRINSIC_KIND(template class ConstantBase)
+FOR_EACH_LENGTHLESS_INTRINSIC_KIND(template class ConstantBase)
 template class ConstantBase<SomeDerived, StructureConstructorValues>;
 FOR_EACH_INTRINSIC_KIND(template class Constant)
 }

diff --git a/flang/lib/evaluate/constant.h b/flang/lib/evaluate/constant.h
index 11fad03..add1f96 100644 (file)
--- a/flang/lib/evaluate/constant.h
+++ b/flang/lib/evaluate/constant.h
@@ -22,23 +22,31 @@
 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
-// instantiations of Constant.
+// This Constant<> template class should be instantiated only for
+// concrete intrinsic types and SomeDerived.  There is no instance
+// Constant<Expr<SomeType>> since there is no way to constrain each
+// element of its array to hold the same type.  To represent a generic
+// constants, use a generic expression like Expr<SomeInteger> &
+// Expr<SomeType>) to wrap the appropriate instantiation of Constant<>.
 
 template<typename> class Constant;
 
-template<typename RESULT, typename VALUE = Scalar<RESULT>> class ConstantBase {
+// Constant<> is specialized for Character kinds and SomeDerived.
+// The non-Character intrinsic types, and SomeDerived, share enough
+// common behavior that they use this common base class.
+template<typename RESULT, typename SCALAR = Scalar<RESULT>> class ConstantBase {
+  static_assert(RESULT::category != TypeCategory::Character);
+
 public:
   using Result = RESULT;
-  using Value = VALUE;
+  using ScalarValue = SCALAR;
 
   template<typename A> ConstantBase(const A &x) : values_{x} {}
   template<typename A>
   ConstantBase(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
     : values_{std::move(x)} {}
-  ConstantBase(std::vector<Value> &&x, std::vector<std::int64_t> &&s)
-    : values_(std::move(x)), shape_(std::move(s)) {}
+  ConstantBase(std::vector<ScalarValue> &&x, std::vector<std::int64_t> &&dims)
+    : values_(std::move(x)), shape_(std::move(dims)) {}
   ~ConstantBase();
 
   int Rank() const { return static_cast<int>(shape_.size()); }
@@ -49,19 +57,19 @@ public:
   std::size_t size() const { return values_.size(); }
   const std::vector<std::int64_t> &shape() const { return shape_; }
 
-  Value operator*() const {
+  ScalarValue operator*() const {
     CHECK(values_.size() == 1);
     return values_.at(0);
   }
 
   // Apply 1-based subscripts
-  Value At(const std::vector<std::int64_t> &) const;
+  ScalarValue At(const std::vector<std::int64_t> &) const;
 
   Constant<SubscriptInteger> SHAPE() const;
   std::ostream &AsFortran(std::ostream &) const;
 
 protected:
-  std::vector<Value> values_;
+  std::vector<ScalarValue> values_;
   std::vector<std::int64_t> shape_;
 
 private:
@@ -75,27 +83,49 @@ private:
 template<typename T> class Constant : public ConstantBase<T> {
 public:
   using Result = T;
-  using ConstantBase<Result>::ConstantBase;
+  using ScalarValue = Scalar<Result>;
+  using ConstantBase<Result, ScalarValue>::ConstantBase;
   CLASS_BOILERPLATE(Constant)
   static constexpr DynamicType GetType() { return Result::GetType(); }
 };
 
-template<int KIND>
-class Constant<Type<TypeCategory::Character, KIND>>
-  : public ConstantBase<Type<TypeCategory::Character, KIND>> {
+template<int KIND> class Constant<Type<TypeCategory::Character, KIND>> {
 public:
   using Result = Type<TypeCategory::Character, KIND>;
-  using ConstantBase<Result>::ConstantBase;
+  using ScalarValue = Scalar<Result>;
   CLASS_BOILERPLATE(Constant)
-  static constexpr DynamicType GetType() { return Result::GetType(); }
-  std::int64_t LEN() const {
-    if (this->values_.empty()) {
-      return 0;
-    } else {
-      return static_cast<std::int64_t>(this->values_.front().size());
-    }
+  explicit Constant(const ScalarValue &);
+  explicit Constant(ScalarValue &&);
+  Constant(
+      std::int64_t, std::vector<ScalarValue> &&, std::vector<std::int64_t> &&);
+  ~Constant();
+
+  int Rank() const { return static_cast<int>(shape_.size()); }
+  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() / length_; }
+  const std::vector<std::int64_t> &shape() const { return shape_; }
+
+  std::int64_t LEN() const { return length_; }
+
+  ScalarValue operator*() const {
+    CHECK(static_cast<std::int64_t>(values_.size()) == length_);
+    return values_;
   }
-  // TODO pmk: make CHARACTER values contiguous (they're strings now)
+
+  // Apply 1-based subscripts
+  ScalarValue At(const std::vector<std::int64_t> &) const;
+
+  Constant<SubscriptInteger> SHAPE() const;
+  std::ostream &AsFortran(std::ostream &) const;
+  static constexpr DynamicType GetType() { return Result::GetType(); }
+
+private:
+  ScalarValue values_;  // one contiguous string
+  std::int64_t length_;
+  std::vector<std::int64_t> shape_;
 };
 
 using StructureConstructorValues =
@@ -109,7 +139,7 @@ public:
   using Base = ConstantBase<Result, StructureConstructorValues>;
   Constant(const StructureConstructor &);
   Constant(StructureConstructor &&);
-  Constant(const semantics::DerivedTypeSpec &, std::vector<Value> &&,
+  Constant(const semantics::DerivedTypeSpec &, std::vector<ScalarValue> &&,
       std::vector<std::int64_t> &&);
   Constant(const semantics::DerivedTypeSpec &,
       std::vector<StructureConstructor> &&, std::vector<std::int64_t> &&);
@@ -127,7 +157,7 @@ private:
   const semantics::DerivedTypeSpec *derivedTypeSpec_;
 };
 
-FOR_EACH_INTRINSIC_KIND(extern template class ConstantBase)
+FOR_EACH_LENGTHLESS_INTRINSIC_KIND(extern template class ConstantBase)
 extern template class ConstantBase<SomeDerived, StructureConstructorValues>;
 FOR_EACH_INTRINSIC_KIND(extern template class Constant)
 }

diff --git a/flang/lib/evaluate/fold.cc b/flang/lib/evaluate/fold.cc
index 116fd64..39889dc 100644 (file)
--- a/flang/lib/evaluate/fold.cc
+++ b/flang/lib/evaluate/fold.cc
@@ -72,7 +72,7 @@ Component FoldOperation(FoldingContext &context, Component &&component) {
 
 Triplet FoldOperation(FoldingContext &context, Triplet &&triplet) {
   return {Fold(context, triplet.lower()), Fold(context, triplet.upper()),
-      Fold(context, Expr<SubscriptInteger>{triplet.stride()})};
+      Fold(context, common::Clone(triplet.stride()))};
 }
 
 Subscript FoldOperation(FoldingContext &context, Subscript &&subscript) {
@@ -234,18 +234,23 @@ public:
       if constexpr (std::is_same_v<T, SomeDerived>) {
         return Expr<T>{Constant<T>{array.derivedTypeSpec(),
             std::move(elements_), std::vector<std::int64_t>{n}}};
+      } else if constexpr (T::category == TypeCategory::Character) {
+        auto length{Fold(context_, common::Clone(array.LEN()))};
+        if (std::optional<std::int64_t> lengthValue{ToInt64(length)}) {
+          return Expr<T>{Constant<T>{*lengthValue, std::move(elements_),
+              std::vector<std::int64_t>{n}}};
+        }
       } else {
         return Expr<T>{
             Constant<T>{std::move(elements_), std::vector<std::int64_t>{n}}};
       }
-    } else {
-      return Expr<T>{std::move(array)};
     }
+    return Expr<T>{std::move(array)};
   }
 
 private:
   bool FoldArray(const CopyableIndirection<Expr<T>> &expr) {
-    Expr<T> folded{Fold(context_, Expr<T>{*expr})};
+    Expr<T> folded{Fold(context_, common::Clone(*expr))};
     if (auto *c{UnwrapExpr<Constant<T>>(folded)}) {
       // Copy elements in Fortran array element order
       std::vector<std::int64_t> shape{c->shape()};

diff --git a/flang/lib/evaluate/tools.h b/flang/lib/evaluate/tools.h
index 6b13ddd..2aa4718 100644 (file)
--- a/flang/lib/evaluate/tools.h
+++ b/flang/lib/evaluate/tools.h
@@ -212,7 +212,7 @@ Expr<TO> ConvertToType(Expr<Type<FROMCAT, FROMKIND>> &&x) {
 
 template<typename TO> Expr<TO> ConvertToType(BOZLiteralConstant &&x) {
   static_assert(IsSpecificIntrinsicType<TO>);
-  using Value = typename Constant<TO>::Value;
+  using Value = typename Constant<TO>::ScalarValue;
   if constexpr (TO::category == TypeCategory::Integer) {
     return Expr<TO>{Constant<TO>{Value::ConvertUnsigned(std::move(x)).value}};
   } else {

diff --git a/flang/lib/evaluate/type.h b/flang/lib/evaluate/type.h
index 28ee0e1..b84786c 100644 (file)
--- a/flang/lib/evaluate/type.h
+++ b/flang/lib/evaluate/type.h
@@ -336,15 +336,18 @@ template<typename CONST> using TypeOf = typename TypeOfHelper<CONST>::type;
 #define FOR_EACH_LOGICAL_KIND(PREFIX) \
   EXPAND_FOR_EACH_LOGICAL_KIND(FOR_EACH_LOGICAL_KIND_HELP, PREFIX)
 
-#define FOR_EACH_INTRINSIC_KIND(PREFIX) \
+#define FOR_EACH_LENGTHLESS_INTRINSIC_KIND(PREFIX) \
   FOR_EACH_INTEGER_KIND(PREFIX) \
   FOR_EACH_REAL_KIND(PREFIX) \
   FOR_EACH_COMPLEX_KIND(PREFIX) \
-  FOR_EACH_CHARACTER_KIND(PREFIX) \
   FOR_EACH_LOGICAL_KIND(PREFIX)
+#define FOR_EACH_INTRINSIC_KIND(PREFIX) \
+  FOR_EACH_LENGTHLESS_INTRINSIC_KIND(PREFIX) \
+  FOR_EACH_CHARACTER_KIND(PREFIX)
 #define FOR_EACH_SPECIFIC_TYPE(PREFIX) \
   FOR_EACH_INTRINSIC_KIND(PREFIX) \
   PREFIX<SomeDerived>;
+
 #define FOR_EACH_CATEGORY_TYPE(PREFIX) \
   PREFIX<SomeInteger>; \
   PREFIX<SomeReal>; \