[flang][fir] Update FIR's character type.

Upstream the changes made to the !fir.char type.

https://github.com/flang-compiler/f18-llvm-project/pull/269
https://github.com/flang-compiler/f18-llvm-project/pull/557

Author: Eric Schweitz, Jean Perier

Differention Revision: https://reviews.llvm.org/D96183

flang/include/flang/Optimizer/Dialect/FIRType.h

@@ -97,15 +97,34 @@ mlir::Type dyn_cast_ptrEleTy(mlir::Type t);
 // Intrinsic types
 
 /// Model of the Fortran CHARACTER intrinsic type, including the KIND type
-/// parameter. The model does not include a LEN type parameter. A CharacterType
-/// is thus the type of a single character value.
+/// parameter. The model optionally includes a LEN type parameter. A
+/// CharacterType is thus the type of both a single character value and a
+/// character with a LEN parameter.
 class CharacterType
     : public mlir::Type::TypeBase<CharacterType, mlir::Type,
                                   detail::CharacterTypeStorage> {
 public:
   using Base::Base;
-  static CharacterType get(mlir::MLIRContext *ctxt, KindTy kind);
+  using LenType = std::int64_t;
+
+  static CharacterType get(mlir::MLIRContext *ctxt, KindTy kind, LenType len);
+  /// Return unknown length CHARACTER type.
+  static CharacterType getUnknownLen(mlir::MLIRContext *ctxt, KindTy kind) {
+    return get(ctxt, kind, unknownLen());
+  }
+  /// Return length 1 CHARACTER type.
+  static CharacterType getSingleton(mlir::MLIRContext *ctxt, KindTy kind) {
+    return get(ctxt, kind, singleton());
+  }
   KindTy getFKind() const;
+
+  /// CHARACTER is a singleton and has a LEN of 1.
+  static constexpr LenType singleton() { return 1; }
+  /// CHARACTER has an unknown LEN property.
+  static constexpr LenType unknownLen() { return -1; }
+
+  /// Access to a CHARACTER's LEN property. Defaults to 1.
+  LenType getLen() const;
 };
 
 /// Model of a Fortran COMPLEX intrinsic type, including the KIND type
@@ -407,6 +426,17 @@ inline bool isa_complex(mlir::Type t) {
   return t.isa<fir::ComplexType>() || t.isa<mlir::ComplexType>();
 }
 
+inline bool isa_char_string(mlir::Type t) {
+  if (auto ct = t.dyn_cast_or_null<fir::CharacterType>())
+    return ct.getLen() != fir::CharacterType::singleton();
+  return false;
+}
+
+/// Is `t` a box type for which it is not possible to deduce the box size.
+/// It is not possible to deduce the size of a box that describes an entity
+/// of unknown rank or type.
+bool isa_unknown_size_box(mlir::Type t);
+
 } // namespace fir
 
 #endif // OPTIMIZER_DIALECT_FIRTYPE_H

flang/lib/Lower/ConvertType.cpp

@@ -157,7 +157,7 @@ genFIRType<Fortran::common::TypeCategory::Character>(mlir::MLIRContext *context,
                                                      int KIND) {
   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
           Fortran::common::TypeCategory::Character, KIND))
-    return fir::CharacterType::get(context, KIND);
+    return fir::CharacterType::get(context, KIND, 1);
   return {};
 }
 

flang/lib/Lower/IO.cpp

@@ -490,7 +490,7 @@ lowerSourceTextAsStringLit(Fortran::lower::AbstractConverter &converter,
   text = text.take_front(text.rfind(')') + 1);
   auto &builder = converter.getFirOpBuilder();
   auto lit = builder.createStringLit(
-      loc, /*FIXME*/ fir::CharacterType::get(builder.getContext(), 1), text);
+      loc, /*FIXME*/ fir::CharacterType::get(builder.getContext(), 1, 1), text);
   auto data =
       Fortran::lower::CharacterExprHelper{builder, loc}.materializeCharacter(
           lit);

flang/lib/Lower/IntrinsicCall.cpp

