//===-- ConvertConstant.cpp -----------------------------------------------===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
//
// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
//
//===----------------------------------------------------------------------===//
#include "flang/Lower/ConvertConstant.h"
#include "flang/Evaluate/expression.h"
#include "flang/Lower/AbstractConverter.h"
#include "flang/Lower/BuiltinModules.h"
#include "flang/Lower/ConvertExprToHLFIR.h"
#include "flang/Lower/ConvertType.h"
#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/Mangler.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Lower/SymbolMap.h"
#include "flang/Optimizer/Builder/Complex.h"
#include "flang/Optimizer/Builder/MutableBox.h"
#include "flang/Optimizer/Builder/Todo.h"
#include <algorithm>
/// Convert string, \p s, to an APFloat value. Recognize and handle Inf and
/// NaN strings as well. \p s is assumed to not contain any spaces.
static llvm::APFloat consAPFloat(const llvm::fltSemantics &fsem,
llvm::StringRef s) {
assert(!s.contains(' '));
if (s.compare_insensitive("-inf") == 0)
return llvm::APFloat::getInf(fsem, /*negative=*/true);
if (s.compare_insensitive("inf") == 0 || s.compare_insensitive("+inf") == 0)
return llvm::APFloat::getInf(fsem);
// TODO: Add support for quiet and signaling NaNs.
if (s.compare_insensitive("-nan") == 0)
return llvm::APFloat::getNaN(fsem, /*negative=*/true);
if (s.compare_insensitive("nan") == 0 || s.compare_insensitive("+nan") == 0)
return llvm::APFloat::getNaN(fsem);
return {fsem, s};
}
//===----------------------------------------------------------------------===//
// Fortran::lower::tryCreatingDenseGlobal implementation
//===----------------------------------------------------------------------===//
/// Generate an mlir attribute from a literal value
template <Fortran::common::TypeCategory TC, int KIND>
static mlir::Attribute convertToAttribute(
fir::FirOpBuilder &builder,
const Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>> &value,
mlir::Type type) {
if constexpr (TC == Fortran::common::TypeCategory::Integer) {
if constexpr (KIND <= 8)
return builder.getIntegerAttr(type, value.ToInt64());
else {
static_assert(KIND <= 16, "integers with KIND > 16 are not supported");
return builder.getIntegerAttr(
type, llvm::APInt(KIND * 8,
{value.ToUInt64(), value.SHIFTR(64).ToUInt64()}));
}
} else if constexpr (TC == Fortran::common::TypeCategory::Logical) {
return builder.getIntegerAttr(type, value.IsTrue());
} else {
auto getFloatAttr = [&](const auto &value, mlir::Type type) {
std::string str = value.DumpHexadecimal();
auto floatVal =
consAPFloat(builder.getKindMap().getFloatSemantics(KIND), str);
return builder.getFloatAttr(type, floatVal);
};
if constexpr (TC == Fortran::common::TypeCategory::Real) {
return getFloatAttr(value, type);
} else {
static_assert(TC == Fortran::common::TypeCategory::Complex,
"type values cannot be converted to attributes");
mlir::Type eleTy = mlir::cast<mlir::ComplexType>(type).getElementType();
llvm::SmallVector<mlir::Attribute, 2> attrs = {
getFloatAttr(value.REAL(), eleTy),
getFloatAttr(value.AIMAG(), eleTy)};
return builder.getArrayAttr(attrs);
}
}
return {};
}
namespace {
/// Helper class to lower an array constant to a global with an MLIR dense
/// attribute.
///
/// If we have an array of integer, real, complex, or logical, then we can
/// create a global array with the dense attribute.
///
/// The mlir tensor type can only handle integer, real, complex, or logical.
/// It does not currently support nested structures.
class DenseGlobalBuilder {
public:
static fir::GlobalOp tryCreating(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Type symTy,
llvm::StringRef globalName,
mlir::StringAttr linkage, bool isConst,
const Fortran::lower::SomeExpr &initExpr,
cuf::DataAttributeAttr dataAttr) {
DenseGlobalBuilder globalBuilder;
Fortran::common::visit(
Fortran::common::visitors{
[&](const Fortran::evaluate::Expr<Fortran::evaluate::SomeLogical> &
x) { globalBuilder.tryConvertingToAttributes(builder, x); },
[&](const Fortran::evaluate::Expr<Fortran::evaluate::SomeInteger> &
x) { globalBuilder.tryConvertingToAttributes(builder, x); },
[&](const Fortran::evaluate::Expr<Fortran::evaluate::SomeReal> &x) {
globalBuilder.tryConvertingToAttributes(builder, x);
},
[&](const Fortran::evaluate::Expr<Fortran::evaluate::SomeComplex> &
x) { globalBuilder.tryConvertingToAttributes(builder, x); },
[](const auto &) {},
},
initExpr.u);
return globalBuilder.tryCreatingGlobal(builder, loc, symTy, globalName,
linkage, isConst, dataAttr);
}
template <Fortran::common::TypeCategory TC, int KIND>
static fir::GlobalOp tryCreating(
fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type symTy,
llvm::StringRef globalName, mlir::StringAttr linkage, bool isConst,
const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC, KIND>>
&constant,
cuf::DataAttributeAttr dataAttr) {
DenseGlobalBuilder globalBuilder;
globalBuilder.tryConvertingToAttributes(builder, constant);
return globalBuilder.tryCreatingGlobal(builder, loc, symTy, globalName,
linkage, isConst, dataAttr);
}
private:
DenseGlobalBuilder() = default;
/// Try converting an evaluate::Constant to a list of MLIR attributes.
template <Fortran::common::TypeCategory TC, int KIND>
void tryConvertingToAttributes(
fir::FirOpBuilder &builder,
const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC, KIND>>
&constant) {
static_assert(TC != Fortran::common::TypeCategory::Character,
"must be numerical or logical");
auto attrTc = TC == Fortran::common::TypeCategory::Logical
? Fortran::common::TypeCategory::Integer
: TC;
attributeElementType = Fortran::lower::getFIRType(
builder.getContext(), attrTc, KIND, std::nullopt);
for (auto element : constant.values())
attributes.push_back(
convertToAttribute<TC, KIND>(builder, element, attributeElementType));
}
/// Try converting an evaluate::Expr to a list of MLIR attributes.
template <typename SomeCat>
void tryConvertingToAttributes(fir::FirOpBuilder &builder,
const Fortran::evaluate::Expr<SomeCat> &expr) {
Fortran::common::visit(
[&](const auto &x) {
using TR = Fortran::evaluate::ResultType<decltype(x)>;
if (const auto *constant =
std::get_if<Fortran::evaluate::Constant<TR>>(&x.u))
tryConvertingToAttributes<TR::category, TR::kind>(builder,
*constant);
},
expr.u);
}
/// Create a fir::Global if MLIR attributes have been successfully created by
/// tryConvertingToAttributes.
fir::GlobalOp tryCreatingGlobal(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Type symTy,
llvm::StringRef globalName,
mlir::StringAttr linkage, bool isConst,
cuf::DataAttributeAttr dataAttr) const {
// Not a "trivial" intrinsic constant array, or empty array.
if (!attributeElementType || attributes.empty())
return {};
assert(mlir::isa<fir::SequenceType>(symTy) && "expecting an array global");
auto arrTy = mlir::cast<fir::SequenceType>(symTy);
llvm::SmallVector<int64_t> tensorShape(arrTy.getShape());
std::reverse(tensorShape.begin(), tensorShape.end());
auto tensorTy =
mlir::RankedTensorType::get(tensorShape, attributeElementType);
auto init = mlir::DenseElementsAttr::get(tensorTy, attributes);
return builder.createGlobal(loc, symTy, globalName, linkage, init, isConst,
/*isTarget=*/false, dataAttr);
}
llvm::SmallVector<mlir::Attribute> attributes;
mlir::Type attributeElementType;
};
} // namespace
fir::GlobalOp Fortran::lower::tryCreatingDenseGlobal(
fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type symTy,
llvm::StringRef globalName, mlir::StringAttr linkage, bool isConst,
const Fortran::lower::SomeExpr &initExpr, cuf::DataAttributeAttr dataAttr) {
return DenseGlobalBuilder::tryCreating(builder, loc, symTy, globalName,
linkage, isConst, initExpr, dataAttr);
}
//===----------------------------------------------------------------------===//
// Fortran::lower::convertConstant
// Lower a constant to a fir::ExtendedValue.
//===----------------------------------------------------------------------===//
/// Generate a real constant with a value `value`.
template <int KIND>
static mlir::Value genRealConstant(fir::FirOpBuilder &builder,
mlir::Location loc,
const llvm::APFloat &value) {
mlir::Type fltTy = Fortran::lower::convertReal(builder.getContext(), KIND);
return builder.createRealConstant(loc, fltTy, value);
}
/// Convert a scalar literal constant to IR.
template <Fortran::common::TypeCategory TC, int KIND>
static mlir::Value genScalarLit(
fir::FirOpBuilder &builder, mlir::Location loc,
const Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>> &value) {
if constexpr (TC == Fortran::common::TypeCategory::Integer) {
mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND,
std::nullopt);
if (KIND == 16) {
auto bigInt =
llvm::APInt(ty.getIntOrFloatBitWidth(), value.SignedDecimal(), 10);
return builder.create<mlir::arith::ConstantOp>(
loc, ty, mlir::IntegerAttr::get(ty, bigInt));
}
return builder.createIntegerConstant(loc, ty, value.ToInt64());
} else if constexpr (TC == Fortran::common::TypeCategory::Logical) {
return builder.createBool(loc, value.IsTrue());
} else if constexpr (TC == Fortran::common::TypeCategory::Real) {
std::string str = value.DumpHexadecimal();
if constexpr (KIND == 2) {
auto floatVal = consAPFloat(llvm::APFloatBase::IEEEhalf(), str);
return genRealConstant<KIND>(builder, loc, floatVal);
} else if constexpr (KIND == 3) {
auto floatVal = consAPFloat(llvm::APFloatBase::BFloat(), str);
return genRealConstant<KIND>(builder, loc, floatVal);
} else if constexpr (KIND == 4) {
auto floatVal = consAPFloat(llvm::APFloatBase::IEEEsingle(), str);
return genRealConstant<KIND>(builder, loc, floatVal);
} else if constexpr (KIND == 10) {
auto floatVal = consAPFloat(llvm::APFloatBase::x87DoubleExtended(), str);
return genRealConstant<KIND>(builder, loc, floatVal);
} else if constexpr (KIND == 16) {
auto floatVal = consAPFloat(llvm::APFloatBase::IEEEquad(), str);
return genRealConstant<KIND>(builder, loc, floatVal);
} else {
// convert everything else to double
auto floatVal = consAPFloat(llvm::APFloatBase::IEEEdouble(), str);
return genRealConstant<KIND>(builder, loc, floatVal);
}
} else if constexpr (TC == Fortran::common::TypeCategory::Complex) {
mlir::Value real = genScalarLit<Fortran::common::TypeCategory::Real, KIND>(
builder, loc, value.REAL());
mlir::Value imag = genScalarLit<Fortran::common::TypeCategory::Real, KIND>(
builder, loc, value.AIMAG());
return fir::factory::Complex{builder, loc}.createComplex(real, imag);
} else /*constexpr*/ {
llvm_unreachable("unhandled constant");
}
}
/// Create fir::string_lit from a scalar character constant.
template <int KIND>
static fir::StringLitOp
createStringLitOp(fir::FirOpBuilder &builder, mlir::Location loc,
const Fortran::evaluate::Scalar<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Character, KIND>> &value,
[[maybe_unused]] int64_t len) {
if constexpr (KIND == 1) {
assert(value.size() == static_cast<std::uint64_t>(len));
return builder.createStringLitOp(loc, value);
} else {
using ET = typename std::decay_t<decltype(value)>::value_type;
fir::CharacterType type =
fir::CharacterType::get(builder.getContext(), KIND, len);
mlir::MLIRContext *context = builder.getContext();
std::int64_t size = static_cast<std::int64_t>(value.size());
mlir::ShapedType shape = mlir::RankedTensorType::get(
llvm::ArrayRef<std::int64_t>{size},
mlir::IntegerType::get(builder.getContext(), sizeof(ET) * 8));
auto denseAttr = mlir::DenseElementsAttr::get(
shape, llvm::ArrayRef<ET>{value.data(), value.size()});
auto denseTag = mlir::StringAttr::get(context, fir::StringLitOp::xlist());
mlir::NamedAttribute dataAttr(denseTag, denseAttr);
auto sizeTag = mlir::StringAttr::get(context, fir::StringLitOp::size());
mlir::NamedAttribute sizeAttr(sizeTag, builder.getI64IntegerAttr(len));
llvm::SmallVector<mlir::NamedAttribute> attrs = {dataAttr, sizeAttr};
return builder.create<fir::StringLitOp>(
loc, llvm::ArrayRef<mlir::Type>{type}, std::nullopt, attrs);
}
}
/// Convert a scalar literal CHARACTER to IR.
template <int KIND>
static mlir::Value
genScalarLit(fir::FirOpBuilder &builder, mlir::Location loc,
const Fortran::evaluate::Scalar<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Character, KIND>> &value,
int64_t len, bool outlineInReadOnlyMemory) {
// When in an initializer context, construct the literal op itself and do
// not construct another constant object in rodata.
if (!outlineInReadOnlyMemory)
return createStringLitOp<KIND>(builder, loc, value, len);
// Otherwise, the string is in a plain old expression so "outline" the value
// in read only data by hash consing it to a constant literal object.
// ASCII global constants are created using an mlir string attribute.
if constexpr (KIND == 1) {
return fir::getBase(fir::factory::createStringLiteral(builder, loc, value));
}
auto size = builder.getKindMap().getCharacterBitsize(KIND) / 8 * value.size();
llvm::StringRef strVal(reinterpret_cast<const char *>(value.c_str()), size);
std::string globalName = fir::factory::uniqueCGIdent(
KIND == 1 ? "cl"s : "cl"s + std::to_string(KIND), strVal);
fir::GlobalOp global = builder.getNamedGlobal(globalName);
fir::CharacterType type =
fir::CharacterType::get(builder.getContext(), KIND, len);
if (!global)
global = builder.createGlobalConstant(
loc, type, globalName,
[&](fir::FirOpBuilder &builder) {
fir::StringLitOp str =
createStringLitOp<KIND>(builder, loc, value, len);
builder.create<fir::HasValueOp>(loc, str);
},
builder.createLinkOnceLinkage());
return builder.create<fir::AddrOfOp>(loc, global.resultType(),
global.getSymbol());
}
// Helper to generate StructureConstructor component values.
static fir::ExtendedValue
genConstantValue(Fortran::lower::AbstractConverter &converter,
mlir::Location loc,
const Fortran::lower::SomeExpr &constantExpr);
static mlir::Value genStructureComponentInit(
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
const Fortran::semantics::Symbol &sym, const Fortran::lower::SomeExpr &expr,
mlir::Value res) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
fir::RecordType recTy = mlir::cast<fir::RecordType>(res.getType());
std::string name = converter.getRecordTypeFieldName(sym);
mlir::Type componentTy = recTy.getType(name);
auto fieldTy = fir::FieldType::get(recTy.getContext());
assert(componentTy && "failed to retrieve component");
// FIXME: type parameters must come from the derived-type-spec
auto field = builder.create<fir::FieldIndexOp>(
loc, fieldTy, name, recTy,
/*typeParams=*/mlir::ValueRange{} /*TODO*/);
if (Fortran::semantics::IsAllocatable(sym)) {
if (!Fortran::evaluate::IsNullPointer(expr)) {
fir::emitFatalError(loc, "constant structure constructor with an "
"allocatable component value that is not NULL");
} else {
// Handle NULL() initialization
mlir::Value componentValue{fir::factory::createUnallocatedBox(
builder, loc, componentTy, std::nullopt)};
componentValue = builder.createConvert(loc, componentTy, componentValue);
return builder.create<fir::InsertValueOp>(
loc, recTy, res, componentValue,
builder.getArrayAttr(field.getAttributes()));
}
}
if (Fortran::semantics::IsPointer(sym)) {
mlir::Value initialTarget;
if (Fortran::semantics::IsProcedure(sym)) {
if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr))
initialTarget =
fir::factory::createNullBoxProc(builder, loc, componentTy);
else {
Fortran::lower::SymMap globalOpSymMap;
Fortran::lower::StatementContext stmtCtx;
auto box{getBase(Fortran::lower::convertExprToAddress(
loc, converter, expr, globalOpSymMap, stmtCtx))};
initialTarget = builder.createConvert(loc, componentTy, box);
}
} else
initialTarget = Fortran::lower::genInitialDataTarget(converter, loc,
componentTy, expr);
res = builder.create<fir::InsertValueOp>(
loc, recTy, res, initialTarget,
builder.getArrayAttr(field.getAttributes()));
return res;
}
if (Fortran::lower::isDerivedTypeWithLenParameters(sym))
TODO(loc, "component with length parameters in structure constructor");
// Special handling for scalar c_ptr/c_funptr constants. The array constant
// must fall through to genConstantValue() below.
if (Fortran::semantics::IsBuiltinCPtr(sym) && sym.Rank() == 0 &&
(Fortran::evaluate::GetLastSymbol(expr) ||
Fortran::evaluate::IsNullPointer(expr))) {
// Builtin c_ptr and c_funptr have special handling because designators
// and NULL() are handled as initial values for them as an extension
// (otherwise only c_ptr_null/c_funptr_null are allowed and these are
// replaced by structure constructors by semantics, so GetLastSymbol
// returns nothing).
// The Ev::Expr is an initializer that is a pointer target (e.g., 'x' or
// NULL()) that must be inserted into an intermediate cptr record value's
// address field, which ought to be an intptr_t on the target.
mlir::Value addr = fir::getBase(
Fortran::lower::genExtAddrInInitializer(converter, loc, expr));
if (mlir::isa<fir::BoxProcType>(addr.getType()))
addr = builder.create<fir::BoxAddrOp>(loc, addr);
assert((fir::isa_ref_type(addr.getType()) ||
mlir::isa<mlir::FunctionType>(addr.getType())) &&
"expect reference type for address field");
assert(fir::isa_derived(componentTy) &&
"expect C_PTR, C_FUNPTR to be a record");
auto cPtrRecTy = mlir::cast<fir::RecordType>(componentTy);
llvm::StringRef addrFieldName = Fortran::lower::builtin::cptrFieldName;
mlir::Type addrFieldTy = cPtrRecTy.getType(addrFieldName);
auto addrField = builder.create<fir::FieldIndexOp>(
loc, fieldTy, addrFieldName, componentTy,
/*typeParams=*/mlir::ValueRange{});
mlir::Value castAddr = builder.createConvert(loc, addrFieldTy, addr);
auto undef = builder.create<fir::UndefOp>(loc, componentTy);
addr = builder.create<fir::InsertValueOp>(
loc, componentTy, undef, castAddr,
builder.getArrayAttr(addrField.getAttributes()));
res = builder.create<fir::InsertValueOp>(
loc, recTy, res, addr, builder.getArrayAttr(field.getAttributes()));
return res;
}
mlir::Value val = fir::getBase(genConstantValue(converter, loc, expr));
assert(!fir::isa_ref_type(val.getType()) && "expecting a constant value");
mlir::Value castVal = builder.createConvert(loc, componentTy, val);
res = builder.create<fir::InsertValueOp>(
loc, recTy, res, castVal, builder.getArrayAttr(field.getAttributes()));
return res;
}
// Generate a StructureConstructor inlined (returns raw fir.type<T> 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 = mlir::cast<fir::RecordType>(type);
if (!converter.getLoweringOptions().getLowerToHighLevelFIR()) {
mlir::Value res = builder.create<fir::UndefOp>(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");
res = genStructureComponentInit(converter, loc, sym, expr.value(), res);
}
return res;
}
auto fieldTy = fir::FieldType::get(recTy.getContext());
mlir::Value res{};
// When the first structure component values belong to some parent type PT
// and the next values belong to a type extension ET, a new undef for ET must
// be created and the previous PT value inserted into it. There may
// be empty parent types in between ET and PT, hence the list and while loop.
auto insertParentValueIntoExtension = [&](mlir::Type typeExtension) {
assert(res && "res must be set");
llvm::SmallVector<mlir::Type> parentTypes = {typeExtension};
while (true) {
fir::RecordType last = mlir::cast<fir::RecordType>(parentTypes.back());
mlir::Type next =
last.getType(0); // parent components are first in HLFIR.
if (next != res.getType())
parentTypes.push_back(next);
else
break;
}
for (mlir::Type parentType : llvm::reverse(parentTypes)) {
auto undef = builder.create<fir::UndefOp>(loc, parentType);
fir::RecordType parentRecTy = mlir::cast<fir::RecordType>(parentType);
auto field = builder.create<fir::FieldIndexOp>(
loc, fieldTy, parentRecTy.getTypeList()[0].first, parentType,
/*typeParams=*/mlir::ValueRange{} /*TODO*/);
res = builder.create<fir::InsertValueOp>(
loc, parentRecTy, undef, res,
builder.getArrayAttr(field.getAttributes()));
}
};
const Fortran::semantics::DerivedTypeSpec *curentType = nullptr;
for (const auto &[sym, expr] : ctor.values()) {
const Fortran::semantics::DerivedTypeSpec *componentParentType =
sym->owner().derivedTypeSpec();
assert(componentParentType && "failed to retrieve component parent type");
if (!res) {
mlir::Type parentType = converter.genType(*componentParentType);
curentType = componentParentType;
res = builder.create<fir::UndefOp>(loc, parentType);
} else if (*componentParentType != *curentType) {
mlir::Type parentType = converter.genType(*componentParentType);
insertParentValueIntoExtension(parentType);
curentType = componentParentType;
}
res = genStructureComponentInit(converter, loc, sym, expr.value(), res);
}
if (!res) // structure constructor for empty type.
return builder.create<fir::UndefOp>(loc, recTy);
// The last component may belong to a parent type.
if (res.getType() != recTy)
insertParentValueIntoExtension(recTy);
return res;
}
static mlir::Value genScalarLit(
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
const Fortran::evaluate::Scalar<Fortran::evaluate::SomeDerived> &value,
mlir::Type eleTy, bool outlineBigConstantsInReadOnlyMemory) {
if (!outlineBigConstantsInReadOnlyMemory)
return genInlinedStructureCtorLitImpl(converter, loc, value, eleTy);
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
auto expr = std::make_unique<Fortran::lower::SomeExpr>(toEvExpr(
Fortran::evaluate::Constant<Fortran::evaluate::SomeDerived>(value)));
llvm::StringRef globalName =
converter.getUniqueLitName(loc, std::move(expr), eleTy);
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<fir::HasValueOp>(loc, result);
},
builder.createInternalLinkage());
}
return builder.create<fir::AddrOfOp>(loc, global.resultType(),
global.getSymbol());
}
/// Create an evaluate::Constant<T> 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 <typename T>
static mlir::Value
genInlinedArrayLit(Fortran::lower::AbstractConverter &converter,
mlir::Location loc, mlir::Type arrayTy,
const Fortran::evaluate::Constant<T> &con) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
mlir::IndexType idxTy = builder.getIndexType();
Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds();
auto createIdx = [&]() {
llvm::SmallVector<mlir::Attribute> idx;
for (size_t i = 0; i < subscripts.size(); ++i)
idx.push_back(
builder.getIntegerAttr(idxTy, subscripts[i] - con.lbounds()[i]));
return idx;
};
mlir::Value array = builder.create<fir::UndefOp>(loc, arrayTy);
if (Fortran::evaluate::GetSize(con.shape()) == 0)
return array;
if constexpr (T::category == Fortran::common::TypeCategory::Character) {
do {
mlir::Value elementVal =
genScalarLit<T::kind>(builder, loc, con.At(subscripts), con.LEN(),
/*outlineInReadOnlyMemory=*/false);
array = builder.create<fir::InsertValueOp>(
loc, arrayTy, array, elementVal, builder.getArrayAttr(createIdx()));
} while (con.IncrementSubscripts(subscripts));
} else if constexpr (T::category == Fortran::common::TypeCategory::Derived) {
do {
mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrayTy).getEleTy();
mlir::Value elementVal =
genScalarLit(converter, loc, con.At(subscripts), eleTy,
/*outlineInReadOnlyMemory=*/false);
array = builder.create<fir::InsertValueOp>(
loc, arrayTy, array, elementVal, builder.getArrayAttr(createIdx()));
} while (con.IncrementSubscripts(subscripts));
} else {
llvm::SmallVector<mlir::Attribute> rangeStartIdx;
uint64_t rangeSize = 0;
mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrayTy).getEleTy();
do {
auto getElementVal = [&]() {
return builder.createConvert(loc, eleTy,
genScalarLit<T::category, T::kind>(
builder, loc, con.At(subscripts)));
};
Fortran::evaluate::ConstantSubscripts nextSubscripts = subscripts;
bool nextIsSame = con.IncrementSubscripts(nextSubscripts) &&
con.At(subscripts) == con.At(nextSubscripts);
if (!rangeSize && !nextIsSame) { // single (non-range) value
array = builder.create<fir::InsertValueOp>(
loc, arrayTy, array, getElementVal(),
builder.getArrayAttr(createIdx()));
} else if (!rangeSize) { // start a range
rangeStartIdx = createIdx();
rangeSize = 1;
} else if (nextIsSame) { // expand a range
++rangeSize;
} else { // end a range
llvm::SmallVector<int64_t> rangeBounds;
llvm::SmallVector<mlir::Attribute> idx = createIdx();
for (size_t i = 0; i < idx.size(); ++i) {
rangeBounds.push_back(mlir::cast<mlir::IntegerAttr>(rangeStartIdx[i])
.getValue()
.getSExtValue());
rangeBounds.push_back(
mlir::cast<mlir::IntegerAttr>(idx[i]).getValue().getSExtValue());
}
array = builder.create<fir::InsertOnRangeOp>(
loc, arrayTy, array, getElementVal(),
builder.getIndexVectorAttr(rangeBounds));
rangeSize = 0;
}
} while (con.IncrementSubscripts(subscripts));
}
return array;
}
/// Convert an evaluate::Constant<T> array into a fir.ref<fir.array<>> value
/// 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 <typename T>
static mlir::Value
genOutlineArrayLit(Fortran::lower::AbstractConverter &converter,
mlir::Location loc, mlir::Type arrayTy,
const Fortran::evaluate::Constant<T> &constant) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrayTy).getEleTy();
llvm::StringRef globalName = converter.getUniqueLitName(
loc, std::make_unique<Fortran::lower::SomeExpr>(toEvExpr(constant)),
eleTy);
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 (T::category == Fortran::common::TypeCategory::Logical ||
T::category == Fortran::common::TypeCategory::Integer ||
T::category == Fortran::common::TypeCategory::Real ||
T::category == Fortran::common::TypeCategory::Complex) {
global = DenseGlobalBuilder::tryCreating(
builder, loc, arrayTy, globalName, builder.createInternalLinkage(),
true, constant, {});
}
if (!global)
// If the number of elements of the array is huge, the compilation may
// use a lot of memory and take a very long time to complete.
// Empirical evidence shows that an array with 150000 elements of
// complex type takes roughly 30 seconds to compile and uses 4GB of RAM,
// on a modern machine.
// It would be nice to add a driver switch to control the array size
// after which flang should not continue to compile.
global = builder.createGlobalConstant(
loc, arrayTy, globalName,
[&](fir::FirOpBuilder &builder) {
mlir::Value result =
genInlinedArrayLit(converter, loc, arrayTy, constant);
builder.create<fir::HasValueOp>(loc, result);
},
builder.createInternalLinkage());
}
return builder.create<fir::AddrOfOp>(loc, global.resultType(),
global.getSymbol());
}
/// Convert an evaluate::Constant<T> array into an fir::ExtendedValue.
template <typename T>
static fir::ExtendedValue
genArrayLit(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
const Fortran::evaluate::Constant<T> &con,
bool outlineInReadOnlyMemory) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
Fortran::evaluate::ConstantSubscript size =
Fortran::evaluate::GetSize(con.shape());
if (size > std::numeric_limits<std::uint32_t>::max())
// llvm::SmallVector has limited size
TODO(loc, "Creation of very large array constants");
fir::SequenceType::Shape shape(con.shape().begin(), con.shape().end());
llvm::SmallVector<std::int64_t> typeParams;
if constexpr (T::category == Fortran::common::TypeCategory::Character)
typeParams.push_back(con.LEN());
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(converter, loc, arrayTy, con)
: genInlinedArrayLit(converter, loc, arrayTy, con);
mlir::IndexType idxTy = builder.getIndexType();
llvm::SmallVector<mlir::Value> extents;
for (auto extent : shape)
extents.push_back(builder.createIntegerConstant(loc, idxTy, extent));
// Convert lower bounds if they are not all ones.
llvm::SmallVector<mlir::Value> lbounds;
if (llvm::any_of(con.lbounds(), [](auto lb) { return lb != 1; }))
for (auto lb : con.lbounds())
lbounds.push_back(builder.createIntegerConstant(loc, idxTy, lb));
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 {
return fir::ArrayBoxValue{array, extents, lbounds};
}
}
template <typename T>
fir::ExtendedValue Fortran::lower::ConstantBuilder<T>::gen(
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
const Fortran::evaluate::Constant<T> &constant,
bool outlineBigConstantsInReadOnlyMemory) {
if (constant.Rank() > 0)
return genArrayLit(converter, loc, constant,
outlineBigConstantsInReadOnlyMemory);
std::optional<Fortran::evaluate::Scalar<T>> opt = constant.GetScalarValue();
assert(opt.has_value() && "constant has no value");
if constexpr (T::category == Fortran::common::TypeCategory::Character) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
auto value =
genScalarLit<T::kind>(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<T::category, T::kind>(converter.getFirOpBuilder(), loc,
opt.value());
}
}
static fir::ExtendedValue
genConstantValue(Fortran::lower::AbstractConverter &converter,
mlir::Location loc,
const Fortran::evaluate::Expr<Fortran::evaluate::SomeDerived>
&constantExpr) {
if (const auto *constant = std::get_if<
Fortran::evaluate::Constant<Fortran::evaluate::SomeDerived>>(
&constantExpr.u))
return Fortran::lower::convertConstant(converter, loc, *constant,
/*outline=*/false);
if (const auto *structCtor =
std::get_if<Fortran::evaluate::StructureConstructor>(&constantExpr.u))
return Fortran::lower::genInlinedStructureCtorLit(converter, loc,
*structCtor);
fir::emitFatalError(loc, "not a constant derived type expression");
}
template <Fortran::common::TypeCategory TC, int KIND>
static fir::ExtendedValue genConstantValue(
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
const Fortran::evaluate::Expr<Fortran::evaluate::Type<TC, KIND>>
&constantExpr) {
using T = Fortran::evaluate::Type<TC, KIND>;
if (const auto *constant =
std::get_if<Fortran::evaluate::Constant<T>>(&constantExpr.u))
return Fortran::lower::convertConstant(converter, loc, *constant,
/*outline=*/false);
fir::emitFatalError(loc, "not an evaluate::Constant<T>");
}
static fir::ExtendedValue
genConstantValue(Fortran::lower::AbstractConverter &converter,
mlir::Location loc,
const Fortran::lower::SomeExpr &constantExpr) {
return Fortran::common::visit(
[&](const auto &x) -> fir::ExtendedValue {
using T = std::decay_t<decltype(x)>;
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 Fortran::common::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_SPECIFIC_TYPE(template class Fortran::lower::ConstantBuilder, )
Codebase Browser
llvm