[flang] Clean up DynamicType, link it to symbol table character length

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

flang/lib/evaluate/characteristics.cc

@@ -31,18 +31,7 @@ std::ostream &DummyDataObject::Dump(std::ostream &o) const {
   if (intent != common::Intent::Default) {
     o << "INTENT(" << common::EnumToString(intent) << ')';
   }
-  // TODO pmk WIP: generalize this too
-  if (type.category == common::TypeCategory::Character) {
-    if (characterLength.get() == nullptr) {
-      o << type.AsFortran(":"s);
-    } else {
-      std::stringstream ss;
-      characterLength->AsFortran(ss);
-      o << type.AsFortran(ss.str());
-    }
-  } else {
-    o << type.AsFortran();
-  }
+  o << type.AsFortran();
   if (!shape.empty()) {
     char sep{'('};
     for (const auto &expr : shape) {
@@ -86,18 +75,7 @@ bool FunctionResult::operator==(const FunctionResult &that) const {
 
 std::ostream &FunctionResult::Dump(std::ostream &o) const {
   attrs.Dump(o, EnumToString);
-  if (type.category == TypeCategory::Character) {
-    if (characterLength.get() == nullptr) {
-      o << type.AsFortran("*"s);
-    } else {
-      std::stringstream ss;
-      characterLength->AsFortran(o);
-      o << type.AsFortran(ss.str());
-    }
-  } else {
-    o << type.AsFortran();
-  }
-  return o << " rank " << rank;
+  return o << type.AsFortran() << " rank " << rank;
 }
 
 bool Procedure::operator==(const Procedure &that) const {

flang/lib/evaluate/characteristics.h

@@ -21,10 +21,10 @@
 
 #include "expression.h"
 #include "type.h"
+#include "../common/enum-set.h"
 #include "../common/fortran.h"
 #include "../common/idioms.h"
 #include "../common/indirection.h"
-#include "../common/enum-set.h"
 #include <memory>
 #include <ostream>
 #include <variant>
@@ -42,10 +42,9 @@ namespace Fortran::evaluate::characteristics {
 
 // 15.3.2.2
 struct DummyDataObject {
-  ENUM_CLASS(Attr, AssumedRank, Optional, Allocatable, Asynchronous,
-      Contiguous, Value, Volatile, Polymorphic, Pointer, Target)
+  ENUM_CLASS(Attr, AssumedRank, Optional, Allocatable, Asynchronous, Contiguous,
+      Value, Volatile, Polymorphic, Pointer, Target)
   DynamicType type;
-  std::unique_ptr<Expr<SubscriptInteger>> characterLength;
   std::vector<std::optional<Expr<SubscriptInteger>>> shape;
   std::vector<Expr<SubscriptInteger>> coshape;
   common::Intent intent{common::Intent::Default};
@@ -70,14 +69,14 @@ struct AlternateReturn {
 };
 
 // 15.3.2.1
-using DummyArgument = std::variant<DummyDataObject, DummyProcedure, AlternateReturn>;
+using DummyArgument =
+    std::variant<DummyDataObject, DummyProcedure, AlternateReturn>;
 
 // 15.3.3
 struct FunctionResult {
-  ENUM_CLASS(Attr, Polymorphic, Allocatable, Pointer, Contiguous,
-	     ProcedurePointer)
+  ENUM_CLASS(
+      Attr, Polymorphic, Allocatable, Pointer, Contiguous, ProcedurePointer)
   DynamicType type;
-  std::unique_ptr<Expr<SubscriptInteger>> characterLength;
   int rank{0};
   common::EnumSet<Attr, 32> attrs;
   bool operator==(const FunctionResult &) const;

flang/lib/evaluate/constant.h

@@ -149,9 +149,7 @@ public:
     return *derivedTypeSpec_;
   }
 
-  DynamicType GetType() const {
-    return DynamicType{TypeCategory::Derived, 0, derivedTypeSpec_};
-  }
+  DynamicType GetType() const { return DynamicType{derivedTypeSpec()}; }
 
 private:
   const semantics::DerivedTypeSpec *derivedTypeSpec_;

flang/lib/evaluate/expression.cc

@@ -262,7 +262,7 @@ bool StructureConstructor::operator==(const StructureConstructor &that) const {
 }
 
 DynamicType StructureConstructor::GetType() const {
-  return {TypeCategory::Derived, 0, derivedTypeSpec_};
+  return DynamicType{*derivedTypeSpec_};
 }
 
 StructureConstructor &StructureConstructor::Add(

flang/lib/evaluate/expression.h

@@ -473,9 +473,7 @@ public:
   const semantics::DerivedTypeSpec &derivedTypeSpec() const {
     return *derivedTypeSpec_;
   }
-  DynamicType GetType() const {
-    return DynamicType{TypeCategory::Derived, 0, derivedTypeSpec_};
-  }
+  DynamicType GetType() const { return DynamicType{derivedTypeSpec()}; }
   std::ostream &AsFortran(std::ostream &) const;
 
 private:

flang/lib/evaluate/fold.cc

@@ -357,7 +357,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldOperation(
       if (value->isExplicit()) {
         return Fold(context,
             Expr<IntKIND>{Convert<IntKIND, TypeCategory::Integer>(
-                value->GetExplicit().value())});
+                Expr<SomeInteger>{value->GetExplicit().value()})});
       }
     }
   }

flang/lib/evaluate/type.cc

@@ -91,7 +91,7 @@ namespace Fortran::evaluate {
 
 bool DynamicType::operator==(const DynamicType &that) const {
   return category == that.category && kind == that.kind &&
-      derived == that.derived;
+      charLength == that.charLength && derived == that.derived;
 }
 
 std::optional<DynamicType> GetSymbolType(const semantics::Symbol *symbol) {
@@ -101,11 +101,16 @@ std::optional<DynamicType> GetSymbolType(const semantics::Symbol *symbol) {
         if (auto kind{ToInt64(intrinsic->kind())}) {
           TypeCategory category{intrinsic->category()};
           if (IsValidKindOfIntrinsicType(category, *kind)) {
-            return DynamicType{category, static_cast<int>(*kind)};
+            if (category == TypeCategory::Character) {
+              const auto &charType{type->characterTypeSpec()};
+              return DynamicType{static_cast<int>(*kind), charType.length()};
+            } else {
+              return DynamicType{category, static_cast<int>(*kind)};
+            }
           }
         }
       } else if (const auto *derived{type->AsDerived()}) {
-        return DynamicType{TypeCategory::Derived, 0, derived};
+        return DynamicType{*derived};
       }
     }
   }
@@ -116,6 +121,18 @@ std::string DynamicType::AsFortran() const {
   if (derived != nullptr) {
     CHECK(category == TypeCategory::Derived);
     return "TYPE("s + derived->typeSymbol().name().ToString() + ')';
+  } else if (charLength != nullptr) {
+    std::string result{"CHARACTER(KIND="s + std::to_string(kind) + ",LEN="};
+    if (charLength->isAssumed()) {
+      result += ",LEN=*";
+    } else if (charLength->isDeferred()) {
+      result += ",LEN=:";
+    } else if (const auto &length{charLength->GetExplicit()}) {
+      std::stringstream ss;
+      length->AsFortran(ss << ",LEN=");
+      result += ss.str();
+    }
+    return result + ')';
   } else {
     return EnumToString(category) + '(' + std::to_string(kind) + ')';
   }
@@ -124,7 +141,7 @@ std::string DynamicType::AsFortran() const {
 std::string DynamicType::AsFortran(std::string &&charLenExpr) const {
   if (!charLenExpr.empty() && category == TypeCategory::Character) {
     return "CHARACTER(KIND=" + std::to_string(kind) +
-        ",len=" + std::move(charLenExpr) + ')';
+        ",LEN=" + std::move(charLenExpr) + ')';
   } else {
     return AsFortran();
   }

flang/lib/evaluate/type.h

@@ -38,6 +38,7 @@
 
 namespace Fortran::semantics {
 class DerivedTypeSpec;
+class ParamValue;
 class Symbol;
 bool IsDescriptor(const Symbol &);
 }
@@ -54,21 +55,30 @@ using SubscriptInteger = Type<TypeCategory::Integer, 8>;
 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; 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).
+// DynamicType is meant to be suitable for use as the result type for
+// GetType() functions and member functions; consequently, it must be
+// capable of being used in a constexpr context.  So it does *not*
+// directly hold anything requiring a destructor, such as an arbitrary
+// CHARACTER length type parameter expression.  Those must be derived
+// via LEN() member functions, packaged elsewhere (e.g. as in
+// ArrayConstructor), or copied from a parameter spec in the symbol table
+// if one is supplied.
 struct DynamicType {
+  constexpr DynamicType() = default;
+  constexpr DynamicType(TypeCategory cat, int k) : category{cat}, kind{k} {}
+  constexpr DynamicType(int k, const semantics::ParamValue &pv)
+    : category{TypeCategory::Character}, kind{k}, charLength{&pv} {}
+  explicit constexpr DynamicType(const semantics::DerivedTypeSpec &dt)
+    : category{TypeCategory::Derived}, derived{&dt} {}
+
   bool operator==(const DynamicType &) const;
   std::string AsFortran() const;
   std::string AsFortran(std::string &&charLenExpr) const;
   DynamicType ResultTypeForMultiply(const DynamicType &) const;
 
-  TypeCategory category;
+  TypeCategory category{TypeCategory::Integer};  // overridable default
   int kind{0};  // set only for intrinsic types
+  const semantics::ParamValue *charLength{nullptr};
   const semantics::DerivedTypeSpec *derived{nullptr};  // TYPE(T), CLASS(T)
 };
 
@@ -264,7 +274,7 @@ public:
   CLASS_BOILERPLATE(SomeKind)
   explicit SomeKind(const semantics::DerivedTypeSpec &dts) : spec_{&dts} {}
 
-  DynamicType GetType() const { return DynamicType{category, 0, spec_}; }
+  DynamicType GetType() const { return DynamicType{spec()}; }
   const semantics::DerivedTypeSpec &spec() const { return *spec_; }
   bool operator==(const SomeKind &) const;
   std::string AsFortran() const;

flang/lib/semantics/expression.cc

@@ -115,9 +115,22 @@ struct CallAndArguments {
 };
 
 struct DynamicTypeWithLength : public DynamicType {
+  std::optional<Expr<SubscriptInteger>> LEN() const;
   std::optional<Expr<SubscriptInteger>> length;
 };
 
+std::optional<Expr<SubscriptInteger>> DynamicTypeWithLength::LEN() const {
+  if (length.has_value()) {
+    return length;
+  }
+  if (charLength != nullptr) {
+    if (const auto &len{charLength->GetExplicit()}) {
+      return ConvertToType<SubscriptInteger>(common::Clone(*len));
+    }
+  }
+  return std::nullopt;
+}
+
 std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(
     ExpressionAnalysisContext &context,
     const std::optional<parser::TypeSpec> &spec) {
@@ -129,24 +142,22 @@ std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(
       if (const semantics::IntrinsicTypeSpec *
           intrinsic{typeSpec->AsIntrinsic()}) {
         TypeCategory category{intrinsic->category()};
-        if (auto kind{ToInt64(intrinsic->kind())}) {
-          DynamicTypeWithLength result{{category, static_cast<int>(*kind)}};
+        if (auto optKind{ToInt64(intrinsic->kind())}) {
+          int kind{static_cast<int>(*optKind)};
           if (category == TypeCategory::Character) {
             const semantics::CharacterTypeSpec &cts{
                 typeSpec->characterTypeSpec()};
-            const semantics::ParamValue len{cts.length()};
+            const semantics::ParamValue &len{cts.length()};
             // N.B. CHARACTER(LEN=*) is allowed in type-specs in ALLOCATE() &
             // type guards, but not in array constructors.
-            if (len.GetExplicit().has_value()) {
-              Expr<SomeInteger> copy{*len.GetExplicit()};
-              result.length = ConvertToType<SubscriptInteger>(std::move(copy));
-            }
+            return DynamicTypeWithLength{DynamicType{kind, len}};
+          } else {
+            return DynamicTypeWithLength{DynamicType{category, kind}};
           }
-          return result;
         }
       } else if (const semantics::DerivedTypeSpec *
           derived{typeSpec->AsDerived()}) {
-        return DynamicTypeWithLength{{TypeCategory::Derived, 0, derived}};
+        return DynamicTypeWithLength{DynamicType{*derived}};
       }
     }
   }
@@ -1178,7 +1189,7 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
       if (static_cast<const DynamicType &>(*type_) ==
           static_cast<const DynamicType &>(xType)) {
         values_.Push(std::move(*x));
-        if (auto thisLen{ToInt64(xType.length)}) {
+        if (auto thisLen{ToInt64(xType.LEN())}) {
           if (constantLength_.has_value()) {
             if (exprContext_.context().warnOnNonstandardUsage() &&
                 *thisLen != *constantLength_) {
@@ -1191,11 +1202,11 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
               // length of the array constructor's character elements, not the
               // first, when there is no explicit type.
               *constantLength_ = *thisLen;
-              type_->length = std::move(xType.length);
+              type_->length = xType.LEN();
             }
           } else {
             constantLength_ = *thisLen;
-            type_->length = std::move(xType.length);
+            type_->length = xType.LEN();
           }
         }
       } else {
@@ -1333,9 +1344,8 @@ struct ArrayConstructorTypeVisitor {
             *type.derived, MakeSpecific<T>(std::move(values))});
       } else if (type.kind == T::kind) {
         if constexpr (T::category == TypeCategory::Character) {
-          CHECK(type.length.has_value());
           return AsMaybeExpr(ArrayConstructor<T>{
-              std::move(*type.length), MakeSpecific<T>(std::move(values))});
+              type.LEN().value(), MakeSpecific<T>(std::move(values))});
         } else {
           return AsMaybeExpr(
               ArrayConstructor<T>{MakeSpecific<T>(std::move(values))});