@@ -1085,7 +1085,7 @@ mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType,
   Fortran::lower::CharacterExprHelper helper{builder, loc};
   auto dataAndLen = helper.createUnboxChar(arg);
   auto charType = fir::CharacterType::get(
-      builder.getContext(), helper.getCharacterKind(arg.getType()));
+      builder.getContext(), helper.getCharacterKind(arg.getType()), 1);
   auto refType = builder.getRefType(charType);
   auto charAddr = builder.createConvert(loc, refType, dataAndLen.first);
   auto charVal = builder.create<fir::LoadOp>(loc, charType, charAddr);

flang/lib/Optimizer/Dialect/FIRType.cpp

@@ -86,9 +86,25 @@ BoxProcType parseBoxProc(mlir::DialectAsmParser &parser, mlir::Location loc) {
   return parseTypeSingleton<BoxProcType>(parser, loc);
 }
 
-// `char` `<` kind `>`
+// `char` `<` kind [`,` `len`] `>`
 CharacterType parseCharacter(mlir::DialectAsmParser &parser) {
-  return parseKindSingleton<CharacterType>(parser);
+  int kind = 0;
+  if (parser.parseLess() || parser.parseInteger(kind)) {
+    parser.emitError(parser.getCurrentLocation(), "kind value expected");
+    return {};
+  }
+  CharacterType::LenType len = 1;
+  if (mlir::succeeded(parser.parseOptionalComma())) {
+    if (mlir::succeeded(parser.parseOptionalQuestion())) {
+      len = fir::CharacterType::unknownLen();
+    } else if (!mlir::succeeded(parser.parseInteger(len))) {
+      parser.emitError(parser.getCurrentLocation(), "len value expected");
+      return {};
+    }
+  }
+  if (parser.parseGreater())
+    return {};
+  return CharacterType::get(parser.getBuilder().getContext(), kind, len);
 }
 
 // `complex` `<` kind `>`
