diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h --- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h +++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h @@ -24,6 +24,7 @@ namespace hlfir { class AssociateOp; +class ElementalOp; /// Is this an SSA value type for the value of a Fortran expression? inline bool isFortranValueType(mlir::Type type) { @@ -70,6 +71,9 @@ bool isValue() const { return isFortranValue(*this); } bool isVariable() const { return !isValue(); } bool isMutableBox() const { return hlfir::isBoxAddressType(getType()); } + bool isBoxAddressOrValue() const { + return hlfir::isBoxAddressOrValueType(getType()); + } bool isArray() const { mlir::Type type = fir::unwrapPassByRefType(fir::unwrapRefType(getType())); if (type.isa()) @@ -80,6 +84,12 @@ } bool isScalar() const { return !isArray(); } + bool isPolymorphic() const { + if (auto exprType = getType().dyn_cast()) + return exprType.isPolymorphic(); + return fir::isPolymorphicType(getType()); + } + mlir::Type getFortranElementType() const { return hlfir::getFortranElementType(getType()); } @@ -94,6 +104,20 @@ return getFortranElementType().isa(); } + bool hasNonDefaultLowerBounds() const { + if (!isBoxAddressOrValue() || isScalar()) + return false; + if (isMutableBox()) + return true; + if (auto varIface = getIfVariableInterface()) + if (auto shape = varIface.getShape()) { + auto shapeTy = shape.getType(); + return shapeTy.isa() || + shapeTy.isa(); + } + return true; + } + fir::FortranVariableOpInterface getIfVariableInterface() const { return this->getDefiningOp(); } @@ -176,8 +200,9 @@ hlfir::Entity var); /// If the entity is a variable, load its value (dereference pointers and -/// allocatables if needed). Do nothing if the entity os already a variable or -/// if it is not a scalar entity of numerical or logical type. +/// allocatables if needed). Do nothing if the entity is already a value, and +/// only dereference pointers and allocatables if it is not a scalar entity +/// of numerical or logical type. Entity loadTrivialScalar(mlir::Location loc, fir::FirOpBuilder &builder, Entity entity); @@ -187,10 +212,19 @@ fir::FirOpBuilder &builder, Entity entity); +/// Get element entity(oneBasedIndices) if entity is an array, or return entity +/// if it is a scalar. The indices are one based. If the entity has non default +/// lower bounds, the function will adapt the indices in the indexing operation. +hlfir::Entity getElementAt(mlir::Location loc, fir::FirOpBuilder &builder, + Entity entity, mlir::ValueRange oneBasedIndices); /// Compute the lower and upper bounds of an entity. llvm::SmallVector> genBounds(mlir::Location loc, fir::FirOpBuilder &builder, Entity entity); +/// Compute fir.shape<> (no lower bounds) for an entity. +mlir::Value genShape(mlir::Location loc, fir::FirOpBuilder &builder, + Entity entity); + /// Read length parameters into result if this entity has any. void genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder, Entity entity, @@ -204,6 +238,21 @@ mlir::Location loc, fir::FirOpBuilder &builder, Entity entity, llvm::SmallVectorImpl &typeParams); +/// Get the variable type for an element of an array type entity. Returns the +/// input entity type if it is scalar. Will crash if the entity is not a +/// variable. +mlir::Type getVariableElementType(hlfir::Entity variable); + +using ElementalKernelGenerator = std::function; +/// Generate an hlfir.elementalOp given call back to generate the element +/// value at for each iteration. +hlfir::ElementalOp genElementalOp(mlir::Location loc, + fir::FirOpBuilder &builder, + mlir::Type elementType, mlir::Value shape, + mlir::ValueRange typeParams, + const ElementalKernelGenerator &genKernel); + } // namespace hlfir #endif // FORTRAN_OPTIMIZER_BUILDER_HLFIRTOOLS_H diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td b/flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td --- a/flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td +++ b/flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td @@ -74,6 +74,9 @@ return hlfir::ExprType::get(eleTy.getContext(), Shape{}, eleTy, isPolymorphic()); } + static constexpr int64_t getUnknownExtent() { + return mlir::ShapedType::kDynamic; + } }]; let hasCustomAssemblyFormat = 1; diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td --- a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td +++ b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td @@ -194,6 +194,7 @@ let extraClassDeclaration = [{ using Triplet = std::tuple; using Subscript = std::variant; + using Subscripts = llvm::SmallVector; }]; let builders = [ @@ -203,7 +204,13 @@ CArg<"mlir::ValueRange", "{}">:$substring, CArg<"llvm::Optional", "{}">:$complex_part, CArg<"mlir::Value", "{}">:$shape, CArg<"mlir::ValueRange", "{}">:$typeparams, - CArg<"fir::FortranVariableFlagsAttr", "{}">:$fortran_attrs)>]; + CArg<"fir::FortranVariableFlagsAttr", "{}">:$fortran_attrs)>, + + OpBuilder<(ins "mlir::Type":$result_type, "mlir::Value":$memref, + "mlir::ValueRange":$indices, + CArg<"mlir::ValueRange", "{}">:$typeparams, + CArg<"fir::FortranVariableFlagsAttr", "{}">:$fortran_attrs)> + ]; let hasVerifier = 1; } diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp --- a/flang/lib/Lower/ConvertExprToHLFIR.cpp +++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -72,7 +72,7 @@ /// become the operands of an hlfir.declare. struct PartInfo { fir::FortranVariableOpInterface base; - llvm::SmallVector subscripts; + hlfir::DesignateOp::Subscripts subscripts; mlir::Value resultShape; llvm::SmallVector typeParams; }; @@ -319,14 +319,6 @@ fir::FirOpBuilder &builder, const Op &op, hlfir::Entity lhs, hlfir::Entity rhs) { - // evaluate::Extremum is only created by the front-end when building - // compiler generated expressions (like when folding LEN() or shape/bounds - // inquiries). MIN and MAX are represented as evaluate::ProcedureRef and are - // not going through here. So far the frontend does not generate character - // Extremum so there is no way to test it. - if constexpr (TC == Fortran::common::TypeCategory::Character) { - fir::emitFatalError(loc, "Fortran::evaluate::Extremum are unexpected"); - } llvm::SmallVector args{lhs, rhs}; fir::ExtendedValue res = op.ordering == Fortran::evaluate::Ordering::Greater ? Fortran::lower::genMax(builder, loc, args) @@ -335,6 +327,28 @@ } }; +// evaluate::Extremum is only created by the front-end when building compiler +// generated expressions (like when folding LEN() or shape/bounds inquiries). +// MIN and MAX are represented as evaluate::ProcedureRef and are not going +// through here. So far the frontend does not generate character Extremum so +// there is no way to test it. +template +struct BinaryOp>> { + using Op = Fortran::evaluate::Extremum< + Fortran::evaluate::Type>; + static hlfir::EntityWithAttributes gen(mlir::Location loc, + fir::FirOpBuilder &, const Op &, + hlfir::Entity, hlfir::Entity) { + fir::emitFatalError(loc, "Fortran::evaluate::Extremum are unexpected"); + } + static void genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &, + hlfir::Entity, hlfir::Entity, + llvm::SmallVectorImpl &) { + fir::emitFatalError(loc, "Fortran::evaluate::Extremum are unexpected"); + } +}; + /// Convert parser's INTEGER relational operators to MLIR. static mlir::arith::CmpIPredicate translateRelational(Fortran::common::RelationalOperator rop) { @@ -501,6 +515,42 @@ hlfir::Entity, hlfir::Entity) { TODO(loc, "SetLength lowering to HLFIR"); } + static void + genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder, + hlfir::Entity lhs, hlfir::Entity rhs, + llvm::SmallVectorImpl &resultTypeParams) { + resultTypeParams.push_back(rhs); + } +}; + +template +struct BinaryOp> { + using Op = Fortran::evaluate::Concat; + hlfir::EntityWithAttributes gen(mlir::Location loc, + fir::FirOpBuilder &builder, const Op &, + hlfir::Entity lhs, hlfir::Entity rhs) { + assert(len && "genResultTypeParams must have been called"); + auto concat = + builder.create(loc, mlir::ValueRange{lhs, rhs}, len); + return hlfir::EntityWithAttributes{concat.getResult()}; + } + void + genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder, + hlfir::Entity lhs, hlfir::Entity rhs, + llvm::SmallVectorImpl &resultTypeParams) { + llvm::SmallVector lengths; + hlfir::genLengthParameters(loc, builder, lhs, lengths); + hlfir::genLengthParameters(loc, builder, rhs, lengths); + assert(lengths.size() == 2 && "lacks rhs or lhs length"); + mlir::Type idxType = builder.getIndexType(); + mlir::Value lhsLen = builder.createConvert(loc, idxType, lengths[0]); + mlir::Value rhsLen = builder.createConvert(loc, idxType, lengths[1]); + len = builder.create(loc, lhsLen, rhsLen); + resultTypeParams.push_back(len); + } + +private: + mlir::Value len{}; }; //===--------------------------------------------------------------------===// @@ -590,6 +640,13 @@ return hlfir::EntityWithAttributes{ builder.create(loc, lhs.getType(), lhs)}; } + + static void + genResultTypeParams(mlir::Location loc, fir::FirOpBuilder &builder, + hlfir::Entity lhs, + llvm::SmallVectorImpl &resultTypeParams) { + hlfir::genLengthParameters(loc, builder, lhs, resultTypeParams); + } }; template &resultTypeParams) { + hlfir::genLengthParameters(loc, builder, lhs, resultTypeParams); + } }; /// Lower Expr to HLFIR. @@ -695,10 +759,37 @@ gen(const Fortran::evaluate::Operation &op) { auto &builder = getBuilder(); mlir::Location loc = getLoc(); - if (op.Rank() != 0) - TODO(loc, "elemental operations in HLFIR"); + const int rank = op.Rank(); + UnaryOp unaryOp; auto left = hlfir::loadTrivialScalar(loc, builder, gen(op.left())); - return UnaryOp::gen(loc, builder, op.derived(), left); + llvm::SmallVector typeParams; + if constexpr (R::category == Fortran::common::TypeCategory::Character) { + unaryOp.genResultTypeParams(loc, builder, left, typeParams); + } + if (rank == 0) + return unaryOp.gen(loc, builder, op.derived(), left); + + // Elemental expression. + mlir::Type elementType; + if constexpr (R::category == Fortran::common::TypeCategory::Derived) { + elementType = Fortran::lower::translateDerivedTypeToFIRType( + getConverter(), op.derived().GetType().GetDerivedTypeSpec()); + } else { + elementType = + Fortran::lower::getFIRType(builder.getContext(), R::category, R::kind, + /*params=*/std::nullopt); + } + mlir::Value shape = hlfir::genShape(loc, builder, left); + auto genKernel = [&op, &left, &unaryOp]( + mlir::Location l, fir::FirOpBuilder &b, + mlir::ValueRange oneBasedIndices) -> hlfir::Entity { + auto leftElement = hlfir::getElementAt(l, b, left, oneBasedIndices); + auto leftVal = hlfir::loadTrivialScalar(l, b, leftElement); + return unaryOp.gen(l, b, op.derived(), leftVal); + }; + // TODO: deal with hlfir.elemental result destruction. + return hlfir::EntityWithAttributes{hlfir::genElementalOp( + loc, builder, elementType, shape, typeParams, genKernel)}; } template @@ -706,30 +797,41 @@ gen(const Fortran::evaluate::Operation &op) { auto &builder = getBuilder(); mlir::Location loc = getLoc(); - if (op.Rank() != 0) - TODO(loc, "elemental operations in HLFIR"); + const int rank = op.Rank(); + BinaryOp binaryOp; auto left = hlfir::loadTrivialScalar(loc, builder, gen(op.left())); auto right = hlfir::loadTrivialScalar(loc, builder, gen(op.right())); - return BinaryOp::gen(loc, builder, op.derived(), left, right); - } - - template - hlfir::EntityWithAttributes gen(const Fortran::evaluate::Concat &op) { - auto lhs = gen(op.left()); - auto rhs = gen(op.right()); - llvm::SmallVector lengths; - auto &builder = getBuilder(); - mlir::Location loc = getLoc(); - hlfir::genLengthParameters(loc, builder, lhs, lengths); - hlfir::genLengthParameters(loc, builder, rhs, lengths); - assert(lengths.size() == 2 && "lacks rhs or lhs length"); - mlir::Type idxType = builder.getIndexType(); - mlir::Value lhsLen = builder.createConvert(loc, idxType, lengths[0]); - mlir::Value rhsLen = builder.createConvert(loc, idxType, lengths[1]); - mlir::Value len = builder.create(loc, lhsLen, rhsLen); - auto concat = - builder.create(loc, mlir::ValueRange{lhs, rhs}, len); - return hlfir::EntityWithAttributes{concat.getResult()}; + llvm::SmallVector typeParams; + if constexpr (R::category == Fortran::common::TypeCategory::Character) { + binaryOp.genResultTypeParams(loc, builder, left, right, typeParams); + } + if (rank == 0) + return binaryOp.gen(loc, builder, op.derived(), left, right); + + // Elemental expression. + mlir::Type elementType = + Fortran::lower::getFIRType(builder.getContext(), R::category, R::kind, + /*params=*/std::nullopt); + // TODO: "merge" shape, get cst shape from front-end if possible. + mlir::Value shape; + if (left.isArray()) { + shape = hlfir::genShape(loc, builder, left); + } else { + assert(right.isArray() && "must have at least one array operand"); + shape = hlfir::genShape(loc, builder, right); + } + auto genKernel = [&op, &left, &right, &binaryOp]( + mlir::Location l, fir::FirOpBuilder &b, + mlir::ValueRange oneBasedIndices) -> hlfir::Entity { + auto leftElement = hlfir::getElementAt(l, b, left, oneBasedIndices); + auto rightElement = hlfir::getElementAt(l, b, right, oneBasedIndices); + auto leftVal = hlfir::loadTrivialScalar(l, b, leftElement); + auto rightVal = hlfir::loadTrivialScalar(l, b, rightElement); + return binaryOp.gen(l, b, op.derived(), leftVal, rightVal); + }; + // TODO: deal with hlfir.elemental result destruction. + return hlfir::EntityWithAttributes{hlfir::genElementalOp( + loc, builder, elementType, shape, typeParams, genKernel)}; } hlfir::EntityWithAttributes diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp --- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp +++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp @@ -183,7 +183,7 @@ assert(value.isValue() && "must not be a variable"); mlir::Value shape{}; if (value.isArray()) - TODO(loc, "associating array expressions"); + shape = genShape(loc, builder, value); mlir::Value source = value; // Lowered scalar expression values for numerical and logical may have a @@ -244,14 +244,63 @@ hlfir::Entity hlfir::loadTrivialScalar(mlir::Location loc, fir::FirOpBuilder &builder, Entity entity) { + entity = derefPointersAndAllocatables(loc, builder, entity); if (entity.isVariable() && entity.isScalar() && fir::isa_trivial(entity.getFortranElementType())) { - entity = derefPointersAndAllocatables(loc, builder, entity); return Entity{builder.create(loc, entity)}; } return entity; } +static std::optional> +getNonDefaultLowerBounds(mlir::Location loc, fir::FirOpBuilder &builder, + hlfir::Entity entity) { + if (!entity.hasNonDefaultLowerBounds()) + return std::nullopt; + if (auto varIface = entity.getIfVariableInterface()) { + llvm::SmallVector lbounds = getExplicitLbounds(varIface); + if (!lbounds.empty()) + return lbounds; + } + TODO(loc, "get non default lower bounds without FortranVariableInterface"); +} + +hlfir::Entity hlfir::getElementAt(mlir::Location loc, + fir::FirOpBuilder &builder, Entity entity, + mlir::ValueRange oneBasedIndices) { + if (entity.isScalar()) + return entity; + llvm::SmallVector lenParams; + genLengthParameters(loc, builder, entity, lenParams); + if (entity.getType().isa()) + return hlfir::Entity{builder.create( + loc, entity, oneBasedIndices, lenParams)}; + // Build hlfir.designate. The lower bounds may need to be added to + // the oneBasedIndices since hlfir.designate expect indices + // based on the array operand lower bounds. + mlir::Type resultType = hlfir::getVariableElementType(entity); + hlfir::DesignateOp designate; + if (auto lbounds = getNonDefaultLowerBounds(loc, builder, entity)) { + llvm::SmallVector indices; + mlir::Type idxTy = builder.getIndexType(); + mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); + for (auto [oneBased, lb] : llvm::zip(oneBasedIndices, *lbounds)) { + auto lbIdx = builder.createConvert(loc, idxTy, lb); + auto oneBasedIdx = builder.createConvert(loc, idxTy, oneBased); + auto shift = builder.create(loc, lbIdx, one); + mlir::Value index = + builder.create(loc, oneBasedIdx, shift); + indices.push_back(index); + } + designate = builder.create(loc, resultType, entity, + indices, lenParams); + } else { + designate = builder.create(loc, resultType, entity, + oneBasedIndices, lenParams); + } + return mlir::cast(designate.getOperation()); +} + static mlir::Value genUBound(mlir::Location loc, fir::FirOpBuilder &builder, mlir::Value lb, mlir::Value extent, mlir::Value one) { @@ -285,6 +334,45 @@ return result; } +static hlfir::Entity followEntitySource(hlfir::Entity entity) { + while (true) { + if (auto reassoc = entity.getDefiningOp()) { + entity = hlfir::Entity{reassoc.getVal()}; + continue; + } + if (auto asExpr = entity.getDefiningOp()) { + entity = hlfir::Entity{asExpr.getVar()}; + continue; + } + break; + } + return entity; +} + +mlir::Value hlfir::genShape(mlir::Location loc, fir::FirOpBuilder &builder, + hlfir::Entity entity) { + assert(entity.isArray() && "entity must be an array"); + if (entity.isMutableBox()) + entity = hlfir::derefPointersAndAllocatables(loc, builder, entity); + else + entity = followEntitySource(entity); + + 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()); + } + } else if (entity.getType().isa()) { + if (auto elemental = entity.getDefiningOp()) + return elemental.getShape(); + TODO(loc, "get shape from HLFIR expr without producer holding the shape"); + } + TODO(loc, "get shape from HLFIR variable without interface"); +} + void hlfir::genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder, Entity entity, llvm::SmallVectorImpl &result) { @@ -304,6 +392,12 @@ hlfir::genLengthParameters(loc, builder, hlfir::Entity{asExpr.getVar()}, result); return; + } else if (auto elemental = expr.getDefiningOp()) { + result.append(elemental.getTypeparams().begin(), + elemental.getTypeparams().end()); + return; + } else if (auto apply = expr.getDefiningOp()) { + result.append(apply.getTypeparams().begin(), apply.getTypeparams().end()); } TODO(loc, "inquire type parameters of hlfir.expr"); } @@ -340,3 +434,53 @@ return hlfir::Entity{builder.create(loc, entity).getResult()}; return entity; } + +mlir::Type hlfir::getVariableElementType(hlfir::Entity variable) { + assert(variable.isVariable() && "entity must be a variable"); + if (variable.isScalar()) + return variable.getType(); + mlir::Type eleTy = variable.getFortranElementType(); + if (variable.isPolymorphic()) + return fir::ClassType::get(eleTy); + if (auto charType = eleTy.dyn_cast()) { + if (charType.hasDynamicLen()) + return fir::BoxCharType::get(charType.getContext(), charType.getFKind()); + } else if (fir::isRecordWithTypeParameters(eleTy)) { + return fir::BoxType::get(eleTy); + } + return fir::ReferenceType::get(eleTy); +} + +static hlfir::ExprType getArrayExprType(mlir::Type elementType, + mlir::Value shape, bool isPolymorphic) { + unsigned rank = shape.getType().cast().getRank(); + hlfir::ExprType::Shape typeShape(rank, hlfir::ExprType::getUnknownExtent()); + if (auto shapeOp = shape.getDefiningOp()) + for (auto extent : llvm::enumerate(shapeOp.getExtents())) + if (auto cstExtent = fir::factory::getIntIfConstant(extent.value())) + typeShape[extent.index()] = *cstExtent; + return hlfir::ExprType::get(elementType.getContext(), typeShape, elementType, + isPolymorphic); +} + +hlfir::ElementalOp +hlfir::genElementalOp(mlir::Location loc, fir::FirOpBuilder &builder, + mlir::Type elementType, mlir::Value shape, + mlir::ValueRange typeParams, + const ElementalKernelGenerator &genKernel) { + mlir::Type exprType = getArrayExprType(elementType, shape, false); + auto elementalOp = + builder.create(loc, exprType, shape, typeParams); + auto insertPt = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(elementalOp.getBody()); + mlir::Value elementResult = genKernel(loc, builder, elementalOp.getIndices()); + // Numerical and logical scalars may be lowered to another type than the + // Fortran expression type (e.g i1 instead of fir.logical). Array expression + // values are typed according to their Fortran type. Insert a cast if needed + // here. + if (fir::isa_trivial(elementResult.getType())) + elementResult = builder.createConvert(loc, elementType, elementResult); + builder.create(loc, elementResult); + builder.restoreInsertionPoint(insertPt); + return elementalOp; +} diff --git a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp --- a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp +++ b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp @@ -116,6 +116,22 @@ fortran_attrs); } +void hlfir::DesignateOp::build(mlir::OpBuilder &builder, + mlir::OperationState &result, + mlir::Type result_type, mlir::Value memref, + mlir::ValueRange indices, + mlir::ValueRange typeparams, + fir::FortranVariableFlagsAttr fortran_attrs) { + llvm::SmallVector isTriplet(indices.size(), false); + auto isTripletAttr = + mlir::DenseBoolArrayAttr::get(builder.getContext(), isTriplet); + build(builder, result, result_type, memref, + /*componentAttr=*/mlir::StringAttr{}, /*component_shape=*/mlir::Value{}, + indices, isTripletAttr, /*substring*/ mlir::ValueRange{}, + /*complexPartAttr=*/mlir::BoolAttr{}, /*shape=*/mlir::Value{}, + typeparams, fortran_attrs); +} + static mlir::ParseResult parseDesignatorIndices( mlir::OpAsmParser &parser, llvm::SmallVectorImpl &indices, diff --git a/flang/test/Lower/HLFIR/elemental-array-ops.f90 b/flang/test/Lower/HLFIR/elemental-array-ops.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/HLFIR/elemental-array-ops.f90 @@ -0,0 +1,128 @@ +! Test lowering of elemental intrinsic operations with array arguments to HLFIR +! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s + +subroutine binary(x, y) + integer :: x(100), y(100) + x = x+y +end subroutine +! CHECK-LABEL: func.func @_QPbinary( +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_3:[^)]*]]) {{.*}}x +! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_6:[^)]*]]) {{.*}}y +! CHECK: %[[VAL_8:.*]] = hlfir.elemental %[[VAL_3]] : (!fir.shape<1>) -> !hlfir.expr<100xi32> { +! CHECK: ^bb0(%[[VAL_9:.*]]: index): +! CHECK: %[[VAL_10:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_9]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_11:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_9]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_10]] : !fir.ref +! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_11]] : !fir.ref +! CHECK: %[[VAL_14:.*]] = arith.addi %[[VAL_12]], %[[VAL_13]] : i32 +! CHECK: hlfir.yield_element %[[VAL_14]] : i32 +! CHECK: } + +subroutine binary_with_scalar_and_array(x, y) + integer :: x(100), y + x = x+y +end subroutine +! CHECK-LABEL: func.func @_QPbinary_with_scalar_and_array( +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_3:[^)]*]]) {{.*}}x +! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %{{.*}} {{.*}}y +! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref +! CHECK: %[[VAL_7:.*]] = hlfir.elemental %[[VAL_3]] : (!fir.shape<1>) -> !hlfir.expr<100xi32> { +! CHECK: ^bb0(%[[VAL_8:.*]]: index): +! CHECK: %[[VAL_9:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_8]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_9]] : !fir.ref +! CHECK: %[[VAL_11:.*]] = arith.addi %[[VAL_10]], %[[VAL_6]] : i32 +! CHECK: hlfir.yield_element %[[VAL_11]] : i32 +! CHECK: } + +subroutine char_binary(x, y) + character(*) :: x(100), y(100) + call test_char(x//y) +end subroutine +! CHECK-LABEL: func.func @_QPchar_binary( +! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_5:.*]]) typeparams %[[VAL_2:.*]]#1 {{.*}}x +! CHECK: %[[VAL_11:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_10:.*]]) typeparams %[[VAL_7:.*]]#1 {{.*}}y +! CHECK: %[[VAL_12:.*]] = arith.addi %[[VAL_2]]#1, %[[VAL_7]]#1 : index +! CHECK: %[[VAL_13:.*]] = hlfir.elemental %[[VAL_5]] typeparams %[[VAL_12]] : (!fir.shape<1>, index) -> !hlfir.expr<100x!fir.char<1,?>> { +! CHECK: ^bb0(%[[VAL_14:.*]]: index): +! CHECK: %[[VAL_15:.*]] = hlfir.designate %[[VAL_6]]#0 (%[[VAL_14]]) typeparams %[[VAL_2]]#1 : (!fir.box>>, index, index) -> !fir.boxchar<1> +! CHECK: %[[VAL_16:.*]] = hlfir.designate %[[VAL_11]]#0 (%[[VAL_14]]) typeparams %[[VAL_7]]#1 : (!fir.box>>, index, index) -> !fir.boxchar<1> +! CHECK: %[[VAL_17:.*]] = hlfir.concat %[[VAL_15]], %[[VAL_16]] len %[[VAL_12]] : (!fir.boxchar<1>, !fir.boxchar<1>, index) -> !hlfir.expr> +! CHECK: hlfir.yield_element %[[VAL_17]] : !hlfir.expr> +! CHECK: } + +subroutine unary(x, n) + integer :: n + logical :: x(n) + x = .not.x +end subroutine +! CHECK-LABEL: func.func @_QPunary( +! CHECK: %[[VAL_10:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_9:[^)]*]]) {{.*}}x +! CHECK: %[[VAL_11:.*]] = hlfir.elemental %[[VAL_9]] : (!fir.shape<1>) -> !hlfir.expr> { +! CHECK: ^bb0(%[[VAL_12:.*]]: index): +! CHECK: %[[VAL_13:.*]] = hlfir.designate %[[VAL_10]]#0 (%[[VAL_12]]) : (!fir.box>>, index) -> !fir.ref> +! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_13]] : !fir.ref> +! CHECK: %[[VAL_15:.*]] = arith.constant true +! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_14]] : (!fir.logical<4>) -> i1 +! CHECK: %[[VAL_17:.*]] = arith.xori %[[VAL_16]], %[[VAL_15]] : i1 +! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i1) -> !fir.logical<4> +! CHECK: hlfir.yield_element %[[VAL_18]] : !fir.logical<4> +! CHECK: } + +subroutine char_unary(x) + character(10) :: x(20) + call test_char_2((x)) +end subroutine +! CHECK-LABEL: func.func @_QPchar_unary( +! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_5:.*]]) typeparams %[[VAL_2:[^ ]*]] {{.*}}x +! CHECK: %[[VAL_7:.*]] = hlfir.elemental %[[VAL_5]] typeparams %[[VAL_2]] : (!fir.shape<1>, index) -> !hlfir.expr<20x!fir.char<1,?>> { +! CHECK: ^bb0(%[[VAL_8:.*]]: index): +! CHECK: %[[VAL_9:.*]] = hlfir.designate %[[VAL_6]]#0 (%[[VAL_8]]) typeparams %[[VAL_2]] : (!fir.ref>>, index, index) -> !fir.ref> +! CHECK: %[[VAL_10:.*]] = hlfir.as_expr %[[VAL_9]] : (!fir.ref>) -> !hlfir.expr> +! CHECK: hlfir.yield_element %[[VAL_10]] : !hlfir.expr> +! CHECK: } + +subroutine chained_elemental(x, y, z) + integer :: x(100), y(100), z(100) + x = x+y+z +end subroutine +! CHECK-LABEL: func.func @_QPchained_elemental( +! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_4:[^)]*]]) {{.*}}x +! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_7:[^)]*]]) {{.*}}y +! CHECK: %[[VAL_11:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_10:[^)]*]]) {{.*}}z +! CHECK: %[[VAL_12:.*]] = hlfir.elemental %[[VAL_4]] : (!fir.shape<1>) -> !hlfir.expr<100xi32> { +! CHECK: ^bb0(%[[VAL_13:.*]]: index): +! CHECK: %[[VAL_14:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_13]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_15:.*]] = hlfir.designate %[[VAL_8]]#0 (%[[VAL_13]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_14]] : !fir.ref +! CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_15]] : !fir.ref +! CHECK: %[[VAL_18:.*]] = arith.addi %[[VAL_16]], %[[VAL_17]] : i32 +! CHECK: hlfir.yield_element %[[VAL_18]] : i32 +! CHECK: } +! CHECK: %[[VAL_19:.*]] = hlfir.elemental %[[VAL_4]] : (!fir.shape<1>) -> !hlfir.expr<100xi32> { +! CHECK: ^bb0(%[[VAL_20:.*]]: index): +! CHECK: %[[VAL_21:.*]] = hlfir.apply %[[VAL_22:.*]], %[[VAL_20]] : (!hlfir.expr<100xi32>, index) -> i32 +! CHECK: %[[VAL_23:.*]] = hlfir.designate %[[VAL_11]]#0 (%[[VAL_20]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_24:.*]] = fir.load %[[VAL_23]] : !fir.ref +! CHECK: %[[VAL_25:.*]] = arith.addi %[[VAL_21]], %[[VAL_24]] : i32 +! CHECK: hlfir.yield_element %[[VAL_25]] : i32 +! CHECK: } + +subroutine lower_bounds(x) + integer :: x(2:101) + call test((x)) +end subroutine +! CHECK-LABEL: func.func @_QPlower_bounds( +! CHECK: %[[VAL_1:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_2:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_3:[^)]*]]) {{.*}}x +! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_6:.*]] = hlfir.elemental %[[VAL_5]] : (!fir.shape<1>) -> !hlfir.expr<100xi32> { +! CHECK: ^bb0(%[[VAL_7:.*]]: index): +! CHECK: %[[VAL_8:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_9:.*]] = arith.subi %[[VAL_1]], %[[VAL_8]] : index +! CHECK: %[[VAL_10:.*]] = arith.addi %[[VAL_7]], %[[VAL_9]] : index +! CHECK: %[[VAL_11:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_10]]) : (!fir.box>, index) -> !fir.ref +! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_11]] : !fir.ref +! CHECK: %[[VAL_13:.*]] = hlfir.no_reassoc %[[VAL_12]] : i32 +! CHECK: hlfir.yield_element %[[VAL_13]] : i32 +! CHECK: }