diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h index bbc0595a73913..fb1a7547cbe28 100644 --- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h +++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h @@ -280,6 +280,16 @@ genBounds(mlir::Location loc, fir::FirOpBuilder &builder, mlir::Value shape); mlir::Value genShape(mlir::Location loc, fir::FirOpBuilder &builder, Entity entity); +/// Compute the extent of \p entity in dimension \p dim. Crashes +/// if dim is bigger than the entity's rank. +mlir::Value genExtent(mlir::Location loc, fir::FirOpBuilder &builder, + hlfir::Entity entity, unsigned dim); + +/// Compute the lower bound of \p entity in dimension \p dim. Crashes +/// if dim is bigger than the entity's rank. +mlir::Value genLBound(mlir::Location loc, fir::FirOpBuilder &builder, + hlfir::Entity entity, unsigned dim); + /// Generate a vector of extents with index type from a fir.shape /// of fir.shape_shift value. llvm::SmallVector getIndexExtents(mlir::Location loc, diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp index f13822ec55904..7cda0f4345e8c 100644 --- a/flang/lib/Lower/ConvertExprToHLFIR.cpp +++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -1189,9 +1189,11 @@ class HlfirBuilder { case Fortran::evaluate::DescriptorInquiry::Field::Len: return castResult(hlfir::genCharLength(loc, builder, entity)); case Fortran::evaluate::DescriptorInquiry::Field::LowerBound: - TODO(loc, "lower bound inquiry in HLFIR"); + return castResult( + hlfir::genLBound(loc, builder, entity, desc.dimension())); case Fortran::evaluate::DescriptorInquiry::Field::Extent: - TODO(loc, "extent inquiry in HLFIR"); + return castResult( + hlfir::genExtent(loc, builder, entity, desc.dimension())); case Fortran::evaluate::DescriptorInquiry::Field::Rank: TODO(loc, "rank inquiry on assumed rank"); case Fortran::evaluate::DescriptorInquiry::Field::Stride: diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp index 7272779ac4338..4b54a0121af3f 100644 --- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp +++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp @@ -399,7 +399,7 @@ hlfir::genBounds(mlir::Location loc, fir::FirOpBuilder &builder, return result; } -static hlfir::Entity followEntitySource(hlfir::Entity entity) { +static hlfir::Entity followShapeInducingSource(hlfir::Entity entity) { while (true) { if (auto reassoc = entity.getDefiningOp()) { entity = hlfir::Entity{reassoc.getVal()}; @@ -414,6 +414,24 @@ static hlfir::Entity followEntitySource(hlfir::Entity entity) { return entity; } +static mlir::Value computeVariableExtent(mlir::Location loc, + fir::FirOpBuilder &builder, + hlfir::Entity variable, + fir::SequenceType seqTy, + unsigned dim) { + mlir::Type idxTy = builder.getIndexType(); + if (seqTy.getShape().size() > dim) { + fir::SequenceType::Extent typeExtent = seqTy.getShape()[dim]; + if (typeExtent != fir::SequenceType::getUnknownExtent()) + return builder.createIntegerConstant(loc, idxTy, typeExtent); + } + assert(variable.getType().isa() && + "array variable with dynamic extent must be boxed"); + mlir::Value dimVal = builder.createIntegerConstant(loc, idxTy, dim); + auto dimInfo = builder.create(loc, idxTy, idxTy, idxTy, + variable, dimVal); + return dimInfo.getExtent(); +} llvm::SmallVector getVariableExtents(mlir::Location loc, fir::FirOpBuilder &builder, hlfir::Entity variable) { @@ -432,42 +450,38 @@ llvm::SmallVector getVariableExtents(mlir::Location loc, fir::SequenceType seqTy = hlfir::getFortranElementOrSequenceType(variable.getType()) .cast(); - mlir::Type idxTy = builder.getIndexType(); - for (auto typeExtent : seqTy.getShape()) - if (typeExtent != fir::SequenceType::getUnknownExtent()) { - extents.push_back(builder.createIntegerConstant(loc, idxTy, typeExtent)); - } else { - assert(variable.getType().isa() && - "array variable with dynamic extent must be boxed"); - mlir::Value dim = - builder.createIntegerConstant(loc, idxTy, extents.size()); - auto dimInfo = builder.create(loc, idxTy, idxTy, idxTy, - variable, dim); - extents.push_back(dimInfo.getExtent()); - } + unsigned rank = seqTy.getShape().size(); + for (unsigned dim = 0; dim < rank; ++dim) + extents.push_back( + computeVariableExtent(loc, builder, variable, seqTy, dim)); return extents; } -mlir::Value hlfir::genShape(mlir::Location loc, fir::FirOpBuilder &builder, - hlfir::Entity entity) { - assert(entity.isArray() && "entity must be an array"); - entity = followEntitySource(entity); - +static mlir::Value tryRetrievingShapeOrShift(hlfir::Entity entity) { if (entity.getType().isa()) { if (auto elemental = entity.getDefiningOp()) return elemental.getShape(); - TODO(loc, "get shape from HLFIR expr without producer holding the shape"); + return mlir::Value{}; } - // Entity is an array variable. - if (auto varIface = entity.getIfVariableInterface()) { - if (auto shape = varIface.getShape()) { - if (shape.getType().isa()) - return shape; - if (shape.getType().isa()) - if (auto s = shape.getDefiningOp()) - return builder.create(loc, s.getExtents()); - } + if (auto varIface = entity.getIfVariableInterface()) + return varIface.getShape(); + return {}; +} + +mlir::Value hlfir::genShape(mlir::Location loc, fir::FirOpBuilder &builder, + hlfir::Entity entity) { + assert(entity.isArray() && "entity must be an array"); + entity = followShapeInducingSource(entity); + assert(entity && "what?"); + if (auto shape = tryRetrievingShapeOrShift(entity)) { + if (shape.getType().isa()) + return shape; + if (shape.getType().isa()) + if (auto s = shape.getDefiningOp()) + return builder.create(loc, s.getExtents()); } + if (entity.getType().isa()) + TODO(loc, "get shape from HLFIR expr without producer holding the shape"); // There is no shape lying around for this entity. Retrieve the extents and // build a new fir.shape. return builder.create(loc, @@ -484,6 +498,50 @@ hlfir::getIndexExtents(mlir::Location loc, fir::FirOpBuilder &builder, return extents; } +mlir::Value hlfir::genExtent(mlir::Location loc, fir::FirOpBuilder &builder, + hlfir::Entity entity, unsigned dim) { + entity = followShapeInducingSource(entity); + if (auto shape = tryRetrievingShapeOrShift(entity)) { + auto extents = getExplicitExtentsFromShape(shape); + if (!extents.empty()) { + assert(extents.size() > dim && "bad inquiry"); + return extents[dim]; + } + } + if (entity.isVariable()) { + if (entity.isMutableBox()) + entity = hlfir::derefPointersAndAllocatables(loc, builder, entity); + // Use the type shape information, and/or the fir.box/fir.class shape + // information if any extents are not static. + fir::SequenceType seqTy = + hlfir::getFortranElementOrSequenceType(entity.getType()) + .cast(); + return computeVariableExtent(loc, builder, entity, seqTy, dim); + } + TODO(loc, "get extent from HLFIR expr without producer holding the shape"); +} + +mlir::Value hlfir::genLBound(mlir::Location loc, fir::FirOpBuilder &builder, + hlfir::Entity entity, unsigned dim) { + if (!entity.hasNonDefaultLowerBounds()) + return builder.createIntegerConstant(loc, builder.getIndexType(), 1); + if (auto shape = tryRetrievingShapeOrShift(entity)) { + auto lbounds = getExplicitLboundsFromShape(shape); + if (!lbounds.empty()) { + assert(lbounds.size() > dim && "bad inquiry"); + return lbounds[dim]; + } + } + if (entity.isMutableBox()) + entity = hlfir::derefPointersAndAllocatables(loc, builder, entity); + assert(entity.getType().isa() && "must be a box"); + mlir::Type idxTy = builder.getIndexType(); + mlir::Value dimVal = builder.createIntegerConstant(loc, idxTy, dim); + auto dimInfo = + builder.create(loc, idxTy, idxTy, idxTy, entity, dimVal); + return dimInfo.getLowerBound(); +} + void hlfir::genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder, Entity entity, llvm::SmallVectorImpl &result) { diff --git a/flang/test/Lower/HLFIR/descriptor-inquiries.f90 b/flang/test/Lower/HLFIR/descriptor-inquiries.f90 new file mode 100644 index 0000000000000..ecdec0ac8e507 --- /dev/null +++ b/flang/test/Lower/HLFIR/descriptor-inquiries.f90 @@ -0,0 +1,85 @@ +! Test lowering of extent and lower bound inquires that +! come in lowering as evaluate::DescriptorInquiry. + +! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s + +subroutine test_assumed_shape(x, r) + integer(8) :: r + real :: x(:,:) + r = size(x, dim=2, kind=8) +end subroutine +! CHECK-LABEL: func.func @_QPtest_assumed_shape( +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}Ex +! CHECK: %[[VAL_4:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]]#0, %[[VAL_4]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]]#1 : (index) -> i64 +! CHECK: hlfir.assign %[[VAL_6]] to %{{.*}} + +subroutine test_explicit_shape(x, n, m, r) + integer(8) :: n, m, r + real :: x(n,m) + r = size(x, dim=2, kind=8) +end subroutine +! CHECK-LABEL: func.func @_QPtest_explicit_shape( +! CHECK: %[[VAL_17:.*]] = fir.shape %{{.*}}, %[[VAL_16:.*]] : (index, index) -> !fir.shape<2> +! CHECK: %[[VAL_18:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_17]]) {{.*}}Ex +! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_16]] : (index) -> i64 +! CHECK: hlfir.assign %[[VAL_19]] to %{{.*}} + +subroutine test_pointer(x, r) + integer(8) :: r + real :: x(:,:) + r = size(x, dim=2, kind=8) +end subroutine +! CHECK-LABEL: func.func @_QPtest_pointer( +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}Ex +! CHECK: %[[VAL_4:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]]#0, %[[VAL_4]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]]#1 : (index) -> i64 +! CHECK: hlfir.assign %[[VAL_6]] to %{{.*}} + +subroutine test_lbound_assumed_shape(x, l1, l2, r) + integer(8) :: l1, l2, r + real :: x(l1:,l2:) + r = lbound(x, dim=2, kind=8) +end subroutine +! CHECK: %[[VAL_11:.*]] = fir.shift %[[VAL_8:.*]], %[[VAL_10:.*]] : (index, index) -> !fir.shift<2> +! CHECK: %[[VAL_12:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_11]]) {{.*}}Ex +! CHECK: %[[VAL_13:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_14:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_15:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_16:.*]]:3 = fir.box_dims %[[VAL_12]]#1, %[[VAL_15]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_17:.*]] = arith.cmpi eq, %[[VAL_16]]#1, %[[VAL_14]] : index +! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_13]] : (i64) -> index +! CHECK: %[[VAL_19:.*]] = arith.select %[[VAL_17]], %[[VAL_18]], %[[VAL_10]] : index +! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_19]] : (index) -> i64 +! CHECK: hlfir.assign %[[VAL_20]] to %{{.*}} + +subroutine test_lbound_explicit_shape(x, n, m, l1, l2, r) + integer(8) :: n, m, l1, l2, r + real :: x(l1:n,l2:m) + r = lbound(x, dim=2, kind=8) +end subroutine +! CHECK-LABEL: func.func @_QPtest_lbound_explicit_shape( +! CHECK: %[[VAL_31:.*]] = fir.shape_shift %{{.*}}, %{{.*}}, %[[VAL_22:.*]], %[[VAL_30:.*]] : (index, index, index, index) -> !fir.shapeshift<2> +! CHECK: %[[VAL_32:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_31]]) {{.*}}Ex +! CHECK: %[[VAL_33:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_34:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_35:.*]] = arith.cmpi eq, %[[VAL_30]], %[[VAL_34]] : index +! CHECK: %[[VAL_36:.*]] = fir.convert %[[VAL_33]] : (i64) -> index +! CHECK: %[[VAL_37:.*]] = arith.select %[[VAL_35]], %[[VAL_36]], %[[VAL_22]] : index +! CHECK: %[[VAL_38:.*]] = fir.convert %[[VAL_37]] : (index) -> i64 +! CHECK: hlfir.assign %[[VAL_38]] to %{{.*}} + +subroutine test_lbound_pointer(x, r) + integer(8) :: r + real, pointer :: x(:,:) + r = lbound(x, dim=2, kind=8) +end subroutine +! CHECK-LABEL: func.func @_QPtest_lbound_pointer( +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}Ex +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref>>> +! CHECK: %[[VAL_5:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_4]], %[[VAL_5]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]]#0 : (index) -> i64 +! CHECK: hlfir.assign %[[VAL_7]] to %{{.*}}