[flang-commits] [flang] c807aa5 - [flang] Handle lowering of ranked array
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Tue Feb 15 07:01:09 PST 2022
Author: Valentin Clement
Date: 2022-02-15T16:01:02+01:00
New Revision: c807aa53ee6dec76fd70c8665a409c078a1494d7
URL: https://github.com/llvm/llvm-project/commit/c807aa53ee6dec76fd70c8665a409c078a1494d7
DIFF: https://github.com/llvm/llvm-project/commit/c807aa53ee6dec76fd70c8665a409c078a1494d7.diff
LOG: [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 at nvidia.com>
Added:
Modified:
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertType.cpp
flang/test/Lower/basic-function.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 175aee73481c6..8bf110cf2daf7 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -155,6 +155,21 @@ class Fortran::lower::CallInterfaceImpl {
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 @@ class Fortran::lower::CallInterfaceImpl {
}
}
+ 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>
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 7a957819503f1..848f38b389cc0 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -154,6 +154,17 @@ class TypeBuilder {
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 @@ class TypeBuilder {
} 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));
diff --git a/flang/test/Lower/basic-function.f90 b/flang/test/Lower/basic-function.f90
index a613682e4f36a..1aee3a94c1e22 100644
--- a/flang/test/Lower/basic-function.f90
+++ b/flang/test/Lower/basic-function.f90
@@ -48,6 +48,34 @@ integer function fct_body()
! 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>
More information about the flang-commits
mailing list