diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1317,6 +1317,25 @@ return {hlfir::EntityWithAttributes{matmulOp.getResult()}}; } + if (intrinsic.name == "transpose") { + llvm::SmallVector operands = getOperandVector(loweredActuals); + hlfir::ExprType::Shape resultShape; + mlir::Type normalisedResult = + hlfir::getFortranElementOrSequenceType(*callContext.resultType); + auto arrayType = normalisedResult.cast(); + llvm::ArrayRef arrayShape = arrayType.getShape(); + assert(arrayShape.size() == 2 && "arguments to transpose have a rank of 2"); + mlir::Type elementType = arrayType.getEleTy(); + resultShape.push_back(arrayShape[0]); + resultShape.push_back(arrayShape[1]); + mlir::Type resultTy = + hlfir::ExprType::get(builder.getContext(), resultShape, elementType, + hlfir::Entity{operands[0]}.isPolymorphic()); + hlfir::TransposeOp transposeOp = + builder.create(loc, resultTy, operands[0]); + + return {hlfir::EntityWithAttributes{transposeOp.getResult()}}; + } // TODO add hlfir operations for other transformational intrinsics here diff --git a/flang/test/Lower/HLFIR/transpose.f90 b/flang/test/Lower/HLFIR/transpose.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/HLFIR/transpose.f90 @@ -0,0 +1,33 @@ +! Test lowering of TRANSPOSE intrinsic to HLFIR +! RUN: bbc -emit-fir -hlfir -polymorphic-type -o - %s 2>&1 | FileCheck %s + +subroutine transpose1(m, res) + integer :: m(1,2), res(2, 1) + res = TRANSPOSE(m) +endsubroutine +! CHECK-LABEL: func.func @_QPtranspose1 +! CHECK: %[[M_ARG:.*]]: !fir.ref> +! CHECK: %[[RES_ARG:.*]]: !fir.ref> +! CHECK-DAG: %[[ARG:.*]]:2 = hlfir.declare %[[M_ARG]](%[[M_SHAPE:.*]]) {[[NAME:.*]]} : (!fir.ref>, !fir.shape<2>) -> (!fir.ref>, !fir.ref>) +! CHECK-DAG: %[[RES:.*]]:2 = hlfir.declare %[[RES_ARG]](%[[RES_SHAPE:.*]]) {[[NAME2:.*]]} : (!fir.ref>, !fir.shape<2>) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[EXPR:.*]] = hlfir.transpose %[[ARG]]#0 : (!fir.ref>) -> !hlfir.expr<2x1xi32> +! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[RES]]#0 +! CHECK-NEXT: hlfir.destroy %[[EXPR]] +! CHECK-NEXT: return +! CHECK-NEXT: } + +subroutine transpose2(m, res) + class(*) :: m(1,2) + class(*), allocatable :: res(:,:) + res = TRANSPOSE(m) +endsubroutine +! CHECK-LABEL: func.func @_QPtranspose2 +! CHECK: %[[M_ARG:.*]]: !fir.class> +! CHECK: %[[RES_ARG:.*]]: !fir.ref>>> +! CHECK-DAG: %[[ARG:.*]]:2 = hlfir.declare %[[M_ARG]] +! CHECK-DAG: %[[RES:.*]]:2 = hlfir.declare %[[RES_ARG]] +! CHECK: %[[EXPR:.*]] = hlfir.transpose %[[ARG]]#0 : (!fir.class>) -> !hlfir.expr<2x1xnone?> +! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[RES]]#0 realloc +! CHECK-NEXT: hlfir.destroy %[[EXPR]] +! CHECK-NEXT: return +! CHECK-NEXT: }