Index: flang/include/flang/Optimizer/Dialect/FIRType.h =================================================================== --- flang/include/flang/Optimizer/Dialect/FIRType.h +++ flang/include/flang/Optimizer/Dialect/FIRType.h @@ -100,15 +100,34 @@ // 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 { 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 @@ -445,6 +464,17 @@ return t.isa() || t.isa(); } +inline bool isa_char_string(mlir::Type t) { + if (auto ct = t.dyn_cast_or_null()) + 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 Index: flang/lib/Lower/ConvertType.cpp =================================================================== --- flang/lib/Lower/ConvertType.cpp +++ flang/lib/Lower/ConvertType.cpp @@ -157,7 +157,7 @@ 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 {}; } Index: flang/lib/Lower/IO.cpp =================================================================== --- flang/lib/Lower/IO.cpp +++ flang/lib/Lower/IO.cpp @@ -490,7 +490,7 @@ 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); Index: flang/lib/Lower/IntrinsicCall.cpp =================================================================== --- flang/lib/Lower/IntrinsicCall.cpp +++ flang/lib/Lower/IntrinsicCall.cpp @@ -1085,7 +1085,7 @@ 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(loc, charType, charAddr); Index: flang/lib/Optimizer/Dialect/FIRType.cpp =================================================================== --- flang/lib/Optimizer/Dialect/FIRType.cpp +++ flang/lib/Optimizer/Dialect/FIRType.cpp @@ -86,9 +86,25 @@ return parseTypeSingleton(parser, loc); } -// `char` `<` kind `>` +// `char` `<` kind [`,` `len`] `>` CharacterType parseCharacter(mlir::DialectAsmParser &parser) { - return parseKindSingleton(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 `>` @@ -184,7 +200,7 @@ } SequenceType::Shape shape; if (parser.parseOptionalStar()) { - if (parser.parseDimensionList(shape, true)) { + if (parser.parseDimensionList(shape, /*allowDynamic=*/true)) { parser.emitError(parser.getNameLoc(), "invalid shape"); return {}; } @@ -396,26 +412,35 @@ /// `CHARACTER` storage struct CharacterTypeStorage : public mlir::TypeStorage { - using KeyTy = KindTy; + using KeyTy = std::tuple; - 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(); - 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} {} }; struct ShapeTypeStorage : public mlir::TypeStorage { @@ -672,9 +697,9 @@ KindTy getFKind() const { return kind; } - // a !fir.boxchar always wraps a !fir.char + // a !fir.boxchar always wraps a !fir.char CharacterType getElementType(mlir::MLIRContext *ctxt) const { - return CharacterType::get(ctxt, getFKind()); + return CharacterType::getUnknownLen(ctxt, getFKind()); } protected: @@ -791,7 +816,7 @@ std::tuple; static unsigned hashKey(const KeyTy &key) { - auto shapeHash{hash_value(std::get(key))}; + auto shapeHash = hash_value(std::get(key)); shapeHash = llvm::hash_combine(shapeHash, std::get(key)); return llvm::hash_combine(shapeHash, std::get(key)); } @@ -981,12 +1006,17 @@ // 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) { @@ -1359,11 +1389,10 @@ 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"; - } } } @@ -1401,8 +1430,18 @@ os << '>'; return; } - if (auto type = ty.dyn_cast()) { - os << "char<" << type.getFKind() << '>'; + if (auto chTy = ty.dyn_cast()) { + // 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()) { @@ -1520,3 +1559,17 @@ return; } } + +bool fir::isa_unknown_size_box(mlir::Type t) { + if (auto boxTy = t.dyn_cast()) { + auto eleTy = boxTy.getEleTy(); + if (auto actualEleTy = fir::dyn_cast_ptrEleTy(eleTy)) + eleTy = actualEleTy; + if (eleTy.isa()) + return true; + if (auto seqTy = eleTy.dyn_cast()) + if (seqTy.hasUnknownShape()) + return true; + } + return false; +} Index: flang/test/Fir/fir-types.fir =================================================================== --- flang/test/Fir/fir-types.fir +++ 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