[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:
		
							parent
							
								
									bfc1217119
								
							
						
					
					
						commit
						c807aa53ee
					
				| 
						 | 
				
			
			@ -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>
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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));
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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>
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue