[flang] take literal substrings out of variable.h

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

flang/lib/evaluate/expression.cc

@@ -58,6 +58,11 @@ template<typename A> std::ostream &Relational<A>::Infix(std::ostream &o) const {
   return o << '.' << EnumToString(opr) << '.';
 }
 
+template<int KIND>
+std::ostream &LiteralSubstring<KIND>::Prefix(std::ostream &o) const {
+  return o << KIND << '_' << parser::QuoteCharacterLiteral(string) << '(';
+}
+
 std::ostream &Relational<SomeType>::Dump(std::ostream &o) const {
   std::visit([&](const auto &rel) { rel.Dump(o); }, u);
   return o;
@@ -81,12 +86,7 @@ template<typename T> std::ostream &Constant<T>::Dump(std::ostream &o) const {
       T::category == TypeCategory::Complex) {
     return o << value.DumpHexadecimal() << '_' << T::kind;
   } else if constexpr (T::category == TypeCategory::Character) {
-    if constexpr (T::kind == 1) {
+    return o << T::kind << '_' << parser::QuoteCharacterLiteral(value);
-      return o << T::kind << '_' << parser::QuoteCharacterLiteral(value);
-    } else {
-      return o << T::kind
-               << "_'(wide character dumping unimplemented)'";  // TODO
-    }
   } else if constexpr (T::category == TypeCategory::Logical) {
     if (value.IsTrue()) {
       o << ".TRUE.";
@@ -149,10 +149,16 @@ std::ostream &ExpressionBase<RESULT>::Dump(std::ostream &o) const {
 }
 
 template<typename T> Expr<SubscriptInteger> ArrayConstructor<T>::LEN() const {
-  // TODO pmk: extract from type spec
+  // TODO pmk: extract from type spec in array constructor
   return AsExpr(Constant<SubscriptInteger>{0});  // TODO placeholder
 }
 
+template<int KIND> Expr<SubscriptInteger> LiteralSubstring<KIND>::LEN() const {
+  auto lower{this->left()};
+  auto upper{this->right()};
+  return std::move(upper) - std::move(lower) + Expr<SubscriptInteger>{1};
+}
+
 template<int KIND>
 Expr<SubscriptInteger> Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
   return std::visit(
@@ -160,6 +166,7 @@ Expr<SubscriptInteger> Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
                          return AsExpr(
                              Constant<SubscriptInteger>{c.value.size()});
                        },
+          [](const LiteralSubstring<KIND> &ls) { return ls.LEN(); },
           [](const ArrayConstructor<Result> &a) { return a.LEN(); },
           [](const Parentheses<Result> &x) { return x.left().LEN(); },
           [](const Concat<KIND> &c) {
@@ -178,7 +185,7 @@ Expr<SomeType>::~Expr() {}
 
 template<typename T> DynamicType ArrayConstructor<T>::GetType() const {
   // TODO: pmk: parameterized derived types, CHARACTER length
-  return *result.GetType();
+  return result.GetType();
 }
 
 template<typename A>

flang/lib/evaluate/expression.h

@@ -357,6 +357,25 @@ struct Concat
   static std::ostream &Infix(std::ostream &o) { return o << "//"; }
 };
 
+template<int KIND>
+struct LiteralSubstring : public Operation<LiteralSubstring<KIND>,
+                              Type<TypeCategory::Character, KIND>,
+                              SubscriptInteger, SubscriptInteger> {
+  using Result = Type<TypeCategory::Character, KIND>;
+  using Operand = SubscriptInteger;
+  using String = Scalar<Result>;
+  using Base = Operation<LiteralSubstring, Result, Operand, Operand>;
+  LiteralSubstring(
+      const String &s, const Expr<Operand> &lower, const Expr<Operand> &upper)
+    : string{s}, Base{lower, upper} {}
+  LiteralSubstring(String &&s, Expr<Operand> &&lower, Expr<Operand> &&upper)
+    : Base{std::move(lower), std::move(upper)}, string{std::move(s)} {}
+
+  std::ostream &Prefix(std::ostream &) const;
+  Expr<SubscriptInteger> LEN() const;
+  String string;
+};
+
 ENUM_CLASS(LogicalOperator, And, Or, Eqv, Neqv)
 
 template<int KIND>
@@ -508,8 +527,9 @@ public:
 
   Expr<SubscriptInteger> LEN() const;
 
-  std::variant<Constant<Result>, ArrayConstructor<Result>, Designator<Result>,
+  std::variant<Constant<Result>, LiteralSubstring<KIND>,
-      FunctionRef<Result>, Parentheses<Result>, Concat<KIND>, Extremum<Result>>
+      ArrayConstructor<Result>, Designator<Result>, FunctionRef<Result>,
+      Parentheses<Result>, Concat<KIND>, Extremum<Result>>
       u;
 };
 
@@ -551,9 +571,7 @@ template<> class Relational<SomeType> {
 public:
   using Result = LogicalResult;
   EVALUATE_UNION_CLASS_BOILERPLATE(Relational)
-  static constexpr std::optional<DynamicType> GetType() {
+  static constexpr DynamicType GetType() { return Result::GetType(); }
-    return Result::GetType();
-  }
   int Rank() const {
     return std::visit([](const auto &x) { return x.Rank(); }, u);
   }

flang/lib/evaluate/fold.cc

@@ -34,25 +34,17 @@ Expr<ResultType<A>> FoldOperation(FoldingContext &, A &&x) {
 }
 
 // Designators
-// At the moment, only substrings fold.
+// At the moment, only empty substrings fold.
-// TODO: Parameters, KIND type parameters
+// TODO: Parameters, KIND type parameters, substrings of parameters
 template<int KIND>
 Expr<Type<TypeCategory::Character, KIND>> FoldOperation(FoldingContext &context,
     Designator<Type<TypeCategory::Character, KIND>> &&designator) {
   using CHAR = Type<TypeCategory::Character, KIND>;
   if (auto *substring{std::get_if<Substring>(&designator.u)}) {
-    if (auto folded{substring->Fold(context)}) {
+    substring->Fold(context);
-      if (auto *string{std::get_if<Scalar<CHAR>>(&*folded)}) {
+    if (auto length{ToInt64(Fold(context, substring->LEN()))}) {
-        return Expr<CHAR>{Constant<CHAR>{std::move(*string)}};
+      if (*length == 0) {
-      }
+        return Expr<CHAR>{Constant<CHAR>{Scalar<CHAR>{}}};
-      // A zero-length substring of an arbitrary data reference can
-      // be folded, but the C++ string type of the empty value will be
-      // std::string and that may not be right for multi-byte CHARACTER
-      // kinds.
-      if (auto length{ToInt64(Fold(context, substring->LEN()))}) {
-        if (*length == 0) {
-          return Expr<CHAR>{Constant<CHAR>{Scalar<CHAR>{}}};
-        }
       }
     }
   }
@@ -353,22 +345,56 @@ Expr<T> FoldOperation(FoldingContext &context, Extremum<T> &&x) {
 template<int KIND>
 Expr<Type<TypeCategory::Complex, KIND>> FoldOperation(
     FoldingContext &context, ComplexConstructor<KIND> &&x) {
-  using COMPLEX = Type<TypeCategory::Complex, KIND>;
+  using Result = Type<TypeCategory::Complex, KIND>;
   if (auto folded{FoldOperands(context, x.left(), x.right())}) {
-    return Expr<COMPLEX>{
+    return Expr<Result>{
-        Constant<COMPLEX>{Scalar<COMPLEX>{folded->first, folded->second}}};
+        Constant<Result>{Scalar<Result>{folded->first, folded->second}}};
   }
-  return Expr<COMPLEX>{std::move(x)};
+  return Expr<Result>{std::move(x)};
+}
+
+template<int KIND>
+Expr<Type<TypeCategory::Character, KIND>> FoldOperation(
+    FoldingContext &context, LiteralSubstring<KIND> &&x) {
+  using Result = Type<TypeCategory::Character, KIND>;
+  x.left() = Fold(context, std::move(x.left()));
+  x.right() = Fold(context, std::move(x.right()));
+  auto lower{ToInt64(x.left())};
+  auto upper{ToInt64(x.left())};
+  if (lower.has_value() && *lower < 1) {
+    context.messages.Say("lower bound (%jd) on literal substring "
+                         "is less than one"_en_US,
+        static_cast<std::intmax_t>(*lower));
+    lower = 1;
+  }
+  if (upper.has_value()) {
+    if (*upper < 1 || (lower.has_value() && *upper < *lower)) {
+      return Expr<Result>{Constant<Result>(Scalar<Result>{})};
+    }
+    std::int64_t len = x.string.size();
+    if (*upper > len) {
+      context.messages.Say("upper bound (%jd) on substring "
+                           "is greater than character length (%jd)"_en_US,
+          static_cast<std::intmax_t>(*upper), static_cast<std::intmax_t>(len));
+      upper = len;
+    }
+    if (lower.has_value()) {
+      Scalar<Result> substring{
+          x.string.substr(*lower - 1, *upper - *lower + 1)};
+      return Expr<Result>{Constant<Result>{substring}};
+    }
+  }
+  return Expr<Result>{std::move(x)};
 }
 
 template<int KIND>
 Expr<Type<TypeCategory::Character, KIND>> FoldOperation(
     FoldingContext &context, Concat<KIND> &&x) {
-  using CHAR = Type<TypeCategory::Character, KIND>;
+  using Result = Type<TypeCategory::Character, KIND>;
   if (auto folded{FoldOperands(context, x.left(), x.right())}) {
-    return Expr<CHAR>{Constant<CHAR>{folded->first + folded->second}};
+    return Expr<Result>{Constant<Result>{folded->first + folded->second}};
   }
-  return Expr<CHAR>{std::move(x)};
+  return Expr<Result>{std::move(x)};
 }
 
 template<typename T>

flang/lib/evaluate/type.h

@@ -70,9 +70,7 @@ template<TypeCategory CATEGORY, int KIND> struct TypeBase {
   // data types will have set this flag to true.
   static constexpr bool isSpecificIntrinsicType{true};
   static constexpr DynamicType dynamicType{CATEGORY, KIND};
-  static constexpr std::optional<DynamicType> GetType() {
+  static constexpr DynamicType GetType() { return {dynamicType}; }
-    return {dynamicType};
-  }
   static constexpr TypeCategory category{CATEGORY};
   static constexpr int kind{KIND};
   static std::string Dump() { return dynamicType.Dump(); }
@@ -167,6 +165,11 @@ using SubscriptInteger = Type<TypeCategory::Integer, 8>;
 using LogicalResult = Type<TypeCategory::Logical, 1>;
 using LargestReal = Type<TypeCategory::Real, 16>;
 
+// Many expressions, including subscripts, CHARACTER lengths, array bounds,
+// and effective type parameter values, are of a maximal kind of INTEGER.
+using IndirectSubscriptIntegerExpr =
+    CopyableIndirection<Expr<SubscriptInteger>>;
+
 // A predicate that is true when a kind value is a kind that could possibly
 // be supported for an intrinsic type category on some target instruction
 // set architecture.
@@ -244,9 +247,7 @@ public:
   CLASS_BOILERPLATE(SomeKind)
   explicit SomeKind(const semantics::DerivedTypeSpec &s) : spec_{&s} {}
 
-  std::optional<DynamicType> GetType() const {
+  DynamicType GetType() const { return DynamicType{category, 0, spec_}; }
-    return {DynamicType{category, 0, spec_}};
-  }
   const semantics::DerivedTypeSpec &spec() const { return *spec_; }
   std::string Dump() const;
 
@@ -330,7 +331,7 @@ template<typename T> struct Constant {
   template<typename A>
   Constant(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
     : value(std::move(x)) {}
-  constexpr std::optional<DynamicType> GetType() const {
+  constexpr DynamicType GetType() const {
     if constexpr (Result::isSpecificIntrinsicType) {
       return Result::GetType();
     } else {

flang/lib/evaluate/variable.cc

@@ -113,70 +113,38 @@ Expr<SubscriptInteger> Substring::last() const {
   if (last_.has_value()) {
     return **last_;
   } else {
-    return std::visit(
+    return parent_.LEN();
-        [](const auto &x) {
-          if constexpr (std::is_same_v<DataRef, std::decay_t<decltype(x)>>) {
-            return x.LEN();
-          } else {
-            return AsExpr(Constant<SubscriptInteger>{x.size()});
-          }
-        },
-        u_);
   }
 }
 
-auto Substring::Fold(FoldingContext &context) -> std::optional<Strings> {
+void Substring::Fold(FoldingContext &context) {
-  std::optional<std::int64_t> lbi, ubi;
+  if (!first_.has_value()) {
-  if (first_.has_value()) {
+    first_ = AsExpr(Constant<SubscriptInteger>{1});
-    *first_ = evaluate::Fold(context, std::move(**first_));
-    lbi = ToInt64(**first_);
   }
-  if (last_.has_value()) {
+  *first_ = evaluate::Fold(context, std::move(**first_));
-    *last_ = evaluate::Fold(context, std::move(**last_));
+  std::optional<std::int64_t> lbi{ToInt64(**first_)};
-    ubi = ToInt64(**last_);
+  if (lbi.has_value() && *lbi < 1) {
+    context.messages.Say(
+        "lower bound on substring (%jd) is less than one"_en_US,
+        static_cast<std::intmax_t>(*lbi));
+    *lbi = 1;
+    first_ = AsExpr(Constant<SubscriptInteger>{1});
   }
-  if (lbi.has_value() && ubi.has_value()) {
+  if (!last_.has_value()) {
-    if (*ubi < *lbi) {
+    last_ = parent_.LEN();
-      // These cases are well defined, and they produce zero-length results.
+  }
-      u_ = ""s;
+  *last_ = evaluate::Fold(context, std::move(**last_));
+  if (std::optional<std::int64_t> ubi{ToInt64(**last_)}) {
+    if (*ubi < 1) {
+      *ubi = 0;
+      last_ = AsExpr(Constant<SubscriptInteger>{0});
+    }
+    if (lbi.has_value() && *ubi < *lbi) {
+      // This case is well defined
       first_ = AsExpr(Constant<SubscriptInteger>{1});
       last_ = AsExpr(Constant<SubscriptInteger>{0});
-      return {Strings{""s}};
     }
-    if (*lbi <= 0) {
-      context.messages.Say(
-          "lower bound on substring (%jd) is less than one"_en_US,
-          static_cast<std::intmax_t>(*lbi));
-      *lbi = 1;
-      first_ = AsExpr(Constant<SubscriptInteger>{1});
-    }
-    if (*ubi <= 0) {
-      u_ = ""s;
-      last_ = AsExpr(Constant<SubscriptInteger>{0});
-      return {Strings{""s}};
-    }
-    return std::visit(
-        [&](const auto &x) -> std::optional<Strings> {
-          if constexpr (std::is_same_v<DataRef, std::decay_t<decltype(x)>>) {
-            return std::nullopt;
-          } else {
-            std::int64_t len = x.size();
-            if (*ubi > len) {
-              context.messages.Say(
-                  "upper bound on substring (%jd) is greater than character length (%jd)"_en_US,
-                  static_cast<std::intmax_t>(*ubi),
-                  static_cast<std::intmax_t>(len));
-              *ubi = len;
-              last_ = AsExpr(Constant<SubscriptInteger>{len});
-            }
-            auto substring{x.substr(*lbi - 1, *ubi - *lbi + 1)};
-            u_ = substring;
-            return std::make_optional(Strings{substring});
-          }
-        },
-        u_);
   }
-  return std::nullopt;
 }
 
 // Variable dumping
@@ -300,7 +268,7 @@ std::ostream &CoarrayRef::Dump(std::ostream &o) const {
 std::ostream &DataRef::Dump(std::ostream &o) const { return Emit(o, u); }
 
 std::ostream &Substring::Dump(std::ostream &o) const {
-  Emit(o, u_) << '(';
+  Emit(o, parent_) << '(';
   Emit(o, first_) << ':';
   return Emit(o, last_);
 }
@@ -325,7 +293,9 @@ template<typename T> std::ostream &Designator<T>::Dump(std::ostream &o) const {
 static Expr<SubscriptInteger> SymbolLEN(const Symbol &sym) {
   return AsExpr(Constant<SubscriptInteger>{0});  // TODO
 }
-Expr<SubscriptInteger> Component::LEN() const { return SymbolLEN(symbol()); }
+Expr<SubscriptInteger> Component::LEN() const {
+  return SymbolLEN(GetLastSymbol());
+}
 Expr<SubscriptInteger> ArrayRef::LEN() const {
   return std::visit(
       common::visitors{[](const Symbol *s) { return SymbolLEN(*s); },
@@ -420,17 +390,7 @@ int DataRef::Rank() const {
       },
       u);
 }
-int Substring::Rank() const {
+int Substring::Rank() const { return parent_.Rank(); }
-  return std::visit(
-      [](const auto &x) {
-        if constexpr (std::is_same_v<std::decay_t<decltype(x)>, DataRef>) {
-          return x.Rank();
-        } else {
-          return 0;  // parent string is a literal scalar
-        }
-      },
-      u_);
-}
 int ComplexPart::Rank() const { return complex_.Rank(); }
 template<typename T> int Designator<T>::Rank() const {
   return std::visit(
@@ -460,77 +420,62 @@ bool ProcedureDesignator::IsElemental() const {
   return 0;
 }
 
-// GetFirstSymbol(), GetLastSymbol()
+// GetFirstSymbol() & GetLastSymbol()
-const Symbol *Component::GetFirstSymbol() const {
+const Symbol &Component::GetFirstSymbol() const {
   return base_->GetFirstSymbol();
 }
-const Symbol *Component::GetLastSymbol() const {
+const Symbol &ArrayRef::GetFirstSymbol() const {
-  return base_->GetLastSymbol();
+  return *std::visit(common::visitors{[](const Symbol *sym) { return sym; },
-}
+                         [=](const Component &component) {
-const Symbol *ArrayRef::GetFirstSymbol() const {
+                           return &component.GetFirstSymbol();
-  return std::visit(common::visitors{[](const Symbol *sym) { return sym; },
+                         }},
-                        [=](const Component &component) {
-                          return component.GetFirstSymbol();
-                        }},
       u);
 }
-const Symbol *ArrayRef::GetLastSymbol() const {
+const Symbol &ArrayRef::GetLastSymbol() const {
-  return std::visit(common::visitors{[](const Symbol *sym) { return sym; },
+  return *std::visit(common::visitors{[](const Symbol *sym) { return sym; },
-                        [=](const Component &component) {
+                         [=](const Component &component) {
-                          return component.GetLastSymbol();
+                           return &component.GetLastSymbol();
-                        }},
+                         }},
       u);
 }
-const Symbol *DataRef::GetFirstSymbol() const {
+const Symbol &DataRef::GetFirstSymbol() const {
-  return std::visit(common::visitors{[](const Symbol *sym) { return sym; },
+  return *std::visit(common::visitors{[](const Symbol *sym) { return sym; },
-                        [=](const auto &x) { return x.GetFirstSymbol(); }},
+                         [=](const auto &x) { return &x.GetFirstSymbol(); }},
       u);
 }
-const Symbol *DataRef::GetLastSymbol() const {
+const Symbol &DataRef::GetLastSymbol() const {
-  return std::visit(common::visitors{[](const Symbol *sym) { return sym; },
+  return *std::visit(common::visitors{[](const Symbol *sym) { return sym; },
-                        [=](const auto &x) { return x.GetLastSymbol(); }},
+                         [=](const auto &x) { return &x.GetLastSymbol(); }},
       u);
 }
-const Symbol *Substring::GetFirstSymbol() const {
+const Symbol &Substring::GetFirstSymbol() const {
-  if (const DataRef * dataRef{std::get_if<DataRef>(&u_)}) {
+  return parent_.GetFirstSymbol();
-    return dataRef->GetFirstSymbol();
-  } else {
-    return nullptr;  // substring of character literal
-  }
 }
-const Symbol *Substring::GetLastSymbol() const {
+const Symbol &Substring::GetLastSymbol() const {
-  if (const DataRef * dataRef{std::get_if<DataRef>(&u_)}) {
+  return parent_.GetLastSymbol();
-    return dataRef->GetLastSymbol();
-  } else {
-    return nullptr;  // substring of character literal
-  }
 }
-template<typename T> const Symbol *Designator<T>::GetFirstSymbol() const {
+template<typename T> const Symbol &Designator<T>::GetFirstSymbol() const {
-  return std::visit(common::visitors{[](const Symbol *sym) { return sym; },
+  return *std::visit(common::visitors{[](const Symbol *sym) { return sym; },
-                        [=](const auto &x) { return x.GetFirstSymbol(); }},
+                         [=](const auto &x) { return &x.GetFirstSymbol(); }},
       u);
 }
-template<typename T> const Symbol *Designator<T>::GetLastSymbol() const {
+template<typename T> const Symbol &Designator<T>::GetLastSymbol() const {
-  return std::visit(common::visitors{[](const Symbol *sym) { return sym; },
+  return *std::visit(common::visitors{[](const Symbol *sym) { return sym; },
-                        [=](const auto &x) { return x.GetLastSymbol(); }},
+                         [=](const auto &x) { return &x.GetLastSymbol(); }},
       u);
 }
 const Symbol *ProcedureDesignator::GetSymbol() const {
   return std::visit(common::visitors{[](const Symbol *sym) { return sym; },
-                        [](const Component &c) { return c.GetLastSymbol(); },
+                        [](const Component &c) { return &c.GetLastSymbol(); },
                         [](const auto &) -> const Symbol * { return nullptr; }},
       u);
 }
 
 template<typename T> std::optional<DynamicType> Designator<T>::GetType() const {
   if constexpr (std::is_same_v<Result, SomeDerived>) {
-    if (const Symbol * sym{GetLastSymbol()}) {
+    return GetSymbolType(GetLastSymbol());
-      return GetSymbolType(*sym);
-    } else {
-      return std::nullopt;
-    }
   } else {
-    return Result::GetType();
+    return {Result::GetType()};
   }
 }
 std::optional<DynamicType> ProcedureDesignator::GetType() const {

flang/lib/evaluate/variable.h

@@ -43,14 +43,11 @@ using semantics::Symbol;
 struct DataRef;
 template<typename A> struct Variable;
 
-// Subscript and cosubscript expressions are of a kind that matches the
+// pmk: are these still needed?
-// address size, at least at the top level.
-using IndirectSubscriptIntegerExpr =
-    CopyableIndirection<Expr<SubscriptInteger>>;
-
 int GetSymbolRank(const Symbol &);
 const parser::CharBlock &GetSymbolName(const Symbol &);
 
+
 // R913 structure-component & C920: Defined to be a multi-part
 // data-ref whose last part has no subscripts (or image-selector, although
 // that isn't explicit in the document).  Pointer and allocatable components
@@ -66,10 +63,9 @@ public:
 
   const DataRef &base() const { return *base_; }
   DataRef &base() { return *base_; }
-  const Symbol &symbol() const { return *symbol_; }
   int Rank() const;
-  const Symbol *GetFirstSymbol() const;
+  const Symbol &GetFirstSymbol() const;
-  const Symbol *GetLastSymbol() const;
+  const Symbol &GetLastSymbol() const { return *symbol_; }
   Expr<SubscriptInteger> LEN() const;
   std::ostream &Dump(std::ostream &) const;
 
@@ -118,8 +114,8 @@ struct ArrayRef {
     : u{std::move(c)}, subscript(std::move(ss)) {}
 
   int Rank() const;
-  const Symbol *GetFirstSymbol() const;
+  const Symbol &GetFirstSymbol() const;
-  const Symbol *GetLastSymbol() const;
+  const Symbol &GetLastSymbol() const;
   Expr<SubscriptInteger> LEN() const;
   std::ostream &Dump(std::ostream &) const;
 
@@ -146,8 +142,8 @@ public:
   CoarrayRef &set_team(Expr<SomeInteger> &&, bool isTeamNumber = false);
 
   int Rank() const;
-  const Symbol *GetFirstSymbol() const { return base_.front(); }
+  const Symbol &GetFirstSymbol() const { return *base_.front(); }
-  const Symbol *GetLastSymbol() const { return base_.back(); }
+  const Symbol &GetLastSymbol() const { return *base_.back(); }
   Expr<SubscriptInteger> LEN() const;
   std::ostream &Dump(std::ostream &) const;
 
@@ -168,8 +164,8 @@ struct DataRef {
   explicit DataRef(const Symbol &n) : u{&n} {}
 
   int Rank() const;
-  const Symbol *GetFirstSymbol() const;
+  const Symbol &GetFirstSymbol() const;
-  const Symbol *GetLastSymbol() const;
+  const Symbol &GetLastSymbol() const;
   Expr<SubscriptInteger> LEN() const;
   std::ostream &Dump(std::ostream &) const;
 
@@ -177,34 +173,33 @@ struct DataRef {
 };
 
 // R908 substring, R909 parent-string, R910 substring-range.
-// The base object of a substring can be a literal.
+// The base object of a substring can be a literal, but those are represented
+// as a LiteralSubstring expression.
 // In the F2018 standard, substrings of array sections are parsed as
 // variants of sections instead.
 class Substring {
 public:
-  using Strings = std::variant<std::string, std::u16string, std::u32string>;
   CLASS_BOILERPLATE(Substring)
-  template<typename A>
+  Substring(DataRef &&parent, std::optional<Expr<SubscriptInteger>> &&first,
-  Substring(A &&parent, std::optional<Expr<SubscriptInteger>> &&first,
       std::optional<Expr<SubscriptInteger>> &&last)
-    : u_{std::move(parent)} {
+    : parent_{std::move(parent)} {
     SetBounds(first, last);
   }
 
   Expr<SubscriptInteger> first() const;
   Expr<SubscriptInteger> last() const;
   int Rank() const;
-  const Symbol *GetFirstSymbol() const;
+  const Symbol &GetFirstSymbol() const;
-  const Symbol *GetLastSymbol() const;
+  const Symbol &GetLastSymbol() const;
   Expr<SubscriptInteger> LEN() const;
-  std::optional<Strings> Fold(FoldingContext &);
   std::ostream &Dump(std::ostream &) const;
 
+  void Fold(FoldingContext &);
+
 private:
-  using Variant = common::CombineVariants<std::variant<DataRef>, Strings>;
   void SetBounds(std::optional<Expr<SubscriptInteger>> &,
       std::optional<Expr<SubscriptInteger>> &);
-  Variant u_;
+  DataRef parent_;
   std::optional<IndirectSubscriptIntegerExpr> first_, last_;
 };
 
@@ -219,8 +214,8 @@ public:
   const DataRef &complex() const { return complex_; }
   Part part() const { return part_; }
   int Rank() const;
-  const Symbol *GetFirstSymbol() const { return complex_.GetFirstSymbol(); }
+  const Symbol &GetFirstSymbol() const { return complex_.GetFirstSymbol(); }
-  const Symbol *GetLastSymbol() const { return complex_.GetLastSymbol(); }
+  const Symbol &GetLastSymbol() const { return complex_.GetLastSymbol(); }
   std::ostream &Dump(std::ostream &) const;
 
 private:
@@ -253,8 +248,8 @@ public:
 
   std::optional<DynamicType> GetType() const;
   int Rank() const;
-  const Symbol *GetFirstSymbol() const;
+  const Symbol &GetFirstSymbol() const;
-  const Symbol *GetLastSymbol() const;
+  const Symbol &GetLastSymbol() const;
   Expr<SubscriptInteger> LEN() const;
   std::ostream &Dump(std::ostream &o) const;
 

flang/lib/parser/characters.cc

@@ -82,14 +82,30 @@ std::optional<std::size_t> CountCharacters(
   return {chars};
 }
 
-std::string QuoteCharacterLiteral(
+template<typename STRING>
-    const std::string &str, bool doubleDoubleQuotes, bool doubleBackslash) {
+std::string QuoteCharacterLiteralHelper(
+    const STRING &str, bool doubleDoubleQuotes, bool doubleBackslash) {
   std::string result{'"'};
   const auto emit{[&](char ch) { result += ch; }};
-  for (char ch : str) {
+  for (auto ch : str) {
     EmitQuotedChar(ch, emit, emit, doubleDoubleQuotes, doubleBackslash);
   }
   result += '"';
   return result;
 }
+
+std::string QuoteCharacterLiteral(
+    const std::string &str, bool doubleDoubleQuotes, bool doubleBackslash) {
+  return QuoteCharacterLiteralHelper(str, doubleDoubleQuotes, doubleBackslash);
+}
+
+std::string QuoteCharacterLiteral(
+    const std::u16string &str, bool doubleDoubleQuotes, bool doubleBackslash) {
+  return QuoteCharacterLiteralHelper(str, doubleDoubleQuotes, doubleBackslash);
+}
+
+std::string QuoteCharacterLiteral(
+    const std::u32string &str, bool doubleDoubleQuotes, bool doubleBackslash) {
+  return QuoteCharacterLiteralHelper(str, doubleDoubleQuotes, doubleBackslash);
+}
 }

flang/lib/parser/characters.h

@@ -134,7 +134,7 @@ inline constexpr std::optional<char> BackslashEscapeChar(char ch) {
 }
 
 template<typename NORMAL, typename INSERTED>
-void EmitQuotedChar(char ch, const NORMAL &emit, const INSERTED &insert,
+void EmitQuotedChar(char32_t ch, const NORMAL &emit, const INSERTED &insert,
     bool doubleDoubleQuotes = true, bool doubleBackslash = true) {
   if (ch == '"') {
     if (doubleDoubleQuotes) {
@@ -156,13 +156,29 @@ void EmitQuotedChar(char ch, const NORMAL &emit, const INSERTED &insert,
       insert('0' + ((ch >> 3) & 7));
       insert('0' + (ch & 7));
     }
-  } else {
+  } else if (ch <= 0x7f) {
     emit(ch);
+  } else if (ch <= 0x7ff) {
+    emit(0xc0 | ((ch >> 6) & 0x1f));
+    emit(0x80 | (ch & 0x3f));
+  } else if (ch <= 0xffff) {
+    emit(0xe0 | ((ch >> 12) & 0x0f));
+    emit(0x80 | ((ch >> 6) & 0x3f));
+    emit(0x80 | (ch & 0x3f));
+  } else {
+    emit(0xf0 | ((ch >> 18) & 0x07));
+    emit(0x80 | ((ch >> 12) & 0x3f));
+    emit(0x80 | ((ch >> 6) & 0x3f));
+    emit(0x80 | (ch & 0x3f));
   }
 }
 
 std::string QuoteCharacterLiteral(const std::string &,
     bool doubleDoubleQuotes = true, bool doubleBackslash = true);
+std::string QuoteCharacterLiteral(const std::u16string &,
+    bool doubleDoubleQuotes = true, bool doubleBackslash = true);
+std::string QuoteCharacterLiteral(const std::u32string &,
+    bool doubleDoubleQuotes = true, bool doubleBackslash = true);
 
 std::optional<int> UTF8CharacterBytes(const char *);
 std::optional<int> EUC_JPCharacterBytes(const char *);

flang/lib/semantics/expression.cc

@@ -520,7 +520,7 @@ MaybeExpr TypedWrapper(DynamicType &&dyType, WRAPPED &&x) {
 
 // Wraps a data reference in a typed Designator<>.
 static MaybeExpr Designate(DataRef &&dataRef) {
-  const Symbol &symbol{*dataRef.GetLastSymbol()};
+  const Symbol &symbol{dataRef.GetLastSymbol()};
   if (std::optional<DynamicType> dyType{GetSymbolType(symbol)}) {
     return TypedWrapper<Designator, DataRef>(
         std::move(*dyType), std::move(dataRef));
@@ -577,7 +577,7 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::Substring &ss) {
               GetSubstringBound(std::get<0>(range.t))};
           std::optional<Expr<SubscriptInteger>> last{
               GetSubstringBound(std::get<1>(range.t))};
-          const Symbol &symbol{*checked->GetLastSymbol()};
+          const Symbol &symbol{checked->GetLastSymbol()};
           if (std::optional<DynamicType> dynamicType{GetSymbolType(symbol)}) {
             if (dynamicType->category == TypeCategory::Character) {
               return WrapperHelper<TypeCategory::Character, Designator,
@@ -693,7 +693,7 @@ MaybeExpr ExprAnalyzer::ApplySubscripts(
 }
 
 MaybeExpr ExprAnalyzer::CompleteSubscripts(ArrayRef &&ref) {
-  const Symbol &symbol{*ref.GetLastSymbol()};
+  const Symbol &symbol{ref.GetLastSymbol()};
   int symbolRank{symbol.Rank()};
   if (ref.subscript.empty()) {
     // A -> A(:,:)
@@ -804,8 +804,36 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::CoindexedNamedObject &co) {
   return std::nullopt;
 }
 
-MaybeExpr ExprAnalyzer::Analyze(const parser::CharLiteralConstantSubstring &) {
+MaybeExpr ExprAnalyzer::Analyze(const parser::CharLiteralConstantSubstring &x) {
-  Say("TODO: CharLiteralConstantSubstring unimplemented"_err_en_US);
+  const parser::SubstringRange &range{std::get<parser::SubstringRange>(x.t)};
+  std::optional<Expr<SubscriptInteger>> lower{
+      GetSubstringBound(std::get<0>(range.t))};
+  std::optional<Expr<SubscriptInteger>> upper{
+      GetSubstringBound(std::get<1>(range.t))};
+  if (MaybeExpr string{Analyze(std::get<parser::CharLiteralConstant>(x.t))}) {
+    if (auto *charExpr{std::get_if<Expr<SomeCharacter>>(&string->u)}) {
+      Expr<SubscriptInteger> length{std::visit(
+          [](const auto &ckExpr) { return ckExpr.LEN(); }, charExpr->u)};
+      if (!lower.has_value()) {
+        lower = Expr<SubscriptInteger>{1};
+      }
+      if (!upper.has_value()) {
+        std::optional<std::int64_t> size{ToInt64(length)};
+        CHECK(size.has_value());
+        upper = Expr<SubscriptInteger>{static_cast<std::int64_t>(*size)};
+      }
+      return std::visit(
+          [&](auto &&ckExpr) -> MaybeExpr {
+            using Result = ResultType<decltype(ckExpr)>;
+            auto *cp{std::get_if<Constant<Result>>(&ckExpr.u)};
+            CHECK(cp != nullptr);  // the parent was parsed as a constant string
+            return AsGenericExpr(Expr<SomeCharacter>{Expr<Result>{
+                LiteralSubstring<Result::kind>{std::move(cp->value),
+                    std::move(*lower), std::move(*upper)}}});
+          },
+          std::move(charExpr->u));
+    }
+  }
   return std::nullopt;
 }
 
@@ -1184,11 +1212,12 @@ MaybeExpr ExprAnalyzer::TopLevelChecks(DataRef &&dataRef) {
 void ExprAnalyzer::CheckUnsubscriptedComponent(const Component &component) {
   int baseRank{component.base().Rank()};
   if (baseRank > 0) {
-    int componentRank{component.symbol().Rank()};
+    const Symbol &symbol{component.GetLastSymbol()};
+    int componentRank{symbol.Rank()};
     if (componentRank > 0) {
       Say("reference to whole rank-%d component '%%%s' of "
           "rank-%d array of derived type is not allowed"_err_en_US,
-          componentRank, component.symbol().name().ToString().data(), baseRank);
+          componentRank, symbol.name().ToString().data(), baseRank);
     }
   }
 }