[flang] Handle lowering of ranked array

This patch adds lowering of ranked array as function return.

This patch is part of the upstreaming effort from fir-dev branch.

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D119835

Co-authored-by: Jean Perier <jperier@nvidia.com>
This commit is contained in:
Valentin Clement 2022-02-15 16:00:28 +01:00
parent bfc1217119
commit c807aa53ee
No known key found for this signature in database
GPG Key ID: 086D54783C928776
3 changed files with 115 additions and 1 deletions

View File

@ -155,6 +155,21 @@ public:
FirPlaceHolder::resultEntityPosition, Property::Value);
}
void buildExplicitInterface(
const Fortran::evaluate::characteristics::Procedure &procedure) {
// Handle result
if (const std::optional<Fortran::evaluate::characteristics::FunctionResult>
&result = procedure.functionResult) {
if (result->CanBeReturnedViaImplicitInterface())
handleImplicitResult(*result);
else
handleExplicitResult(*result);
} else if (interface.side().hasAlternateReturns()) {
addFirResult(mlir::IndexType::get(&mlirContext),
FirPlaceHolder::resultEntityPosition, Property::Value);
}
}
private:
void handleImplicitResult(
const Fortran::evaluate::characteristics::FunctionResult &result) {
@ -182,6 +197,57 @@ private:
}
}
void handleExplicitResult(
const Fortran::evaluate::characteristics::FunctionResult &result) {
using Attr = Fortran::evaluate::characteristics::FunctionResult::Attr;
if (result.IsProcedurePointer())
TODO(interface.converter.getCurrentLocation(),
"procedure pointer results");
const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape =
result.GetTypeAndShape();
assert(typeAndShape && "expect type for non proc pointer result");
Fortran::evaluate::DynamicType dynamicType = typeAndShape->type();
if (dynamicType.category() == Fortran::common::TypeCategory::Character) {
TODO(interface.converter.getCurrentLocation(),
"implicit result character type");
} else if (dynamicType.category() ==
Fortran::common::TypeCategory::Derived) {
TODO(interface.converter.getCurrentLocation(),
"implicit result derived type");
}
mlir::Type mlirType =
getConverter().genType(dynamicType.category(), dynamicType.kind());
fir::SequenceType::Shape bounds = getBounds(typeAndShape->shape());
if (!bounds.empty())
mlirType = fir::SequenceType::get(bounds, mlirType);
if (result.attrs.test(Attr::Allocatable))
mlirType = fir::BoxType::get(fir::HeapType::get(mlirType));
if (result.attrs.test(Attr::Pointer))
mlirType = fir::BoxType::get(fir::PointerType::get(mlirType));
addFirResult(mlirType, FirPlaceHolder::resultEntityPosition,
Property::Value);
}
fir::SequenceType::Shape getBounds(const Fortran::evaluate::Shape &shape) {
fir::SequenceType::Shape bounds;
for (Fortran::evaluate::MaybeExtentExpr extentExpr : shape) {
fir::SequenceType::Extent extent = fir::SequenceType::getUnknownExtent();
if (std::optional<std::int64_t> constantExtent =
toInt64(std::move(extentExpr)))
extent = *constantExtent;
bounds.push_back(extent);
}
return bounds;
}
template <typename A>
std::optional<std::int64_t> toInt64(A &&expr) {
return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold(
getConverter().getFoldingContext(), std::move(expr)));
}
void addFirResult(mlir::Type type, int entityPosition, Property p) {
interface.outputs.emplace_back(FirPlaceHolder{type, entityPosition, p});
}
@ -201,7 +267,7 @@ void Fortran::lower::CallInterface<T>::determineInterface(
if (isImplicit)
impl.buildImplicitInterface(procedure);
else
TODO_NOLOC("determineImplicitInterface");
impl.buildExplicitInterface(procedure);
}
template <typename T>

View File

@ -154,6 +154,17 @@ public:
TypeBuilder(Fortran::lower::AbstractConverter &converter)
: converter{converter}, context{&converter.getMLIRContext()} {}
template <typename A>
void translateShape(A &shape, Fortran::evaluate::Shape &&shapeExpr) {
for (Fortran::evaluate::MaybeExtentExpr extentExpr : shapeExpr) {
fir::SequenceType::Extent extent = fir::SequenceType::getUnknownExtent();
if (std::optional<std::int64_t> constantExtent =
toInt64(std::move(extentExpr)))
extent = *constantExtent;
shape.push_back(extent);
}
}
template <typename A>
std::optional<std::int64_t> toInt64(A &&expr) {
return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold(
@ -186,6 +197,15 @@ public:
} else {
fir::emitFatalError(loc, "symbol must have a type");
}
if (ultimate.IsObjectArray()) {
auto shapeExpr = Fortran::evaluate::GetShapeHelper{
converter.getFoldingContext()}(ultimate);
if (!shapeExpr)
TODO(loc, "assumed rank symbol type lowering");
fir::SequenceType::Shape shape;
translateShape(shape, std::move(*shapeExpr));
ty = fir::SequenceType::get(shape, ty);
}
if (Fortran::semantics::IsPointer(symbol))
return fir::BoxType::get(fir::PointerType::get(ty));

View File

@ -48,6 +48,34 @@ end
! CHECK: %{{.*}} = fir.call @_FortranAStopStatement
! CHECK: fir.unreachable
function fct_iarr1()
integer, dimension(10) :: fct_iarr1
end
! CHECK-LABEL: func @_QPfct_iarr1() -> !fir.array<10xi32>
! CHECK: return %{{.*}} : !fir.array<10xi32>
function fct_iarr2()
integer, dimension(10, 20) :: fct_iarr2
end
! CHECK-LABEL: func @_QPfct_iarr2() -> !fir.array<10x20xi32>
! CHECK: return %{{.*}} : !fir.array<10x20xi32>
function fct_iarr3()
integer, dimension(:, :), allocatable :: fct_iarr3
end
! CHECK-LABEL: func @_QPfct_iarr3() -> !fir.box<!fir.heap<!fir.array<?x?xi32>>>
! CHECK: return %{{.*}} : !fir.box<!fir.heap<!fir.array<?x?xi32>>>
function fct_iarr4()
integer, dimension(:), pointer :: fct_iarr4
end
! CHECK-LABEL: func @_QPfct_iarr4() -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
! CHECK: return %{{.*}} : !fir.box<!fir.ptr<!fir.array<?xi32>>>
logical(1) function lfct1()
end
! CHECK-LABEL: func @_QPlfct1() -> !fir.logical<1>