From 2d9b4a50cae8d18516a61977768a48d1f92ac33c Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Thu, 5 Jan 2023 14:45:14 +0100 Subject: [PATCH] [flang][NFC] share Constant lowering A previous patch (https://reviews.llvm.org/D136955) already refactored intrinsic constant lowering to place in its own file and allow using it from both the current lowering and the new lowering to HLFIR. This patch does the same for derived types. The core function "genStructComponentInInitializer" is moved from ConvertExpr.cpp and renamed "genInlinedStructureCtorLitImpl" into ConvertConstant.cpp without significant logic change. Then, genScalarLit, genArrayLit (and genInlinedArrayLit/genOutlinedArrayLit) are updated to support derived types. The core aspect of derived type constant lowering that differs between the current lowering and the HLFIR update is the way addresses/initial target descriptors are built when part of a derived type constant. This part happens in ConvertVariable.cpp (since the address of a variable is taken in an initializer and is left TODO). The mangling of derived type global literal constant is fixed: it did not embed the derived type name and could cause "conflicts" between unrelated derived types containing the same data. However, the hash remains unstable between two compilation of the same file. This is not a correctness issue and would require a lot of work to hash the derived type constant data without hashing some irrelevant (but not out of bound) data in the compile time data structure that holds derived type constants (Constant). This may have to be revisited later. Differential Revision: https://reviews.llvm.org/D140986 --- flang/include/flang/Lower/ConvertConstant.h | 55 +++-- flang/include/flang/Lower/ConvertType.h | 2 + flang/include/flang/Lower/Mangler.h | 17 +- flang/lib/Lower/ConvertConstant.cpp | 301 +++++++++++++++++++++---- flang/lib/Lower/ConvertExpr.cpp | 175 +------------- flang/lib/Lower/ConvertExprToHLFIR.cpp | 31 ++- flang/lib/Lower/ConvertType.cpp | 9 + flang/lib/Lower/ConvertVariable.cpp | 4 + flang/lib/Lower/Mangler.cpp | 10 +- flang/test/Lower/HLFIR/constant-derived.f90 | 38 ++++ flang/test/Lower/constant-literal-mangling.f90 | 40 ++++ 11 files changed, 424 insertions(+), 258 deletions(-) create mode 100644 flang/test/Lower/HLFIR/constant-derived.f90 create mode 100644 flang/test/Lower/constant-literal-mangling.f90 diff --git a/flang/include/flang/Lower/ConvertConstant.h b/flang/include/flang/Lower/ConvertConstant.h index 52a9744..c49cbbc 100644 --- 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 @@ fir::GlobalOp tryCreatingDenseGlobal(fir::FirOpBuilder &builder, 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 index ef01d90..f86cc00 100644 --- a/flang/include/flang/Lower/ConvertType.h +++ b/flang/include/flang/Lower/ConvertType.h @@ -86,6 +86,8 @@ mlir::Type translateVariableToFIRType(Fortran::lower::AbstractConverter &, /// 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 index 251ffac..49ba0e7 100644 --- 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 @@ std::string 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 @@ std::string mangleArrayLiteral( template std::string -mangleArrayLiteral(const Fortran::evaluate::Constant> &x) { return mangleArrayLiteral( reinterpret_cast(x.values().data()), @@ -83,12 +87,19 @@ mangleArrayLiteral(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 index 958fa12..331aa7e7 100644 --- 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 @@ fir::GlobalOp Fortran::lower::tryCreatingDenseGlobal( } //===----------------------------------------------------------------------===// -// 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 @@ genScalarLit(fir::FirOpBuilder &builder, mlir::Location loc, 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 @@ static mlir::Value genInlinedArrayLit( 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 @@ static mlir::Value genInlinedArrayLit( 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 @@ static mlir::Value genInlinedArrayLit( /// 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 @@ static mlir::Value genOutlineArrayLit( 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 @@ static mlir::Value genOutlineArrayLit( } /// 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 @@ static fir::ExtendedValue genArrayLit( 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 @@ static fir::ExtendedValue genArrayLit( 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 @@ static fir::ExtendedValue genArrayLit( } } -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 index b525c56..035ccad 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -957,98 +957,15 @@ public: 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 @@ public: 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 @@ private: }; } - 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 index 2f68b29..481c04f 100644 --- a/flang/lib/Lower/ConvertExprToHLFIR.cpp +++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -829,25 +829,20 @@ private: 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 index 9861441..a3068b3 100644 --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -484,6 +484,15 @@ mlir::Type Fortran::lower::convertReal(mlir::MLIRContext *context, int kind) { 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 index d222449..2279d74 100644 --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -170,6 +170,8 @@ static mlir::Type unwrapElementType(mlir::Type type) { 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 @@ mlir::Value Fortran::lower::genInitialDataTarget( 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 index 902c18d..5bc8520 100644 --- a/flang/lib/Lower/Mangler.cpp +++ b/flang/lib/Lower/Mangler.cpp @@ -188,7 +188,8 @@ std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) { // 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 @@ static std::string typeToString(Fortran::common::TypeCategory cat, int kind) { 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 @@ std::string Fortran::lower::mangle::mangleArrayLiteral( 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 index 0000000..4da714e --- /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 index 0000000..abb2754 --- /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 -- 2.7.4