diff --git a/flang/include/flang/Lower/ConvertConstant.h b/flang/include/flang/Lower/ConvertConstant.h --- a/flang/include/flang/Lower/ConvertConstant.h +++ b/flang/include/flang/Lower/ConvertConstant.h @@ -23,31 +23,36 @@ #include "flang/Optimizer/Builder/FIRBuilder.h" namespace Fortran::lower { -template -class ConstantBuilder {}; +class AbstractConverter; -/// Class to lower intrinsic evaluate::Constant to fir::ExtendedValue. -template -class ConstantBuilder> { +/// Class to lower evaluate::Constant to fir::ExtendedValue. +template +class ConstantBuilder { public: /// Lower \p constant into a fir::ExtendedValue. - /// If \p outlineBigConstantsInReadOnlyMemory is set, character and array - /// constants will be lowered into read only memory fir.global, and the - /// resulting fir::ExtendedValue will contain the address of the fir.global. - /// This option should not be set if the constant is being lowered while the - /// builder is already in a fir.global body because fir.global initialization - /// body cannot contain code manipulating memory (e.g. fir.load/fir.store...). - static fir::ExtendedValue - gen(fir::FirOpBuilder &builder, mlir::Location loc, - const evaluate::Constant> &constant, - bool outlineBigConstantsInReadOnlyMemory); + /// If \p outlineBigConstantsInReadOnlyMemory is set, character, derived + /// type, and array constants will be lowered into read only memory + /// fir.global, and the resulting fir::ExtendedValue will contain the address + /// of the fir.global. This option should not be set if the constant is being + /// lowered while the builder is already in a fir.global body because + /// fir.global initialization body cannot contain code manipulating memory + /// (e.g. fir.load/fir.store...). + static fir::ExtendedValue gen(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, + const evaluate::Constant &constant, + bool outlineBigConstantsInReadOnlyMemory); }; - -template -using IntrinsicConstantBuilder = ConstantBuilder>; - using namespace evaluate; -FOR_EACH_INTRINSIC_KIND(extern template class ConstantBuilder, ) +FOR_EACH_SPECIFIC_TYPE(extern template class ConstantBuilder, ) + +template +fir::ExtendedValue convertConstant(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, + const evaluate::Constant &constant, + bool outlineBigConstantsInReadOnlyMemory) { + return ConstantBuilder::gen(converter, loc, constant, + outlineBigConstantsInReadOnlyMemory); +} /// Create a fir.global array with a dense attribute containing the value of /// \p initExpr. @@ -61,6 +66,16 @@ mlir::StringAttr linkage, bool isConst, const Fortran::lower::SomeExpr &initExpr); +/// Lower a StructureConstructor that must be lowered in read only data although +/// it may not be wrapped into a Constant (this may be the case for derived +/// type descriptor compiler generated data that is not fully compliant with +/// Fortran constant expression but can and must still be lowered into read only +/// memory). +fir::ExtendedValue +genInlinedStructureCtorLit(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, + const Fortran::evaluate::StructureConstructor &ctor); + } // namespace Fortran::lower #endif // FORTRAN_LOWER_CONVERTCONSTANT_H diff --git a/flang/include/flang/Lower/ConvertType.h b/flang/include/flang/Lower/ConvertType.h --- a/flang/include/flang/Lower/ConvertType.h +++ b/flang/include/flang/Lower/ConvertType.h @@ -86,6 +86,8 @@ /// Translate a REAL of KIND to the mlir::Type. mlir::Type convertReal(mlir::MLIRContext *ctxt, int KIND); +bool isDerivedTypeWithLenParameters(const semantics::Symbol &); + template class TypeBuilder { public: diff --git a/flang/include/flang/Lower/Mangler.h b/flang/include/flang/Lower/Mangler.h --- a/flang/include/flang/Lower/Mangler.h +++ b/flang/include/flang/Lower/Mangler.h @@ -14,6 +14,7 @@ #define FORTRAN_LOWER_MANGLER_H #include "flang/Evaluate/expression.h" +#include "flang/Optimizer/Dialect/FIRType.h" #include "mlir/IR/BuiltinTypes.h" #include "llvm/ADT/StringRef.h" #include @@ -63,10 +64,12 @@ mangleArrayLiteral(const uint8_t *addr, size_t size, const Fortran::evaluate::ConstantSubscripts &shape, Fortran::common::TypeCategory cat, int kind = 0, - Fortran::common::ConstantSubscript charLen = -1); + Fortran::common::ConstantSubscript charLen = -1, + llvm::StringRef derivedName = {}); template std::string mangleArrayLiteral( + mlir::Type, const Fortran::evaluate::Constant> &x) { return mangleArrayLiteral( reinterpret_cast(x.values().data()), @@ -75,7 +78,8 @@ template std::string -mangleArrayLiteral(const Fortran::evaluate::Constant> &x) { return mangleArrayLiteral( reinterpret_cast(x.values().data()), @@ -83,12 +87,19 @@ Fortran::common::TypeCategory::Character, KIND, x.LEN()); } +// FIXME: derived type mangling is safe but not reproducible between two +// compilation of a same file because `values().data()` is a nontrivial compile +// time data structure containing pointers and vectors. In particular, this +// means that similar structure constructors are not "combined" into the same +// global constant by lowering. inline std::string mangleArrayLiteral( + mlir::Type eleTy, const Fortran::evaluate::Constant &x) { return mangleArrayLiteral( reinterpret_cast(x.values().data()), x.values().size() * sizeof(x.values()[0]), x.shape(), - Fortran::common::TypeCategory::Derived); + Fortran::common::TypeCategory::Derived, /*kind=*/0, /*charLen=*/-1, + eleTy.cast().getName()); } /// Return the compiler-generated name of a static namelist variable descriptor. diff --git a/flang/lib/Lower/ConvertConstant.cpp b/flang/lib/Lower/ConvertConstant.cpp --- a/flang/lib/Lower/ConvertConstant.cpp +++ b/flang/lib/Lower/ConvertConstant.cpp @@ -12,7 +12,10 @@ #include "flang/Lower/ConvertConstant.h" #include "flang/Evaluate/expression.h" +#include "flang/Lower/AbstractConverter.h" +#include "flang/Lower/BuiltinModules.h" #include "flang/Lower/ConvertType.h" +#include "flang/Lower/ConvertVariable.h" #include "flang/Lower/Mangler.h" #include "flang/Optimizer/Builder/Complex.h" #include "flang/Optimizer/Builder/Todo.h" @@ -179,8 +182,8 @@ } //===----------------------------------------------------------------------===// -// Fortran::lower::IntrinsicConstantBuilder::gen -// Lower an array constant to a fir::ExtendedValue. +// Fortran::lower::convertConstant +// Lower a constant to a fir::ExtendedValue. //===----------------------------------------------------------------------===// /// Generate a real constant with a value `value`. @@ -315,13 +318,128 @@ global.getSymbol()); } +// Helper to generate StructureConstructor component values. +static fir::ExtendedValue +genConstantValue(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, + const Fortran::lower::SomeExpr &constantExpr); + +// Generate a StructureConstructor inlined (returns raw fir.type value, +// not the address of a global constant). +static mlir::Value genInlinedStructureCtorLitImpl( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const Fortran::evaluate::StructureConstructor &ctor, mlir::Type type) { + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + auto recTy = type.cast(); + auto fieldTy = fir::FieldType::get(type.getContext()); + mlir::Value res = builder.create(loc, recTy); + + for (const auto &[sym, expr] : ctor.values()) { + // Parent components need more work because they do not appear in the + // fir.rec type. + if (sym->test(Fortran::semantics::Symbol::Flag::ParentComp)) + TODO(loc, "parent component in structure constructor"); + + llvm::StringRef name = toStringRef(sym->name()); + mlir::Type componentTy = recTy.getType(name); + // FIXME: type parameters must come from the derived-type-spec + auto field = builder.create( + loc, fieldTy, name, type, + /*typeParams=*/mlir::ValueRange{} /*TODO*/); + + if (Fortran::semantics::IsAllocatable(sym)) + TODO(loc, "allocatable component in structure constructor"); + + if (Fortran::semantics::IsPointer(sym)) { + mlir::Value initialTarget = Fortran::lower::genInitialDataTarget( + converter, loc, componentTy, expr.value()); + res = builder.create( + loc, recTy, res, initialTarget, + builder.getArrayAttr(field.getAttributes())); + continue; + } + + if (Fortran::lower::isDerivedTypeWithLenParameters(sym)) + TODO(loc, "component with length parameters in structure constructor"); + + if (Fortran::semantics::IsBuiltinCPtr(sym)) { + // Builtin c_ptr and c_funptr have special handling because initial + // values are handled for them as an extension. + mlir::Value addr = fir::getBase(Fortran::lower::genExtAddrInInitializer( + converter, loc, expr.value())); + if (addr.getType() == componentTy) { + // Do nothing. The Ev::Expr was returned as a value that can be + // inserted directly to the component without an intermediary. + } else { + // The Ev::Expr returned is an initializer that is a pointer (e.g., + // null) that must be inserted into an intermediate cptr record + // value's address field, which ought to be an intptr_t on the target. + assert((fir::isa_ref_type(addr.getType()) || + addr.getType().isa()) && + "expect reference type for address field"); + assert(fir::isa_derived(componentTy) && + "expect C_PTR, C_FUNPTR to be a record"); + auto cPtrRecTy = componentTy.cast(); + llvm::StringRef addrFieldName = Fortran::lower::builtin::cptrFieldName; + mlir::Type addrFieldTy = cPtrRecTy.getType(addrFieldName); + auto addrField = builder.create( + loc, fieldTy, addrFieldName, componentTy, + /*typeParams=*/mlir::ValueRange{}); + mlir::Value castAddr = builder.createConvert(loc, addrFieldTy, addr); + auto undef = builder.create(loc, componentTy); + addr = builder.create( + loc, componentTy, undef, castAddr, + builder.getArrayAttr(addrField.getAttributes())); + } + res = builder.create( + loc, recTy, res, addr, builder.getArrayAttr(field.getAttributes())); + continue; + } + + mlir::Value val = + fir::getBase(genConstantValue(converter, loc, expr.value())); + assert(!fir::isa_ref_type(val.getType()) && "expecting a constant value"); + mlir::Value castVal = builder.createConvert(loc, componentTy, val); + res = builder.create( + loc, recTy, res, castVal, builder.getArrayAttr(field.getAttributes())); + } + return res; +} + +static mlir::Value genScalarLit( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const Fortran::evaluate::Scalar &value, + mlir::Type eleTy, bool outlineBigConstantsInReadOnlyMemory) { + if (!outlineBigConstantsInReadOnlyMemory) + return genInlinedStructureCtorLitImpl(converter, loc, value, eleTy); + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + std::string globalName = Fortran::lower::mangle::mangleArrayLiteral( + eleTy, + Fortran::evaluate::Constant(value)); + fir::GlobalOp global = builder.getNamedGlobal(globalName); + if (!global) { + global = builder.createGlobalConstant( + loc, eleTy, globalName, + [&](fir::FirOpBuilder &builder) { + mlir::Value result = + genInlinedStructureCtorLitImpl(converter, loc, value, eleTy); + builder.create(loc, result); + }, + builder.createInternalLinkage()); + } + return builder.create(loc, global.resultType(), + global.getSymbol()); +} + /// Create an evaluate::Constant array to a fir.array<> value /// built with a chain of fir.insert or fir.insert_on_range operations. /// This is intended to be called when building the body of a fir.global. -template -static mlir::Value genInlinedArrayLit( - fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type arrayTy, - const Fortran::evaluate::Constant> &con) { +template +static mlir::Value +genInlinedArrayLit(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::Type arrayTy, + const Fortran::evaluate::Constant &con) { + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); mlir::IndexType idxTy = builder.getIndexType(); Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds(); auto createIdx = [&]() { @@ -334,11 +452,20 @@ mlir::Value array = builder.create(loc, arrayTy); if (Fortran::evaluate::GetSize(con.shape()) == 0) return array; - if constexpr (TC == Fortran::common::TypeCategory::Character) { + if constexpr (T::category == Fortran::common::TypeCategory::Character) { + do { + mlir::Value elementVal = + genScalarLit(builder, loc, con.At(subscripts), con.LEN(), + /*outlineInReadOnlyMemory=*/false); + array = builder.create( + loc, arrayTy, array, elementVal, builder.getArrayAttr(createIdx())); + } while (con.IncrementSubscripts(subscripts)); + } else if constexpr (T::category == Fortran::common::TypeCategory::Derived) { do { + mlir::Type eleTy = arrayTy.cast().getEleTy(); mlir::Value elementVal = - genScalarLit(builder, loc, con.At(subscripts), con.LEN(), - /*outlineInReadOnlyMemory=*/false); + genScalarLit(converter, loc, con.At(subscripts), eleTy, + /*outlineInReadOnlyMemory=*/false); array = builder.create( loc, arrayTy, array, elementVal, builder.getArrayAttr(createIdx())); } while (con.IncrementSubscripts(subscripts)); @@ -348,9 +475,9 @@ mlir::Type eleTy = arrayTy.cast().getEleTy(); do { auto getElementVal = [&]() { - return builder.createConvert( - loc, eleTy, - genScalarLit(builder, loc, con.At(subscripts))); + return builder.createConvert(loc, eleTy, + genScalarLit( + builder, loc, con.At(subscripts))); }; Fortran::evaluate::ConstantSubscripts nextSubscripts = subscripts; bool nextIsSame = con.IncrementSubscripts(nextSubscripts) && @@ -389,20 +516,23 @@ /// that points to the storage of a fir.global in read only memory and is /// initialized with the value of the constant. /// This should not be called while generating the body of a fir.global. -template -static mlir::Value genOutlineArrayLit( - fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type arrayTy, - const Fortran::evaluate::Constant> - &constant) { - std::string globalName = Fortran::lower::mangle::mangleArrayLiteral(constant); +template +static mlir::Value +genOutlineArrayLit(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, mlir::Type arrayTy, + const Fortran::evaluate::Constant &constant) { + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + mlir::Type eleTy = arrayTy.cast().getEleTy(); + std::string globalName = + Fortran::lower::mangle::mangleArrayLiteral(eleTy, constant); fir::GlobalOp global = builder.getNamedGlobal(globalName); if (!global) { // Using a dense attribute for the initial value instead of creating an // intialization body speeds up MLIR/LLVM compilation, but this is not // always possible. - if constexpr (TC == Fortran::common::TypeCategory::Logical || - TC == Fortran::common::TypeCategory::Integer || - TC == Fortran::common::TypeCategory::Real) { + if constexpr (T::category == Fortran::common::TypeCategory::Logical || + T::category == Fortran::common::TypeCategory::Integer || + T::category == Fortran::common::TypeCategory::Real) { global = DenseGlobalBuilder::tryCreating( builder, loc, arrayTy, globalName, builder.createInternalLinkage(), true, constant); @@ -412,7 +542,7 @@ loc, arrayTy, globalName, [&](fir::FirOpBuilder &builder) { mlir::Value result = - genInlinedArrayLit(builder, loc, arrayTy, constant); + genInlinedArrayLit(converter, loc, arrayTy, constant); builder.create(loc, result); }, builder.createInternalLinkage()); @@ -422,11 +552,12 @@ } /// Convert an evaluate::Constant array into an fir::ExtendedValue. -template -static fir::ExtendedValue genArrayLit( - fir::FirOpBuilder &builder, mlir::Location loc, - const Fortran::evaluate::Constant> &con, - bool outlineInReadOnlyMemory) { +template +static fir::ExtendedValue +genArrayLit(Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const Fortran::evaluate::Constant &con, + bool outlineInReadOnlyMemory) { + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); Fortran::evaluate::ConstantSubscript size = Fortran::evaluate::GetSize(con.shape()); if (size > std::numeric_limits::max()) @@ -434,14 +565,19 @@ TODO(loc, "Creation of very large array constants"); fir::SequenceType::Shape shape(con.shape().begin(), con.shape().end()); llvm::SmallVector typeParams; - if constexpr (TC == Fortran::common::TypeCategory::Character) + if constexpr (T::category == Fortran::common::TypeCategory::Character) typeParams.push_back(con.LEN()); - mlir::Type eleTy = - Fortran::lower::getFIRType(builder.getContext(), TC, KIND, typeParams); + mlir::Type eleTy; + if constexpr (T::category == Fortran::common::TypeCategory::Derived) + eleTy = Fortran::lower::translateDerivedTypeToFIRType( + converter, con.GetType().GetDerivedTypeSpec()); + else + eleTy = Fortran::lower::getFIRType(builder.getContext(), T::category, + T::kind, typeParams); auto arrayTy = fir::SequenceType::get(shape, eleTy); mlir::Value array = outlineInReadOnlyMemory - ? genOutlineArrayLit(builder, loc, arrayTy, con) - : genInlinedArrayLit(builder, loc, arrayTy, con); + ? genOutlineArrayLit(converter, loc, arrayTy, con) + : genInlinedArrayLit(converter, loc, arrayTy, con); mlir::IndexType idxTy = builder.getIndexType(); llvm::SmallVector extents; @@ -453,7 +589,7 @@ for (auto lb : con.lbounds()) lbounds.push_back(builder.createIntegerConstant(loc, idxTy, lb)); - if constexpr (TC == Fortran::common::TypeCategory::Character) { + if constexpr (T::category == Fortran::common::TypeCategory::Character) { mlir::Value len = builder.createIntegerConstant(loc, idxTy, con.LEN()); return fir::CharArrayBoxValue{array, len, extents, lbounds}; } else { @@ -461,29 +597,98 @@ } } -template -fir::ExtendedValue -Fortran::lower::ConstantBuilder>::gen( - fir::FirOpBuilder &builder, mlir::Location loc, - const Fortran::evaluate::Constant> - &constant, +template +fir::ExtendedValue Fortran::lower::ConstantBuilder::gen( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const Fortran::evaluate::Constant &constant, bool outlineBigConstantsInReadOnlyMemory) { if (constant.Rank() > 0) - return genArrayLit(builder, loc, constant, - outlineBigConstantsInReadOnlyMemory); - std::optional>> - opt = constant.GetScalarValue(); + return genArrayLit(converter, loc, constant, + outlineBigConstantsInReadOnlyMemory); + std::optional> opt = constant.GetScalarValue(); assert(opt.has_value() && "constant has no value"); - if constexpr (TC == Fortran::common::TypeCategory::Character) { - auto value = genScalarLit(builder, loc, opt.value(), constant.LEN(), - outlineBigConstantsInReadOnlyMemory); + if constexpr (T::category == Fortran::common::TypeCategory::Character) { + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + auto value = + genScalarLit(builder, loc, opt.value(), constant.LEN(), + outlineBigConstantsInReadOnlyMemory); mlir::Value len = builder.createIntegerConstant( loc, builder.getCharacterLengthType(), constant.LEN()); return fir::CharBoxValue{value, len}; + } else if constexpr (T::category == Fortran::common::TypeCategory::Derived) { + mlir::Type eleTy = Fortran::lower::translateDerivedTypeToFIRType( + converter, opt->GetType().GetDerivedTypeSpec()); + return genScalarLit(converter, loc, *opt, eleTy, + outlineBigConstantsInReadOnlyMemory); } else { - return genScalarLit(builder, loc, opt.value()); + return genScalarLit(converter.getFirOpBuilder(), loc, + opt.value()); } } +static fir::ExtendedValue +genConstantValue(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, + const Fortran::evaluate::Expr + &constantExpr) { + if (const auto *constant = std::get_if< + Fortran::evaluate::Constant>( + &constantExpr.u)) + return Fortran::lower::convertConstant(converter, loc, *constant, + /*outline=*/false); + if (const auto *structCtor = + std::get_if(&constantExpr.u)) + return Fortran::lower::genInlinedStructureCtorLit(converter, loc, + *structCtor); + fir::emitFatalError(loc, "not a constant derived type expression"); +} + +template +static fir::ExtendedValue genConstantValue( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const Fortran::evaluate::Expr> + &constantExpr) { + using T = Fortran::evaluate::Type; + if (const auto *constant = + std::get_if>(&constantExpr.u)) + return Fortran::lower::convertConstant(converter, loc, *constant, + /*outline=*/false); + fir::emitFatalError(loc, "not an evaluate::Constant"); +} + +static fir::ExtendedValue +genConstantValue(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, + const Fortran::lower::SomeExpr &constantExpr) { + return std::visit( + [&](const auto &x) -> fir::ExtendedValue { + using T = std::decay_t; + if constexpr (Fortran::common::HasMember< + T, Fortran::lower::CategoryExpression>) { + if constexpr (T::Result::category == + Fortran::common::TypeCategory::Derived) { + return genConstantValue(converter, loc, x); + } else { + return std::visit( + [&](const auto &preciseKind) { + return genConstantValue(converter, loc, preciseKind); + }, + x.u); + } + } else { + fir::emitFatalError(loc, "unexpected typeless constant value"); + } + }, + constantExpr.u); +} + +fir::ExtendedValue Fortran::lower::genInlinedStructureCtorLit( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const Fortran::evaluate::StructureConstructor &ctor) { + mlir::Type type = Fortran::lower::translateDerivedTypeToFIRType( + converter, ctor.derivedTypeSpec()); + return genInlinedStructureCtorLitImpl(converter, loc, ctor, type); +} + using namespace Fortran::evaluate; -FOR_EACH_INTRINSIC_KIND(template class Fortran::lower::ConstantBuilder, ) +FOR_EACH_SPECIFIC_TYPE(template class Fortran::lower::ConstantBuilder, ) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -957,98 +957,15 @@ return false; } - /// Lower structure constructor without a temporary. This can be used in - /// fir::GloablOp, and assumes that the structure component is a constant. - ExtValue genStructComponentInInitializer( - const Fortran::evaluate::StructureConstructor &ctor) { - mlir::Location loc = getLoc(); - mlir::Type ty = translateSomeExprToFIRType(converter, toEvExpr(ctor)); - auto recTy = ty.cast(); - auto fieldTy = fir::FieldType::get(ty.getContext()); - mlir::Value res = builder.create(loc, recTy); - - for (const auto &[sym, expr] : ctor.values()) { - // Parent components need more work because they do not appear in the - // fir.rec type. - if (sym->test(Fortran::semantics::Symbol::Flag::ParentComp)) - TODO(loc, "parent component in structure constructor"); - - llvm::StringRef name = toStringRef(sym->name()); - mlir::Type componentTy = recTy.getType(name); - // FIXME: type parameters must come from the derived-type-spec - auto field = builder.create( - loc, fieldTy, name, ty, - /*typeParams=*/mlir::ValueRange{} /*TODO*/); - - if (Fortran::semantics::IsAllocatable(sym)) - TODO(loc, "allocatable component in structure constructor"); - - if (Fortran::semantics::IsPointer(sym)) { - mlir::Value initialTarget = Fortran::lower::genInitialDataTarget( - converter, loc, componentTy, expr.value()); - res = builder.create( - loc, recTy, res, initialTarget, - builder.getArrayAttr(field.getAttributes())); - continue; - } - - if (isDerivedTypeWithLenParameters(sym)) - TODO(loc, "component with length parameters in structure constructor"); - - if (Fortran::semantics::IsBuiltinCPtr(sym)) { - // Builtin c_ptr and c_funptr have special handling because initial - // value are handled for them as an extension. - mlir::Value addr = fir::getBase(Fortran::lower::genExtAddrInInitializer( - converter, loc, expr.value())); - if (addr.getType() == componentTy) { - // Do nothing. The Ev::Expr was returned as a value that can be - // inserted directly to the component without an intermediary. - } else { - // The Ev::Expr returned is an initializer that is a pointer (e.g., - // null) that must be inserted into an intermediate cptr record - // value's address field, which ought to be an intptr_t on the target. - assert((fir::isa_ref_type(addr.getType()) || - addr.getType().isa()) && - "expect reference type for address field"); - assert(fir::isa_derived(componentTy) && - "expect C_PTR, C_FUNPTR to be a record"); - auto cPtrRecTy = componentTy.cast(); - llvm::StringRef addrFieldName = - Fortran::lower::builtin::cptrFieldName; - mlir::Type addrFieldTy = cPtrRecTy.getType(addrFieldName); - auto addrField = builder.create( - loc, fieldTy, addrFieldName, componentTy, - /*typeParams=*/mlir::ValueRange{}); - mlir::Value castAddr = builder.createConvert(loc, addrFieldTy, addr); - auto undef = builder.create(loc, componentTy); - addr = builder.create( - loc, componentTy, undef, castAddr, - builder.getArrayAttr(addrField.getAttributes())); - } - res = builder.create( - loc, recTy, res, addr, builder.getArrayAttr(field.getAttributes())); - continue; - } - - mlir::Value val = fir::getBase(genval(expr.value())); - assert(!fir::isa_ref_type(val.getType()) && "expecting a constant value"); - mlir::Value castVal = builder.createConvert(loc, componentTy, val); - res = builder.create( - loc, recTy, res, castVal, - builder.getArrayAttr(field.getAttributes())); - } - return res; - } - /// A structure constructor is lowered two ways. In an initializer context, /// the entire structure must be constant, so the aggregate value is /// constructed inline. This allows it to be the body of a GlobalOp. /// Otherwise, the structure constructor is in an expression. In that case, a /// temporary object is constructed in the stack frame of the procedure. ExtValue genval(const Fortran::evaluate::StructureConstructor &ctor) { - if (inInitializer) - return genStructComponentInInitializer(ctor); mlir::Location loc = getLoc(); + if (inInitializer) + return Fortran::lower::genInlinedStructureCtorLit(converter, loc, ctor); mlir::Type ty = translateSomeExprToFIRType(converter, toEvExpr(ctor)); auto recTy = ty.cast(); auto fieldTy = fir::FieldType::get(ty.getContext()); @@ -1450,53 +1367,22 @@ llvm_unreachable("unhandled logical operation"); } - fir::ExtendedValue genArrayLit( - const Fortran::evaluate::Constant &con) { - mlir::Location loc = getLoc(); - mlir::IndexType idxTy = builder.getIndexType(); - Fortran::evaluate::ConstantSubscript size = - Fortran::evaluate::GetSize(con.shape()); - fir::SequenceType::Shape shape(con.shape().begin(), con.shape().end()); - mlir::Type eleTy = converter.genType(con.GetType().GetDerivedTypeSpec()); - auto arrayTy = fir::SequenceType::get(shape, eleTy); - mlir::Value array = builder.create(loc, arrayTy); - llvm::SmallVector lbounds; - llvm::SmallVector extents; - for (auto [lb, extent] : llvm::zip(con.lbounds(), con.shape())) { - lbounds.push_back(builder.createIntegerConstant(loc, idxTy, lb - 1)); - extents.push_back(builder.createIntegerConstant(loc, idxTy, extent)); - } - if (size == 0) - return fir::ArrayBoxValue{array, extents, lbounds}; - Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds(); - do { - mlir::Value derivedVal = fir::getBase(genval(con.At(subscripts))); - llvm::SmallVector idx; - for (auto [dim, lb] : llvm::zip(subscripts, con.lbounds())) - idx.push_back(builder.getIntegerAttr(idxTy, dim - lb)); - array = builder.create( - loc, arrayTy, array, derivedVal, builder.getArrayAttr(idx)); - } while (con.IncrementSubscripts(subscripts)); - return fir::ArrayBoxValue{array, extents, lbounds}; - } - template ExtValue genval(const Fortran::evaluate::Constant> &con) { - return Fortran::lower::IntrinsicConstantBuilder::gen( - builder, getLoc(), con, + return Fortran::lower::convertConstant( + converter, getLoc(), con, /*outlineBigConstantsInReadOnlyMemory=*/!inInitializer); } fir::ExtendedValue genval( const Fortran::evaluate::Constant &con) { - if (con.Rank() > 0) - return genArrayLit(con); if (auto ctor = con.GetScalarValue()) return genval(*ctor); - fir::emitFatalError(getLoc(), - "constant of derived type has no constructor"); + return Fortran::lower::convertConstant( + converter, getLoc(), con, + /*outlineBigConstantsInReadOnlyMemory=*/false); } template @@ -5202,54 +5088,15 @@ }; } - template - CC genarr( - const Fortran::evaluate::Constant> &x) { + template + CC genarr(const Fortran::evaluate::Constant &x) { if (x.Rank() == 0) return genScalarAndForwardValue(x); - return genarr(Fortran::lower::IntrinsicConstantBuilder::gen( - builder, getLoc(), x, + return genarr(Fortran::lower::convertConstant( + converter, getLoc(), x, /*outlineBigConstantsInReadOnlyMemory=*/true)); } - CC genarr( - const Fortran::evaluate::Constant &x) { - if (x.Rank() == 0) - return genScalarAndForwardValue(x); - mlir::Location loc = getLoc(); - mlir::IndexType idxTy = builder.getIndexType(); - mlir::Type arrTy = converter.genType(toEvExpr(x)); - std::string globalName = Fortran::lower::mangle::mangleArrayLiteral(x); - fir::GlobalOp global = builder.getNamedGlobal(globalName); - if (!global) { - global = builder.createGlobalConstant( - loc, arrTy, globalName, - [&](fir::FirOpBuilder &builder) { - Fortran::lower::StatementContext stmtCtx( - /*cleanupProhibited=*/true); - fir::ExtendedValue result = - Fortran::lower::createSomeInitializerExpression( - loc, converter, toEvExpr(x), symMap, stmtCtx); - mlir::Value castTo = - builder.createConvert(loc, arrTy, fir::getBase(result)); - builder.create(loc, castTo); - }, - builder.createInternalLinkage()); - } - auto addr = builder.create(getLoc(), global.resultType(), - global.getSymbol()); - auto seqTy = global.getType().cast(); - llvm::SmallVector extents; - for (auto extent : seqTy.getShape()) - extents.push_back(builder.createIntegerConstant(loc, idxTy, extent)); - if (auto charTy = seqTy.getEleTy().dyn_cast()) { - mlir::Value len = builder.createIntegerConstant(loc, builder.getI64Type(), - charTy.getLen()); - return genarr(fir::CharArrayBoxValue{addr, len, extents}); - } - return genarr(fir::ArrayBoxValue{addr, extents}); - } - //===--------------------------------------------------------------------===// // A vector subscript expression may be wrapped with a cast to INTEGER*8. // Get rid of it here so the vector can be loaded. Add it back when diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp --- a/flang/lib/Lower/ConvertExprToHLFIR.cpp +++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -829,25 +829,20 @@ template hlfir::EntityWithAttributes gen(const Fortran::evaluate::Constant &expr) { mlir::Location loc = getLoc(); - if constexpr (std::is_same_v) { - TODO(loc, "lowering derived type constant to HLFIR"); - } else { - fir::FirOpBuilder &builder = getBuilder(); - fir::ExtendedValue exv = - Fortran::lower::IntrinsicConstantBuilder::gen( - builder, loc, expr, /*outlineBigConstantInReadOnlyMemory=*/true); - if (const auto *scalarBox = exv.getUnboxed()) - if (fir::isa_trivial(scalarBox->getType())) - return hlfir::EntityWithAttributes(*scalarBox); - if (auto addressOf = fir::getBase(exv).getDefiningOp()) { - auto flags = fir::FortranVariableFlagsAttr::get( - builder.getContext(), fir::FortranVariableFlagsEnum::parameter); - return hlfir::genDeclare( - loc, builder, exv, - addressOf.getSymbol().getRootReference().getValue(), flags); - } - fir::emitFatalError(loc, "Constant was lowered to unexpected format"); + fir::FirOpBuilder &builder = getBuilder(); + fir::ExtendedValue exv = Fortran::lower::convertConstant( + converter, loc, expr, /*outlineBigConstantInReadOnlyMemory=*/true); + if (const auto *scalarBox = exv.getUnboxed()) + if (fir::isa_trivial(scalarBox->getType())) + return hlfir::EntityWithAttributes(*scalarBox); + if (auto addressOf = fir::getBase(exv).getDefiningOp()) { + auto flags = fir::FortranVariableFlagsAttr::get( + builder.getContext(), fir::FortranVariableFlagsEnum::parameter); + return hlfir::genDeclare( + loc, builder, exv, + addressOf.getSymbol().getRootReference().getValue(), flags); } + fir::emitFatalError(loc, "Constant was lowered to unexpected format"); } template diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -484,6 +484,15 @@ return genRealType(context, kind); } +bool Fortran::lower::isDerivedTypeWithLenParameters( + const Fortran::semantics::Symbol &sym) { + if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType()) + if (const Fortran::semantics::DerivedTypeSpec *derived = + declTy->AsDerived()) + return Fortran::semantics::CountLenParameters(*derived) > 0; + return false; +} + template mlir::Type Fortran::lower::TypeBuilder::genType( Fortran::lower::AbstractConverter &converter, diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -170,6 +170,8 @@ fir::ExtendedValue Fortran::lower::genExtAddrInInitializer( Fortran::lower::AbstractConverter &converter, mlir::Location loc, const Fortran::lower::SomeExpr &addr) { + if (converter.getLoweringOptions().getLowerToHighLevelFIR()) + TODO(loc, "generate initializer address in HLFIR"); Fortran::lower::SymMap globalOpSymMap; Fortran::lower::AggregateStoreMap storeMap; Fortran::lower::StatementContext stmtCtx; @@ -193,6 +195,8 @@ Fortran::lower::AbstractConverter &converter, mlir::Location loc, mlir::Type boxType, const Fortran::lower::SomeExpr &initialTarget, bool couldBeInEquivalence) { + if (converter.getLoweringOptions().getLowerToHighLevelFIR()) + TODO(loc, "initial data target in HLFIR"); Fortran::lower::SymMap globalOpSymMap; Fortran::lower::AggregateStoreMap storeMap; Fortran::lower::StatementContext stmtCtx; diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp --- a/flang/lib/Lower/Mangler.cpp +++ b/flang/lib/Lower/Mangler.cpp @@ -188,7 +188,8 @@ // Array Literals Mangling //===----------------------------------------------------------------------===// -static std::string typeToString(Fortran::common::TypeCategory cat, int kind) { +static std::string typeToString(Fortran::common::TypeCategory cat, int kind, + llvm::StringRef derivedName) { switch (cat) { case Fortran::common::TypeCategory::Integer: return "i" + std::to_string(kind); @@ -201,8 +202,7 @@ case Fortran::common::TypeCategory::Character: return "c" + std::to_string(kind); case Fortran::common::TypeCategory::Derived: - // FIXME: Replace "DT" with the (fully qualified) type name. - return "dt.DT"; + return derivedName.str(); } llvm_unreachable("bad TypeCategory"); } @@ -211,13 +211,13 @@ const uint8_t *addr, size_t size, const Fortran::evaluate::ConstantSubscripts &shape, Fortran::common::TypeCategory cat, int kind, - Fortran::common::ConstantSubscript charLen) { + Fortran::common::ConstantSubscript charLen, llvm::StringRef derivedName) { std::string typeId; for (Fortran::evaluate::ConstantSubscript extent : shape) typeId.append(std::to_string(extent)).append("x"); if (charLen >= 0) typeId.append(std::to_string(charLen)).append("x"); - typeId.append(typeToString(cat, kind)); + typeId.append(typeToString(cat, kind, derivedName)); std::string name = fir::NameUniquer::doGenerated("ro."s.append(typeId).append(".")); if (!size) diff --git a/flang/test/Lower/HLFIR/constant-derived.f90 b/flang/test/Lower/HLFIR/constant-derived.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/HLFIR/constant-derived.f90 @@ -0,0 +1,38 @@ +! Test lowering of Constant. +! TODO: remove "-I nowhere" once derived type descriptor can be lowered. +! RUN: bbc -hlfir -emit-fir -o - -I nowhere %s 2>&1 | FileCheck %s + +subroutine test_constant_scalar() + type myderived + integer :: i + integer :: j = 42 + real :: x(2) + character(10) :: c + end type + print *, myderived(i=1, x=[2.,3.], c="hello") +! CHECK-LABEL: func.func @_QPtest_constant_scalar() { +! CHECK: fir.address_of(@[[CST:_QQro._QFtest_constant_scalarTmyderived..*]]) +end subroutine + +! CHECK: fir.global internal @[[CST]] constant : !fir.type<[[DERIVED:_QFtest_constant_scalarTmyderived{i:i32,j:i32,x:!fir.array<2xf32>,c:!fir.char<1,10>}]]> { +! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<[[DERIVED]]> +! CHECK: %[[VAL_1:.*]] = fir.field_index i, !fir.type<[[DERIVED]]> +! CHECK: %[[VAL_2:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_2]], ["i", !fir.type<[[DERIVED]]>] : (!fir.type<[[DERIVED]]>, i32) -> !fir.type<[[DERIVED]]> +! CHECK: %[[VAL_4:.*]] = fir.field_index j, !fir.type<[[DERIVED]]> +! CHECK: %[[VAL_5:.*]] = arith.constant 42 : i32 +! CHECK: %[[VAL_6:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_5]], ["j", !fir.type<[[DERIVED]]>] : (!fir.type<[[DERIVED]]>, i32) -> !fir.type<[[DERIVED]]> +! CHECK: %[[VAL_7:.*]] = fir.field_index x, !fir.type<[[DERIVED]]> +! CHECK: %[[VAL_8:.*]] = fir.undefined !fir.array<2xf32> +! CHECK: %[[VAL_9:.*]] = arith.constant 2.000000e+00 : f32 +! CHECK: %[[VAL_10:.*]] = fir.insert_value %[[VAL_8]], %[[VAL_9]], [0 : index] : (!fir.array<2xf32>, f32) -> !fir.array<2xf32> +! CHECK: %[[VAL_11:.*]] = arith.constant 3.000000e+00 : f32 +! CHECK: %[[VAL_12:.*]] = fir.insert_value %[[VAL_10]], %[[VAL_11]], [1 : index] : (!fir.array<2xf32>, f32) -> !fir.array<2xf32> +! CHECK: %[[VAL_13:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_14:.*]] = fir.insert_value %[[VAL_6]], %[[VAL_12]], ["x", !fir.type<[[DERIVED]]>] : (!fir.type<[[DERIVED]]>, !fir.array<2xf32>) -> !fir.type<[[DERIVED]]> +! CHECK: %[[VAL_15:.*]] = fir.field_index c, !fir.type<[[DERIVED]]> +! CHECK: %[[VAL_16:.*]] = fir.string_lit "hello "(10) : !fir.char<1,10> +! CHECK: %[[VAL_17:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_18:.*]] = fir.insert_value %[[VAL_14]], %[[VAL_16]], ["c", !fir.type<[[DERIVED]]>] : (!fir.type<[[DERIVED]]>, !fir.char<1,10>) -> !fir.type<[[DERIVED]]> +! CHECK: fir.has_value %[[VAL_18]] : !fir.type<[[DERIVED]]> +! CHECK: } diff --git a/flang/test/Lower/constant-literal-mangling.f90 b/flang/test/Lower/constant-literal-mangling.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/constant-literal-mangling.f90 @@ -0,0 +1,40 @@ +! Test the names created for globals holding constant literal values +! RUN: bbc -emit-fir -o - %s | FileCheck %s + +type someType + integer :: i +end type + + print *, [42, 42] +! CHECK: fir.address_of(@_QQro.2xi4.53fa91e04725d4ee6f22cf1e2d38428a) + + print *, reshape([42, 42, 42, 42, 42, 42], [2,3]) +! CHECK: fir.address_of(@_QQro.2x3xi4.9af8c8182bab45c4e7888ec3623db3b6) + + print *, [42_8, 42_8] +! CHECK: fir.address_of(@_QQro.2xi8.3b1356831516d19b976038974b2673ac) + + print *, [0.42, 0.42] +! CHECK: fir.address_of(@_QQro.2xr4.3c5becae2e4426ad1615e253139ceff8) + + print *, [0.42_8, 0.42_8] +! CHECK: fir.address_of(@_QQro.2xr8.ebefec8f7537fbf54acc4530e75084e6) + + print *, [.true.] +! CHECK: fir.address_of(@_QQro.1xl4.4352d88a78aa39750bf70cd6f27bcaa5) + + print *, [.true._8] +! CHECK: fir.address_of(@_QQro.1xl8.33cdeccccebe80329f1fdbee7f5874cb) + + print *, [(1., -1.), (-1., 1)] +! CHECK: fir.address_of(@_QQro.2xz4.ac09ecb1abceb4f9cad4b1a50000074e) + + print *, [(1._8, -1._8), (-1._8, 1._8)] +! CHECK: fir.address_of(@_QQro.2xz8.a3652db37055e37d2cae8198ae4cd959) + + print *, [someType(42), someType(43)] +! CHECK: fir.address_of(@_QQro.2x_QFTsometype. +! Note: the hash for derived types cannot clash with other constant in the same +! compilation unit, but is unstable because it hashes some noise contained in +! unused std::vector storage. +end