@@ -169,7 +185,7 @@ SequenceType parseSequence(mlir::DialectAsmParser &parser, mlir::Location) {
   }
   SequenceType::Shape shape;
   if (parser.parseOptionalStar()) {
-    if (parser.parseDimensionList(shape, true)) {
+    if (parser.parseDimensionList(shape, /*allowDynamic=*/true)) {
       parser.emitError(parser.getNameLoc(), "invalid shape");
       return {};
     }
@@ -373,26 +389,35 @@ namespace detail {
 
 /// `CHARACTER` storage
 struct CharacterTypeStorage : public mlir::TypeStorage {
-  using KeyTy = KindTy;
+  using KeyTy = std::tuple<KindTy, CharacterType::LenType>;
 
-  static unsigned hashKey(const KeyTy &key) { return llvm::hash_combine(key); }
+  static unsigned hashKey(const KeyTy &key) {
+    auto hashVal = llvm::hash_combine(std::get<0>(key));
+    return llvm::hash_combine(hashVal, llvm::hash_combine(std::get<1>(key)));
+  }
 
-  bool operator==(const KeyTy &key) const { return key == getFKind(); }
+  bool operator==(const KeyTy &key) const {
+    return key == KeyTy{getFKind(), getLen()};
+  }
 
   static CharacterTypeStorage *construct(mlir::TypeStorageAllocator &allocator,
-                                         KindTy kind) {
+                                         const KeyTy &key) {
     auto *storage = allocator.allocate<CharacterTypeStorage>();
-    return new (storage) CharacterTypeStorage{kind};
+    return new (storage)
+        CharacterTypeStorage{std::get<0>(key), std::get<1>(key)};
   }
 
   KindTy getFKind() const { return kind; }
+  CharacterType::LenType getLen() const { return len; }
 
 protected:
   KindTy kind;
+  CharacterType::LenType len;
 
 private:
   CharacterTypeStorage() = delete;
-  explicit CharacterTypeStorage(KindTy kind) : kind{kind} {}
+  explicit CharacterTypeStorage(KindTy kind, CharacterType::LenType len)
+      : kind{kind}, len{len} {}
 };
 
 /// The type of a derived type part reference
@@ -580,9 +605,9 @@ struct BoxCharTypeStorage : public mlir::TypeStorage {
 
   KindTy getFKind() const { return kind; }
 
-  // a !fir.boxchar<k> always wraps a !fir.char<k>
+  // a !fir.boxchar<k> always wraps a !fir.char<k, ?>
   CharacterType getElementType(mlir::MLIRContext *ctxt) const {
-    return CharacterType::get(ctxt, getFKind());
+    return CharacterType::getUnknownLen(ctxt, getFKind());
   }
 
 protected:
@@ -699,7 +724,7 @@ struct SequenceTypeStorage : public mlir::TypeStorage {
       std::tuple<SequenceType::Shape, mlir::Type, mlir::AffineMapAttr>;
 
   static unsigned hashKey(const KeyTy &key) {
-    auto shapeHash{hash_value(std::get<SequenceType::Shape>(key))};
+    auto shapeHash = hash_value(std::get<SequenceType::Shape>(key));
     shapeHash = llvm::hash_combine(shapeHash, std::get<mlir::Type>(key));
     return llvm::hash_combine(shapeHash, std::get<mlir::AffineMapAttr>(key));
   }
@@ -887,12 +912,17 @@ mlir::Type dyn_cast_ptrEleTy(mlir::Type t) {
 
 // CHARACTER
 
-CharacterType fir::CharacterType::get(mlir::MLIRContext *ctxt, KindTy kind) {
-  return Base::get(ctxt, kind);
+CharacterType fir::CharacterType::get(mlir::MLIRContext *ctxt, KindTy kind,
+                                      CharacterType::LenType len) {
+  return Base::get(ctxt, kind, len);
 }
 
 KindTy fir::CharacterType::getFKind() const { return getImpl()->getFKind(); }
 
+CharacterType::LenType fir::CharacterType::getLen() const {
+  return getImpl()->getLen();
+}
+
 // Field
 
 FieldType fir::FieldType::get(mlir::MLIRContext *ctxt) {
@@ -1235,11 +1265,10 @@ namespace {
 void printBounds(llvm::raw_ostream &os, const SequenceType::Shape &bounds) {
   os << '<';
   for (auto &b : bounds) {
-    if (b >= 0) {
+    if (b >= 0)
       os << b << 'x';
-    } else {
+    else
       os << "?x";
-    }
   }
 }
 
@@ -1277,8 +1306,18 @@ void fir::printFirType(FIROpsDialect *, mlir::Type ty,
     os << '>';
     return;
   }
-  if (auto type = ty.dyn_cast<CharacterType>()) {
-    os << "char<" << type.getFKind() << '>';
+  if (auto chTy = ty.dyn_cast<CharacterType>()) {
+    // Fortran intrinsic type CHARACTER
+    os << "char<" << chTy.getFKind();
+    auto len = chTy.getLen();
+    if (len != fir::CharacterType::singleton()) {
+      os << ',';
+      if (len == fir::CharacterType::unknownLen())
+        os << '?';
+      else
+        os << len;
+    }
+    os << '>';
     return;
   }
   if (auto type = ty.dyn_cast<fir::ComplexType>()) {
@@ -1379,3 +1418,17 @@ void fir::printFirType(FIROpsDialect *, mlir::Type ty,
     return;
   }
 }
+
+bool fir::isa_unknown_size_box(mlir::Type t) {
+  if (auto boxTy = t.dyn_cast<fir::BoxType>()) {
+    auto eleTy = boxTy.getEleTy();
+    if (auto actualEleTy = fir::dyn_cast_ptrEleTy(eleTy))
+      eleTy = actualEleTy;
+    if (eleTy.isa<mlir::NoneType>())
+      return true;
+    if (auto seqTy = eleTy.dyn_cast<fir::SequenceType>())
+      if (seqTy.hasUnknownShape())
+        return true;
+  }
+  return false;
+}

flang/test/Fir/fir-types.fir

@@ -8,11 +8,15 @@
 // CHECK-LABEL: func private @it3() -> !fir.complex<8>
 // CHECK-LABEL: func private @it4() -> !fir.logical<1>
 // CHECK-LABEL: func private @it5() -> !fir.char<1>
+// CHECK-LABEL: func private @it6() -> !fir.char<2,10>
+// CHECK-LABEL: func private @it7() -> !fir.char<4,?>
 func private @it1() -> !fir.int<4>
 func private @it2() -> !fir.real<8>
 func private @it3() -> !fir.complex<8>
 func private @it4() -> !fir.logical<1>
 func private @it5() -> !fir.char<1>
+func private @it6() -> !fir.char<2,10>
+func private @it7() -> !fir.char<4,?>
 
 // Fortran Derived types (records)
 // CHECK-LABEL: func private @dvd1() -> !fir.type<derived1>