@@ -424,8 +424,8 @@ class ScalarExprLowering {
424424 }
425425
426426 template <typename OpTy>
427- mlir::Value createCompareOp (mlir::arith::CmpIPredicate pred, const ExtValue &left,
428- const ExtValue &right) {
427+ mlir::Value createCompareOp (mlir::arith::CmpIPredicate pred,
428+ const ExtValue &left, const ExtValue & right) {
429429 if (auto *lhs = left.getUnboxed ())
430430 if (auto *rhs = right.getUnboxed ())
431431 return builder.create <OpTy>(getLoc (), pred, *lhs, *rhs);
@@ -438,8 +438,8 @@ class ScalarExprLowering {
438438 }
439439
440440 template <typename OpTy>
441- mlir::Value createFltCmpOp (mlir::arith::CmpFPredicate pred, const ExtValue &left,
442- const ExtValue &right) {
441+ mlir::Value createFltCmpOp (mlir::arith::CmpFPredicate pred,
442+ const ExtValue &left, const ExtValue & right) {
443443 if (auto *lhs = left.getUnboxed ())
444444 if (auto *rhs = right.getUnboxed ())
445445 return builder.create <OpTy>(getLoc (), pred, *lhs, *rhs);
@@ -453,8 +453,8 @@ class ScalarExprLowering {
453453
454454 // / Create a call to the runtime to compare two CHARACTER values.
455455 // / Precondition: This assumes that the two values have `fir.boxchar` type.
456- mlir::Value createCharCompare (mlir::arith::CmpIPredicate pred, const ExtValue &left,
457- const ExtValue &right) {
456+ mlir::Value createCharCompare (mlir::arith::CmpIPredicate pred,
457+ const ExtValue &left, const ExtValue & right) {
458458 return fir::runtime::genCharCompare (builder, getLoc (), pred, left, right);
459459 }
460460
@@ -879,12 +879,14 @@ class ScalarExprLowering {
879879 template <int KIND>
880880 ExtValue genval (const Fortran::evaluate::Relational<Fortran::evaluate::Type<
881881 Fortran::common::TypeCategory::Integer, KIND>> &op) {
882- return createCompareOp<mlir::arith::CmpIOp>(op, translateRelational (op.opr ));
882+ return createCompareOp<mlir::arith::CmpIOp>(op,
883+ translateRelational (op.opr ));
883884 }
884885 template <int KIND>
885886 ExtValue genval (const Fortran::evaluate::Relational<Fortran::evaluate::Type<
886887 Fortran::common::TypeCategory::Real, KIND>> &op) {
887- return createFltCmpOp<mlir::arith::CmpFOp>(op, translateFloatRelational (op.opr ));
888+ return createFltCmpOp<mlir::arith::CmpFOp>(
889+ op, translateFloatRelational (op.opr ));
888890 }
889891 template <int KIND>
890892 ExtValue genval (const Fortran::evaluate::Relational<Fortran::evaluate::Type<
@@ -942,9 +944,11 @@ class ScalarExprLowering {
942944 case Fortran::evaluate::LogicalOperator::Or:
943945 return createBinaryOp<mlir::arith::OrIOp>(lhs, rhs);
944946 case Fortran::evaluate::LogicalOperator::Eqv:
945- return createCompareOp<mlir::arith::CmpIOp>(mlir::arith::CmpIPredicate::eq, lhs, rhs);
947+ return createCompareOp<mlir::arith::CmpIOp>(
948+ mlir::arith::CmpIPredicate::eq, lhs, rhs);
946949 case Fortran::evaluate::LogicalOperator::Neqv:
947- return createCompareOp<mlir::arith::CmpIOp>(mlir::arith::CmpIPredicate::ne, lhs, rhs);
950+ return createCompareOp<mlir::arith::CmpIOp>(
951+ mlir::arith::CmpIPredicate::ne, lhs, rhs);
948952 case Fortran::evaluate::LogicalOperator::Not:
949953 // lib/evaluate expression for .NOT. is Fortran::evaluate::Not<KIND>.
950954 llvm_unreachable (" .NOT. is not a binary operator" );
@@ -3119,9 +3123,11 @@ class ScalarArrayExprLowering {
31193123 case Fortran::evaluate::LogicalOperator::Or:
31203124 return createBinaryBoolOp<mlir::arith::OrIOp>(x);
31213125 case Fortran::evaluate::LogicalOperator::Eqv:
3122- return createCompareBoolOp<mlir::arith::CmpIOp>(mlir::arith::CmpIPredicate::eq, x);
3126+ return createCompareBoolOp<mlir::arith::CmpIOp>(
3127+ mlir::arith::CmpIPredicate::eq, x);
31233128 case Fortran::evaluate::LogicalOperator::Neqv:
3124- return createCompareBoolOp<mlir::arith::CmpIOp>(mlir::arith::CmpIPredicate::ne, x);
3129+ return createCompareBoolOp<mlir::arith::CmpIOp>(
3130+ mlir::arith::CmpIPredicate::ne, x);
31253131 case Fortran::evaluate::LogicalOperator::Not:
31263132 llvm_unreachable (" .NOT. handled elsewhere" );
31273133 }
@@ -3156,7 +3162,8 @@ class ScalarArrayExprLowering {
31563162 ExtValue
31573163 gen (const Fortran::evaluate::Relational<
31583164 Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>> &x) {
3159- return createCompareOp<mlir::arith::CmpFOp>(translateFloatRelational (x.opr ), x);
3165+ return createCompareOp<mlir::arith::CmpFOp>(translateFloatRelational (x.opr ),
3166+ x);
31603167 }
31613168 template <int KIND>
31623169 ExtValue gen (const Fortran::evaluate::Relational<Fortran::evaluate::Type<
@@ -4043,8 +4050,8 @@ class ArrayExprLowering {
40434050 // Compute the dynamic position into the header.
40444051 llvm::SmallVector<mlir::Value> offsets;
40454052 for (auto doLoop : loopStack[i]) {
4046- auto m = builder.create <mlir::arith::SubIOp>(loc, doLoop. getInductionVar (),
4047- doLoop.lowerBound ());
4053+ auto m = builder.create <mlir::arith::SubIOp>(
4054+ loc, doLoop. getInductionVar (), doLoop.lowerBound ());
40484055 auto n = builder.create <mlir::arith::DivSIOp>(loc, m, doLoop.step ());
40494056 auto one = builder.createIntegerConstant (loc, n.getType (), 1 );
40504057 offsets.push_back (builder.create <mlir::arith::AddIOp>(loc, n, one));
@@ -4166,7 +4173,8 @@ class ArrayExprLowering {
41664173 // Convert any implied shape to closed interval form. The fir.do_loop will
41674174 // run from 0 to `extent - 1` inclusive.
41684175 for (auto extent : shape)
4169- loopUppers.push_back (builder.create <mlir::arith::SubIOp>(loc, extent, one));
4176+ loopUppers.push_back (
4177+ builder.create <mlir::arith::SubIOp>(loc, extent, one));
41704178
41714179 // Iteration space is created with outermost columns, innermost rows
41724180 llvm::SmallVector<fir::DoLoopOp> loops;
@@ -5120,8 +5128,8 @@ class ArrayExprLowering {
51205128 loc, resTy, arrLd, mlir::ValueRange{iter},
51215129 arrLdTypeParams);
51225130 auto cast = builder.createConvert (loc, idxTy, fetch);
5123- auto val =
5124- builder. create <mlir::arith::SubIOp>(loc, idxTy, cast, lb);
5131+ auto val = builder. create <mlir::arith::SubIOp>(loc, idxTy,
5132+ cast, lb);
51255133 newIters.setIndexValue (dim, val);
51265134 return newIters;
51275135 };
@@ -5310,9 +5318,10 @@ class ArrayExprLowering {
53105318 // Convert the upper bound to a length.
53115319 auto cast = builder.createConvert (loc, iTy, substringBounds[1 ]);
53125320 auto zero = builder.createIntegerConstant (loc, iTy, 0 );
5313- auto size = builder.create <mlir::arith::SubIOp>(loc, cast, substringBounds[0 ]);
5314- auto cmp = builder.create <mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::sgt,
5315- size, zero);
5321+ auto size =
5322+ builder.create <mlir::arith::SubIOp>(loc, cast, substringBounds[0 ]);
5323+ auto cmp = builder.create <mlir::arith::CmpIOp>(
5324+ loc, mlir::arith::CmpIPredicate::sgt, size, zero);
53165325 // size = MAX(upper - (lower - 1), 0)
53175326 substringBounds[1 ] =
53185327 builder.create <mlir::SelectOp>(loc, cmp, size, zero);
@@ -5695,8 +5704,8 @@ class ArrayExprLowering {
56955704 mlir::Value eleSz) {
56965705 auto loc = getLoc ();
56975706 auto reallocFunc = fir::factory::getRealloc (builder);
5698- auto cond = builder.create <mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::sle,
5699- bufferSize, needed);
5707+ auto cond = builder.create <mlir::arith::CmpIOp>(
5708+ loc, mlir::arith::CmpIPredicate::sle, bufferSize, needed);
57005709 auto ifOp = builder.create <fir::IfOp>(loc, mem.getType (), cond,
57015710 /* withElseRegion=*/ true );
57025711 auto insPt = builder.saveInsertionPoint ();
@@ -5790,7 +5799,8 @@ class ArrayExprLowering {
57905799 mem = growBuffer (mem, endOff, limit, buffSize, eleSz);
57915800
57925801 // Copy the elements to the buffer.
5793- mlir::Value byteSz = builder.create <mlir::arith::MulIOp>(loc, arrSz, eleSz);
5802+ mlir::Value byteSz =
5803+ builder.create <mlir::arith::MulIOp>(loc, arrSz, eleSz);
57945804 auto buff = builder.createConvert (loc, fir::HeapType::get (resTy), mem);
57955805 auto buffi = computeCoordinate (buff, off);
57965806 auto args = fir::runtime::createArguments (
@@ -6064,9 +6074,11 @@ class ArrayExprLowering {
60646074 case Fortran::evaluate::LogicalOperator::Or:
60656075 return createBinaryBoolOp<mlir::arith::OrIOp>(x);
60666076 case Fortran::evaluate::LogicalOperator::Eqv:
6067- return createCompareBoolOp<mlir::arith::CmpIOp>(mlir::arith::CmpIPredicate::eq, x);
6077+ return createCompareBoolOp<mlir::arith::CmpIOp>(
6078+ mlir::arith::CmpIPredicate::eq, x);
60686079 case Fortran::evaluate::LogicalOperator::Neqv:
6069- return createCompareBoolOp<mlir::arith::CmpIOp>(mlir::arith::CmpIPredicate::ne, x);
6080+ return createCompareBoolOp<mlir::arith::CmpIOp>(
6081+ mlir::arith::CmpIPredicate::ne, x);
60706082 case Fortran::evaluate::LogicalOperator::Not:
60716083 llvm_unreachable (" .NOT. handled elsewhere" );
60726084 }
@@ -6112,7 +6124,8 @@ class ArrayExprLowering {
61126124 template <int KIND>
61136125 CC genarr (const Fortran::evaluate::Relational<Fortran::evaluate::Type<
61146126 Fortran::common::TypeCategory::Real, KIND>> &x) {
6115- return createCompareOp<mlir::arith::CmpFOp>(translateFloatRelational (x.opr ), x);
6127+ return createCompareOp<mlir::arith::CmpFOp>(translateFloatRelational (x.opr ),
6128+ x);
61166129 }
61176130 template <int KIND>
61186131 CC genarr (const Fortran::evaluate::Relational<Fortran::evaluate::Type<
@@ -6179,7 +6192,8 @@ class ArrayExprLowering {
61796192 auto step = builder.createConvert (loc, idxTy, stride);
61806193 auto prod =
61816194 builder.create <mlir::arith::MulIOp>(loc, impliedIter, step);
6182- auto trip = builder.create <mlir::arith::AddIOp>(loc, initial, prod);
6195+ auto trip =
6196+ builder.create <mlir::arith::AddIOp>(loc, initial, prod);
61836197 return trip;
61846198 }},
61856199 sub.u );
0 commit comments