xref: /llvm-project/flang/lib/Optimizer/Transforms/SimplifyIntrinsics.cpp (revision 89b98c13e02340d0aad37cc3bc6c5c579ca92918)
1 //===- SimplifyIntrinsics.cpp -- replace intrinsics with simpler form -----===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 //===----------------------------------------------------------------------===//
10 /// \file
11 /// This pass looks for suitable calls to runtime library for intrinsics that
12 /// can be simplified/specialized and replaces with a specialized function.
13 ///
14 /// For example, SUM(arr) can be specialized as a simple function with one loop,
15 /// compared to the three arguments (plus file & line info) that the runtime
16 /// call has - when the argument is a 1D-array (multiple loops may be needed
17 //  for higher dimension arrays, of course)
18 ///
19 /// The general idea is that besides making the call simpler, it can also be
20 /// inlined by other passes that run after this pass, which further improves
21 /// performance, particularly when the work done in the function is trivial
22 /// and small in size.
23 //===----------------------------------------------------------------------===//
24 
25 #include "flang/Common/Fortran.h"
26 #include "flang/Optimizer/Builder/BoxValue.h"
27 #include "flang/Optimizer/Builder/FIRBuilder.h"
28 #include "flang/Optimizer/Builder/LowLevelIntrinsics.h"
29 #include "flang/Optimizer/Builder/Todo.h"
30 #include "flang/Optimizer/Dialect/FIROps.h"
31 #include "flang/Optimizer/Dialect/FIRType.h"
32 #include "flang/Optimizer/Dialect/Support/FIRContext.h"
33 #include "flang/Optimizer/HLFIR/HLFIRDialect.h"
34 #include "flang/Optimizer/Transforms/Passes.h"
35 #include "flang/Runtime/entry-names.h"
36 #include "mlir/Dialect/LLVMIR/LLVMDialect.h"
37 #include "mlir/IR/Matchers.h"
38 #include "mlir/IR/Operation.h"
39 #include "mlir/Pass/Pass.h"
40 #include "mlir/Transforms/DialectConversion.h"
41 #include "mlir/Transforms/GreedyPatternRewriteDriver.h"
42 #include "mlir/Transforms/RegionUtils.h"
43 #include "llvm/Support/Debug.h"
44 #include "llvm/Support/raw_ostream.h"
45 #include <llvm/Support/ErrorHandling.h>
46 #include <mlir/Dialect/Arith/IR/Arith.h>
47 #include <mlir/IR/BuiltinTypes.h>
48 #include <mlir/IR/Location.h>
49 #include <mlir/IR/MLIRContext.h>
50 #include <mlir/IR/Value.h>
51 #include <mlir/Support/LLVM.h>
52 #include <optional>
53 
54 namespace fir {
55 #define GEN_PASS_DEF_SIMPLIFYINTRINSICS
56 #include "flang/Optimizer/Transforms/Passes.h.inc"
57 } // namespace fir
58 
59 #define DEBUG_TYPE "flang-simplify-intrinsics"
60 
61 namespace {
62 
63 class SimplifyIntrinsicsPass
64     : public fir::impl::SimplifyIntrinsicsBase<SimplifyIntrinsicsPass> {
65   using FunctionTypeGeneratorTy =
66       llvm::function_ref<mlir::FunctionType(fir::FirOpBuilder &)>;
67   using FunctionBodyGeneratorTy =
68       llvm::function_ref<void(fir::FirOpBuilder &, mlir::func::FuncOp &)>;
69   using GenReductionBodyTy = llvm::function_ref<void(
70       fir::FirOpBuilder &builder, mlir::func::FuncOp &funcOp, unsigned rank,
71       mlir::Type elementType)>;
72 
73 public:
74   /// Generate a new function implementing a simplified version
75   /// of a Fortran runtime function defined by \p basename name.
76   /// \p typeGenerator is a callback that generates the new function's type.
77   /// \p bodyGenerator is a callback that generates the new function's body.
78   /// The new function is created in the \p builder's Module.
79   mlir::func::FuncOp getOrCreateFunction(fir::FirOpBuilder &builder,
80                                          const mlir::StringRef &basename,
81                                          FunctionTypeGeneratorTy typeGenerator,
82                                          FunctionBodyGeneratorTy bodyGenerator);
83   void runOnOperation() override;
84   void getDependentDialects(mlir::DialectRegistry &registry) const override;
85 
86 private:
87   /// Helper functions to replace a reduction type of call with its
88   /// simplified form. The actual function is generated using a callback
89   /// function.
90   /// \p call is the call to be replaced
91   /// \p kindMap is used to create FIROpBuilder
92   /// \p genBodyFunc is the callback that builds the replacement function
93   void simplifyIntOrFloatReduction(fir::CallOp call,
94                                    const fir::KindMapping &kindMap,
95                                    GenReductionBodyTy genBodyFunc);
96   void simplifyLogicalDim0Reduction(fir::CallOp call,
97                                     const fir::KindMapping &kindMap,
98                                     GenReductionBodyTy genBodyFunc);
99   void simplifyLogicalDim1Reduction(fir::CallOp call,
100                                     const fir::KindMapping &kindMap,
101                                     GenReductionBodyTy genBodyFunc);
102   void simplifyMinlocReduction(fir::CallOp call,
103                                const fir::KindMapping &kindMap);
104   void simplifyReductionBody(fir::CallOp call, const fir::KindMapping &kindMap,
105                              GenReductionBodyTy genBodyFunc,
106                              fir::FirOpBuilder &builder,
107                              const mlir::StringRef &basename,
108                              mlir::Type elementType);
109 };
110 
111 } // namespace
112 
113 /// Create FirOpBuilder with the provided \p op insertion point
114 /// and \p kindMap additionally inheriting FastMathFlags from \p op.
115 static fir::FirOpBuilder
116 getSimplificationBuilder(mlir::Operation *op, const fir::KindMapping &kindMap) {
117   fir::FirOpBuilder builder{op, kindMap};
118   auto fmi = mlir::dyn_cast<mlir::arith::ArithFastMathInterface>(*op);
119   if (!fmi)
120     return builder;
121 
122   // Regardless of what default FastMathFlags are used by FirOpBuilder,
123   // override them with FastMathFlags attached to the operation.
124   builder.setFastMathFlags(fmi.getFastMathFlagsAttr().getValue());
125   return builder;
126 }
127 
128 /// Generate function type for the simplified version of RTNAME(Sum) and
129 /// similar functions with a fir.box<none> type returning \p elementType.
130 static mlir::FunctionType genNoneBoxType(fir::FirOpBuilder &builder,
131                                          const mlir::Type &elementType) {
132   mlir::Type boxType = fir::BoxType::get(builder.getNoneType());
133   return mlir::FunctionType::get(builder.getContext(), {boxType},
134                                  {elementType});
135 }
136 
137 template <typename Op>
138 Op expectOp(mlir::Value val) {
139   if (Op op = mlir::dyn_cast_or_null<Op>(val.getDefiningOp()))
140     return op;
141   LLVM_DEBUG(llvm::dbgs() << "Didn't find expected " << Op::getOperationName()
142                           << '\n');
143   return nullptr;
144 }
145 
146 template <typename Op>
147 static mlir::Value findDefSingle(fir::ConvertOp op) {
148   if (auto defOp = expectOp<Op>(op->getOperand(0))) {
149     return defOp.getResult();
150   }
151   return {};
152 }
153 
154 template <typename... Ops>
155 static mlir::Value findDef(fir::ConvertOp op) {
156   mlir::Value defOp;
157   // Loop over the operation types given to see if any match, exiting once
158   // a match is found. Cast to void is needed to avoid compiler complaining
159   // that the result of expression is unused
160   (void)((defOp = findDefSingle<Ops>(op), (defOp)) || ...);
161   return defOp;
162 }
163 
164 static bool isOperandAbsent(mlir::Value val) {
165   if (auto op = expectOp<fir::ConvertOp>(val)) {
166     assert(op->getOperands().size() != 0);
167     return mlir::isa_and_nonnull<fir::AbsentOp>(
168         op->getOperand(0).getDefiningOp());
169   }
170   return false;
171 }
172 
173 static bool isTrueOrNotConstant(mlir::Value val) {
174   if (auto op = expectOp<mlir::arith::ConstantOp>(val)) {
175     return !mlir::matchPattern(val, mlir::m_Zero());
176   }
177   return true;
178 }
179 
180 static bool isZero(mlir::Value val) {
181   if (auto op = expectOp<fir::ConvertOp>(val)) {
182     assert(op->getOperands().size() != 0);
183     if (mlir::Operation *defOp = op->getOperand(0).getDefiningOp())
184       return mlir::matchPattern(defOp, mlir::m_Zero());
185   }
186   return false;
187 }
188 
189 static mlir::Value findBoxDef(mlir::Value val) {
190   if (auto op = expectOp<fir::ConvertOp>(val)) {
191     assert(op->getOperands().size() != 0);
192     return findDef<fir::EmboxOp, fir::ReboxOp>(op);
193   }
194   return {};
195 }
196 
197 static mlir::Value findMaskDef(mlir::Value val) {
198   if (auto op = expectOp<fir::ConvertOp>(val)) {
199     assert(op->getOperands().size() != 0);
200     return findDef<fir::EmboxOp, fir::ReboxOp, fir::AbsentOp>(op);
201   }
202   return {};
203 }
204 
205 static unsigned getDimCount(mlir::Value val) {
206   // In order to find the dimensions count, we look for EmboxOp/ReboxOp
207   // and take the count from its *result* type. Note that in case
208   // of sliced emboxing the operand and the result of EmboxOp/ReboxOp
209   // have different types.
210   // Actually, we can take the box type from the operand of
211   // the first ConvertOp that has non-opaque box type that we meet
212   // going through the ConvertOp chain.
213   if (mlir::Value emboxVal = findBoxDef(val))
214     if (auto boxTy = emboxVal.getType().dyn_cast<fir::BoxType>())
215       if (auto seqTy = boxTy.getEleTy().dyn_cast<fir::SequenceType>())
216         return seqTy.getDimension();
217   return 0;
218 }
219 
220 /// Given the call operation's box argument \p val, discover
221 /// the element type of the underlying array object.
222 /// \returns the element type or std::nullopt if the type cannot
223 /// be reliably found.
224 /// We expect that the argument is a result of fir.convert
225 /// with the destination type of !fir.box<none>.
226 static std::optional<mlir::Type> getArgElementType(mlir::Value val) {
227   mlir::Operation *defOp;
228   do {
229     defOp = val.getDefiningOp();
230     // Analyze only sequences of convert operations.
231     if (!mlir::isa<fir::ConvertOp>(defOp))
232       return std::nullopt;
233     val = defOp->getOperand(0);
234     // The convert operation is expected to convert from one
235     // box type to another box type.
236     auto boxType = val.getType().cast<fir::BoxType>();
237     auto elementType = fir::unwrapSeqOrBoxedSeqType(boxType);
238     if (!elementType.isa<mlir::NoneType>())
239       return elementType;
240   } while (true);
241 }
242 
243 using BodyOpGeneratorTy = llvm::function_ref<mlir::Value(
244     fir::FirOpBuilder &, mlir::Location, const mlir::Type &, mlir::Value,
245     mlir::Value)>;
246 using InitValGeneratorTy = llvm::function_ref<mlir::Value(
247     fir::FirOpBuilder &, mlir::Location, const mlir::Type &)>;
248 using ContinueLoopGenTy = llvm::function_ref<llvm::SmallVector<mlir::Value>(
249     fir::FirOpBuilder &, mlir::Location, mlir::Value)>;
250 
251 /// Generate the reduction loop into \p funcOp.
252 ///
253 /// \p initVal is a function, called to get the initial value for
254 ///    the reduction value
255 /// \p genBody is called to fill in the actual reduciton operation
256 ///    for example add for SUM, MAX for MAXVAL, etc.
257 /// \p rank is the rank of the input argument.
258 /// \p elementType is the type of the elements in the input array,
259 ///    which may be different to the return type.
260 /// \p loopCond is called to generate the condition to continue or
261 ///    not for IterWhile loops
262 /// \p unorderedOrInitalLoopCond contains either a boolean or bool
263 ///    mlir constant, and controls the inital value for while loops
264 ///    or if DoLoop is ordered/unordered.
265 
266 template <typename OP, typename T, int resultIndex>
267 static void
268 genReductionLoop(fir::FirOpBuilder &builder, mlir::func::FuncOp &funcOp,
269                  InitValGeneratorTy initVal, ContinueLoopGenTy loopCond,
270                  T unorderedOrInitialLoopCond, BodyOpGeneratorTy genBody,
271                  unsigned rank, mlir::Type elementType, mlir::Location loc) {
272 
273   mlir::IndexType idxTy = builder.getIndexType();
274 
275   mlir::Block::BlockArgListType args = funcOp.front().getArguments();
276   mlir::Value arg = args[0];
277 
278   mlir::Value zeroIdx = builder.createIntegerConstant(loc, idxTy, 0);
279 
280   fir::SequenceType::Shape flatShape(rank,
281                                      fir::SequenceType::getUnknownExtent());
282   mlir::Type arrTy = fir::SequenceType::get(flatShape, elementType);
283   mlir::Type boxArrTy = fir::BoxType::get(arrTy);
284   mlir::Value array = builder.create<fir::ConvertOp>(loc, boxArrTy, arg);
285   mlir::Type resultType = funcOp.getResultTypes()[0];
286   mlir::Value init = initVal(builder, loc, resultType);
287 
288   llvm::SmallVector<mlir::Value, Fortran::common::maxRank> bounds;
289 
290   assert(rank > 0 && "rank cannot be zero");
291   mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
292 
293   // Compute all the upper bounds before the loop nest.
294   // It is not strictly necessary for performance, since the loop nest
295   // does not have any store operations and any LICM optimization
296   // should be able to optimize the redundancy.
297   for (unsigned i = 0; i < rank; ++i) {
298     mlir::Value dimIdx = builder.createIntegerConstant(loc, idxTy, i);
299     auto dims =
300         builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, array, dimIdx);
301     mlir::Value len = dims.getResult(1);
302     // We use C indexing here, so len-1 as loopcount
303     mlir::Value loopCount = builder.create<mlir::arith::SubIOp>(loc, len, one);
304     bounds.push_back(loopCount);
305   }
306   // Create a loop nest consisting of OP operations.
307   // Collect the loops' induction variables into indices array,
308   // which will be used in the innermost loop to load the input
309   // array's element.
310   // The loops are generated such that the innermost loop processes
311   // the 0 dimension.
312   llvm::SmallVector<mlir::Value, Fortran::common::maxRank> indices;
313   for (unsigned i = rank; 0 < i; --i) {
314     mlir::Value step = one;
315     mlir::Value loopCount = bounds[i - 1];
316     auto loop = builder.create<OP>(loc, zeroIdx, loopCount, step,
317                                    unorderedOrInitialLoopCond,
318                                    /*finalCountValue=*/false, init);
319     init = loop.getRegionIterArgs()[resultIndex];
320     indices.push_back(loop.getInductionVar());
321     // Set insertion point to the loop body so that the next loop
322     // is inserted inside the current one.
323     builder.setInsertionPointToStart(loop.getBody());
324   }
325 
326   // Reverse the indices such that they are ordered as:
327   //   <dim-0-idx, dim-1-idx, ...>
328   std::reverse(indices.begin(), indices.end());
329   // We are in the innermost loop: generate the reduction body.
330   mlir::Type eleRefTy = builder.getRefType(elementType);
331   mlir::Value addr =
332       builder.create<fir::CoordinateOp>(loc, eleRefTy, array, indices);
333   mlir::Value elem = builder.create<fir::LoadOp>(loc, addr);
334   mlir::Value reductionVal = genBody(builder, loc, elementType, elem, init);
335   // Generate vector with condition to continue while loop at [0] and result
336   // from current loop at [1] for IterWhileOp loops, just result at [0] for
337   // DoLoopOp loops.
338   llvm::SmallVector<mlir::Value> results = loopCond(builder, loc, reductionVal);
339 
340   // Unwind the loop nest and insert ResultOp on each level
341   // to return the updated value of the reduction to the enclosing
342   // loops.
343   for (unsigned i = 0; i < rank; ++i) {
344     auto result = builder.create<fir::ResultOp>(loc, results);
345     // Proceed to the outer loop.
346     auto loop = mlir::cast<OP>(result->getParentOp());
347     results = loop.getResults();
348     // Set insertion point after the loop operation that we have
349     // just processed.
350     builder.setInsertionPointAfter(loop.getOperation());
351   }
352   // End of loop nest. The insertion point is after the outermost loop.
353   // Return the reduction value from the function.
354   builder.create<mlir::func::ReturnOp>(loc, results[resultIndex]);
355 }
356 using MinlocBodyOpGeneratorTy = llvm::function_ref<mlir::Value(
357     fir::FirOpBuilder &, mlir::Location, const mlir::Type &, mlir::Value,
358     mlir::Value, llvm::SmallVector<mlir::Value, Fortran::common::maxRank> &)>;
359 
360 static void
361 genMinlocReductionLoop(fir::FirOpBuilder &builder, mlir::func::FuncOp &funcOp,
362                        InitValGeneratorTy initVal,
363                        MinlocBodyOpGeneratorTy genBody, unsigned rank,
364                        mlir::Type elementType, mlir::Location loc, bool hasMask,
365                        mlir::Type maskElemType, mlir::Value resultArr) {
366 
367   mlir::IndexType idxTy = builder.getIndexType();
368 
369   mlir::Block::BlockArgListType args = funcOp.front().getArguments();
370   mlir::Value arg = args[1];
371 
372   mlir::Value zeroIdx = builder.createIntegerConstant(loc, idxTy, 0);
373 
374   fir::SequenceType::Shape flatShape(rank,
375                                      fir::SequenceType::getUnknownExtent());
376   mlir::Type arrTy = fir::SequenceType::get(flatShape, elementType);
377   mlir::Type boxArrTy = fir::BoxType::get(arrTy);
378   mlir::Value array = builder.create<fir::ConvertOp>(loc, boxArrTy, arg);
379 
380   mlir::Type resultElemType = hlfir::getFortranElementType(resultArr.getType());
381   mlir::Value flagSet = builder.createIntegerConstant(loc, resultElemType, 1);
382   mlir::Value zero = builder.createIntegerConstant(loc, resultElemType, 0);
383   mlir::Value flagRef = builder.createTemporary(loc, resultElemType);
384   builder.create<fir::StoreOp>(loc, zero, flagRef);
385 
386   mlir::Value mask;
387   if (hasMask) {
388     mlir::Type maskTy = fir::SequenceType::get(flatShape, maskElemType);
389     mlir::Type boxMaskTy = fir::BoxType::get(maskTy);
390     mask = builder.create<fir::ConvertOp>(loc, boxMaskTy, args[2]);
391   }
392 
393   mlir::Value init = initVal(builder, loc, elementType);
394   llvm::SmallVector<mlir::Value, Fortran::common::maxRank> bounds;
395 
396   assert(rank > 0 && "rank cannot be zero");
397   mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
398 
399   // Compute all the upper bounds before the loop nest.
400   // It is not strictly necessary for performance, since the loop nest
401   // does not have any store operations and any LICM optimization
402   // should be able to optimize the redundancy.
403   for (unsigned i = 0; i < rank; ++i) {
404     mlir::Value dimIdx = builder.createIntegerConstant(loc, idxTy, i);
405     auto dims =
406         builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, array, dimIdx);
407     mlir::Value len = dims.getResult(1);
408     // We use C indexing here, so len-1 as loopcount
409     mlir::Value loopCount = builder.create<mlir::arith::SubIOp>(loc, len, one);
410     bounds.push_back(loopCount);
411   }
412   // Create a loop nest consisting of OP operations.
413   // Collect the loops' induction variables into indices array,
414   // which will be used in the innermost loop to load the input
415   // array's element.
416   // The loops are generated such that the innermost loop processes
417   // the 0 dimension.
418   llvm::SmallVector<mlir::Value, Fortran::common::maxRank> indices;
419   for (unsigned i = rank; 0 < i; --i) {
420     mlir::Value step = one;
421     mlir::Value loopCount = bounds[i - 1];
422     auto loop =
423         builder.create<fir::DoLoopOp>(loc, zeroIdx, loopCount, step, false,
424                                       /*finalCountValue=*/false, init);
425     init = loop.getRegionIterArgs()[0];
426     indices.push_back(loop.getInductionVar());
427     // Set insertion point to the loop body so that the next loop
428     // is inserted inside the current one.
429     builder.setInsertionPointToStart(loop.getBody());
430   }
431 
432   // Reverse the indices such that they are ordered as:
433   //   <dim-0-idx, dim-1-idx, ...>
434   std::reverse(indices.begin(), indices.end());
435   // We are in the innermost loop: generate the reduction body.
436   if (hasMask) {
437     mlir::Type logicalRef = builder.getRefType(maskElemType);
438     mlir::Value maskAddr =
439         builder.create<fir::CoordinateOp>(loc, logicalRef, mask, indices);
440     mlir::Value maskElem = builder.create<fir::LoadOp>(loc, maskAddr);
441 
442     // fir::IfOp requires argument to be I1 - won't accept logical or any other
443     // Integer.
444     mlir::Type ifCompatType = builder.getI1Type();
445     mlir::Value ifCompatElem =
446         builder.create<fir::ConvertOp>(loc, ifCompatType, maskElem);
447 
448     llvm::SmallVector<mlir::Type> resultsTy = {elementType, elementType};
449     fir::IfOp ifOp = builder.create<fir::IfOp>(loc, elementType, ifCompatElem,
450                                                /*withElseRegion=*/true);
451     builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
452   }
453 
454   // Set flag that mask was true at some point
455   builder.create<fir::StoreOp>(loc, flagSet, flagRef);
456   mlir::Type eleRefTy = builder.getRefType(elementType);
457   mlir::Value addr =
458       builder.create<fir::CoordinateOp>(loc, eleRefTy, array, indices);
459   mlir::Value elem = builder.create<fir::LoadOp>(loc, addr);
460 
461   mlir::Value reductionVal =
462       genBody(builder, loc, elementType, elem, init, indices);
463 
464   if (hasMask) {
465     fir::IfOp ifOp =
466         mlir::dyn_cast<fir::IfOp>(builder.getBlock()->getParentOp());
467     builder.create<fir::ResultOp>(loc, reductionVal);
468     builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
469     builder.create<fir::ResultOp>(loc, init);
470     reductionVal = ifOp.getResult(0);
471     builder.setInsertionPointAfter(ifOp);
472   }
473 
474   // Unwind the loop nest and insert ResultOp on each level
475   // to return the updated value of the reduction to the enclosing
476   // loops.
477   for (unsigned i = 0; i < rank; ++i) {
478     auto result = builder.create<fir::ResultOp>(loc, reductionVal);
479     // Proceed to the outer loop.
480     auto loop = mlir::cast<fir::DoLoopOp>(result->getParentOp());
481     reductionVal = loop.getResult(0);
482     // Set insertion point after the loop operation that we have
483     // just processed.
484     builder.setInsertionPointAfter(loop.getOperation());
485   }
486   // End of loop nest. The insertion point is after the outermost loop.
487   if (fir::IfOp ifOp =
488           mlir::dyn_cast<fir::IfOp>(builder.getBlock()->getParentOp())) {
489     builder.create<fir::ResultOp>(loc, reductionVal);
490     builder.setInsertionPointAfter(ifOp);
491     // Redefine flagSet to escape scope of ifOp
492     flagSet = builder.createIntegerConstant(loc, resultElemType, 1);
493     reductionVal = ifOp.getResult(0);
494   }
495 
496   // Check for case where array was full of max values.
497   // flag will be 0 if mask was never true, 1 if mask was true as some point,
498   // this is needed to avoid catching cases where we didn't access any elements
499   // e.g. mask=.FALSE.
500   mlir::Value flagValue =
501       builder.create<fir::LoadOp>(loc, resultElemType, flagRef);
502   mlir::Value flagCmp = builder.create<mlir::arith::CmpIOp>(
503       loc, mlir::arith::CmpIPredicate::eq, flagValue, flagSet);
504   fir::IfOp ifMaskTrueOp =
505       builder.create<fir::IfOp>(loc, flagCmp, /*withElseRegion=*/false);
506   builder.setInsertionPointToStart(&ifMaskTrueOp.getThenRegion().front());
507 
508   mlir::Value testInit = initVal(builder, loc, elementType);
509   fir::IfOp ifMinSetOp;
510   if (elementType.isa<mlir::FloatType>()) {
511     mlir::Value cmp = builder.create<mlir::arith::CmpFOp>(
512         loc, mlir::arith::CmpFPredicate::OEQ, testInit, reductionVal);
513     ifMinSetOp = builder.create<fir::IfOp>(loc, cmp,
514                                            /*withElseRegion*/ false);
515   } else {
516     mlir::Value cmp = builder.create<mlir::arith::CmpIOp>(
517         loc, mlir::arith::CmpIPredicate::eq, testInit, reductionVal);
518     ifMinSetOp = builder.create<fir::IfOp>(loc, cmp,
519                                            /*withElseRegion*/ false);
520   }
521   builder.setInsertionPointToStart(&ifMinSetOp.getThenRegion().front());
522 
523   // Load output array with 1s instead of 0s
524   for (unsigned int i = 0; i < rank; ++i) {
525     mlir::Type resultRefTy = builder.getRefType(resultElemType);
526     // mlir::Value one = builder.createIntegerConstant(loc, resultElemType, 1);
527     mlir::Value index = builder.createIntegerConstant(loc, idxTy, i);
528     mlir::Value resultElemAddr =
529         builder.create<fir::CoordinateOp>(loc, resultRefTy, resultArr, index);
530     builder.create<fir::StoreOp>(loc, flagSet, resultElemAddr);
531   }
532   builder.setInsertionPointAfter(ifMaskTrueOp);
533   // Store newly created output array to the reference passed in
534   fir::SequenceType::Shape resultShape(1, rank);
535   mlir::Type outputArrTy = fir::SequenceType::get(resultShape, resultElemType);
536   mlir::Type outputHeapTy = fir::HeapType::get(outputArrTy);
537   mlir::Type outputBoxTy = fir::BoxType::get(outputHeapTy);
538   mlir::Type outputRefTy = builder.getRefType(outputBoxTy);
539 
540   mlir::Value outputArrNone = args[0];
541   mlir::Value outputArr =
542       builder.create<fir::ConvertOp>(loc, outputRefTy, outputArrNone);
543 
544   // Store nearly created array to output array
545   builder.create<fir::StoreOp>(loc, resultArr, outputArr);
546   builder.create<mlir::func::ReturnOp>(loc);
547 }
548 
549 static llvm::SmallVector<mlir::Value> nopLoopCond(fir::FirOpBuilder &builder,
550                                                   mlir::Location loc,
551                                                   mlir::Value reductionVal) {
552   return {reductionVal};
553 }
554 
555 /// Generate function body of the simplified version of RTNAME(Sum)
556 /// with signature provided by \p funcOp. The caller is responsible
557 /// for saving/restoring the original insertion point of \p builder.
558 /// \p funcOp is expected to be empty on entry to this function.
559 /// \p rank specifies the rank of the input argument.
560 static void genRuntimeSumBody(fir::FirOpBuilder &builder,
561                               mlir::func::FuncOp &funcOp, unsigned rank,
562                               mlir::Type elementType) {
563   // function RTNAME(Sum)<T>x<rank>_simplified(arr)
564   //   T, dimension(:) :: arr
565   //   T sum = 0
566   //   integer iter
567   //   do iter = 0, extent(arr)
568   //     sum = sum + arr[iter]
569   //   end do
570   //   RTNAME(Sum)<T>x<rank>_simplified = sum
571   // end function RTNAME(Sum)<T>x<rank>_simplified
572   auto zero = [](fir::FirOpBuilder builder, mlir::Location loc,
573                  mlir::Type elementType) {
574     if (auto ty = elementType.dyn_cast<mlir::FloatType>()) {
575       const llvm::fltSemantics &sem = ty.getFloatSemantics();
576       return builder.createRealConstant(loc, elementType,
577                                         llvm::APFloat::getZero(sem));
578     }
579     return builder.createIntegerConstant(loc, elementType, 0);
580   };
581 
582   auto genBodyOp = [](fir::FirOpBuilder builder, mlir::Location loc,
583                       mlir::Type elementType, mlir::Value elem1,
584                       mlir::Value elem2) -> mlir::Value {
585     if (elementType.isa<mlir::FloatType>())
586       return builder.create<mlir::arith::AddFOp>(loc, elem1, elem2);
587     if (elementType.isa<mlir::IntegerType>())
588       return builder.create<mlir::arith::AddIOp>(loc, elem1, elem2);
589 
590     llvm_unreachable("unsupported type");
591     return {};
592   };
593 
594   mlir::Location loc = mlir::UnknownLoc::get(builder.getContext());
595   builder.setInsertionPointToEnd(funcOp.addEntryBlock());
596 
597   genReductionLoop<fir::DoLoopOp, bool, 0>(builder, funcOp, zero, nopLoopCond,
598                                            false, genBodyOp, rank, elementType,
599                                            loc);
600 }
601 
602 static void genRuntimeMaxvalBody(fir::FirOpBuilder &builder,
603                                  mlir::func::FuncOp &funcOp, unsigned rank,
604                                  mlir::Type elementType) {
605   auto init = [](fir::FirOpBuilder builder, mlir::Location loc,
606                  mlir::Type elementType) {
607     if (auto ty = elementType.dyn_cast<mlir::FloatType>()) {
608       const llvm::fltSemantics &sem = ty.getFloatSemantics();
609       return builder.createRealConstant(
610           loc, elementType, llvm::APFloat::getLargest(sem, /*Negative=*/true));
611     }
612     unsigned bits = elementType.getIntOrFloatBitWidth();
613     int64_t minInt = llvm::APInt::getSignedMinValue(bits).getSExtValue();
614     return builder.createIntegerConstant(loc, elementType, minInt);
615   };
616 
617   auto genBodyOp = [](fir::FirOpBuilder builder, mlir::Location loc,
618                       mlir::Type elementType, mlir::Value elem1,
619                       mlir::Value elem2) -> mlir::Value {
620     if (elementType.isa<mlir::FloatType>()) {
621       // arith.maxf later converted to llvm.intr.maxnum does not work
622       // correctly for NaNs and -0.0 (see maxnum/minnum pattern matching
623       // in LLVM's InstCombine pass). Moreover, llvm.intr.maxnum
624       // for F128 operands is lowered into fmaxl call by LLVM.
625       // This libm function may not work properly for F128 arguments
626       // on targets where long double is not F128. It is an LLVM issue,
627       // but we just use normal select here to resolve all the cases.
628       auto compare = builder.create<mlir::arith::CmpFOp>(
629           loc, mlir::arith::CmpFPredicate::OGT, elem1, elem2);
630       return builder.create<mlir::arith::SelectOp>(loc, compare, elem1, elem2);
631     }
632     if (elementType.isa<mlir::IntegerType>())
633       return builder.create<mlir::arith::MaxSIOp>(loc, elem1, elem2);
634 
635     llvm_unreachable("unsupported type");
636     return {};
637   };
638 
639   mlir::Location loc = mlir::UnknownLoc::get(builder.getContext());
640   builder.setInsertionPointToEnd(funcOp.addEntryBlock());
641 
642   genReductionLoop<fir::DoLoopOp, bool, 0>(builder, funcOp, init, nopLoopCond,
643                                            false, genBodyOp, rank, elementType,
644                                            loc);
645 }
646 
647 static void genRuntimeCountBody(fir::FirOpBuilder &builder,
648                                 mlir::func::FuncOp &funcOp, unsigned rank,
649                                 mlir::Type elementType) {
650   auto zero = [](fir::FirOpBuilder builder, mlir::Location loc,
651                  mlir::Type elementType) {
652     unsigned bits = elementType.getIntOrFloatBitWidth();
653     int64_t zeroInt = llvm::APInt::getZero(bits).getSExtValue();
654     return builder.createIntegerConstant(loc, elementType, zeroInt);
655   };
656 
657   auto genBodyOp = [](fir::FirOpBuilder builder, mlir::Location loc,
658                       mlir::Type elementType, mlir::Value elem1,
659                       mlir::Value elem2) -> mlir::Value {
660     auto zero32 = builder.createIntegerConstant(loc, elementType, 0);
661     auto zero64 = builder.createIntegerConstant(loc, builder.getI64Type(), 0);
662     auto one64 = builder.createIntegerConstant(loc, builder.getI64Type(), 1);
663 
664     auto compare = builder.create<mlir::arith::CmpIOp>(
665         loc, mlir::arith::CmpIPredicate::eq, elem1, zero32);
666     auto select =
667         builder.create<mlir::arith::SelectOp>(loc, compare, zero64, one64);
668     return builder.create<mlir::arith::AddIOp>(loc, select, elem2);
669   };
670 
671   // Count always gets I32 for elementType as it converts logical input to
672   // logical<4> before passing to the function.
673   mlir::Location loc = mlir::UnknownLoc::get(builder.getContext());
674   builder.setInsertionPointToEnd(funcOp.addEntryBlock());
675 
676   genReductionLoop<fir::DoLoopOp, bool, 0>(builder, funcOp, zero, nopLoopCond,
677                                            false, genBodyOp, rank, elementType,
678                                            loc);
679 }
680 
681 static void genRuntimeAnyBody(fir::FirOpBuilder &builder,
682                               mlir::func::FuncOp &funcOp, unsigned rank,
683                               mlir::Type elementType) {
684   auto zero = [](fir::FirOpBuilder builder, mlir::Location loc,
685                  mlir::Type elementType) {
686     return builder.createIntegerConstant(loc, elementType, 0);
687   };
688 
689   auto genBodyOp = [](fir::FirOpBuilder builder, mlir::Location loc,
690                       mlir::Type elementType, mlir::Value elem1,
691                       mlir::Value elem2) -> mlir::Value {
692     auto zero = builder.createIntegerConstant(loc, elementType, 0);
693     return builder.create<mlir::arith::CmpIOp>(
694         loc, mlir::arith::CmpIPredicate::ne, elem1, zero);
695   };
696 
697   auto continueCond = [](fir::FirOpBuilder builder, mlir::Location loc,
698                          mlir::Value reductionVal) {
699     auto one1 = builder.createIntegerConstant(loc, builder.getI1Type(), 1);
700     auto eor = builder.create<mlir::arith::XOrIOp>(loc, reductionVal, one1);
701     llvm::SmallVector<mlir::Value> results = {eor, reductionVal};
702     return results;
703   };
704 
705   mlir::Location loc = mlir::UnknownLoc::get(builder.getContext());
706   builder.setInsertionPointToEnd(funcOp.addEntryBlock());
707   mlir::Value ok = builder.createBool(loc, true);
708 
709   genReductionLoop<fir::IterWhileOp, mlir::Value, 1>(
710       builder, funcOp, zero, continueCond, ok, genBodyOp, rank, elementType,
711       loc);
712 }
713 
714 static void genRuntimeAllBody(fir::FirOpBuilder &builder,
715                               mlir::func::FuncOp &funcOp, unsigned rank,
716                               mlir::Type elementType) {
717   auto one = [](fir::FirOpBuilder builder, mlir::Location loc,
718                 mlir::Type elementType) {
719     return builder.createIntegerConstant(loc, elementType, 1);
720   };
721 
722   auto genBodyOp = [](fir::FirOpBuilder builder, mlir::Location loc,
723                       mlir::Type elementType, mlir::Value elem1,
724                       mlir::Value elem2) -> mlir::Value {
725     auto zero = builder.createIntegerConstant(loc, elementType, 0);
726     return builder.create<mlir::arith::CmpIOp>(
727         loc, mlir::arith::CmpIPredicate::ne, elem1, zero);
728   };
729 
730   auto continueCond = [](fir::FirOpBuilder builder, mlir::Location loc,
731                          mlir::Value reductionVal) {
732     llvm::SmallVector<mlir::Value> results = {reductionVal, reductionVal};
733     return results;
734   };
735 
736   mlir::Location loc = mlir::UnknownLoc::get(builder.getContext());
737   builder.setInsertionPointToEnd(funcOp.addEntryBlock());
738   mlir::Value ok = builder.createBool(loc, true);
739 
740   genReductionLoop<fir::IterWhileOp, mlir::Value, 1>(
741       builder, funcOp, one, continueCond, ok, genBodyOp, rank, elementType,
742       loc);
743 }
744 
745 static mlir::FunctionType genRuntimeMinlocType(fir::FirOpBuilder &builder,
746                                                unsigned int rank) {
747   mlir::Type boxType = fir::BoxType::get(builder.getNoneType());
748   mlir::Type boxRefType = builder.getRefType(boxType);
749 
750   return mlir::FunctionType::get(builder.getContext(),
751                                  {boxRefType, boxType, boxType}, {});
752 }
753 
754 static void genRuntimeMinlocBody(fir::FirOpBuilder &builder,
755                                  mlir::func::FuncOp &funcOp, unsigned rank,
756                                  int maskRank, mlir::Type elementType,
757                                  mlir::Type maskElemType,
758                                  mlir::Type resultElemTy) {
759   auto init = [](fir::FirOpBuilder builder, mlir::Location loc,
760                  mlir::Type elementType) {
761     if (auto ty = elementType.dyn_cast<mlir::FloatType>()) {
762       const llvm::fltSemantics &sem = ty.getFloatSemantics();
763       return builder.createRealConstant(
764           loc, elementType, llvm::APFloat::getLargest(sem, /*Negative=*/false));
765     }
766     unsigned bits = elementType.getIntOrFloatBitWidth();
767     int64_t maxInt = llvm::APInt::getSignedMaxValue(bits).getSExtValue();
768     return builder.createIntegerConstant(loc, elementType, maxInt);
769   };
770 
771   mlir::Location loc = mlir::UnknownLoc::get(builder.getContext());
772   builder.setInsertionPointToEnd(funcOp.addEntryBlock());
773 
774   mlir::Value mask = funcOp.front().getArgument(2);
775 
776   // Set up result array in case of early exit / 0 length array
777   mlir::IndexType idxTy = builder.getIndexType();
778   mlir::Type resultTy = fir::SequenceType::get(rank, resultElemTy);
779   mlir::Type resultHeapTy = fir::HeapType::get(resultTy);
780   mlir::Type resultBoxTy = fir::BoxType::get(resultHeapTy);
781 
782   mlir::Value returnValue = builder.createIntegerConstant(loc, resultElemTy, 0);
783   mlir::Value resultArrSize = builder.createIntegerConstant(loc, idxTy, rank);
784 
785   mlir::Value resultArrInit = builder.create<fir::AllocMemOp>(loc, resultTy);
786   mlir::Value resultArrShape = builder.create<fir::ShapeOp>(loc, resultArrSize);
787   mlir::Value resultArr = builder.create<fir::EmboxOp>(
788       loc, resultBoxTy, resultArrInit, resultArrShape);
789 
790   mlir::Type resultRefTy = builder.getRefType(resultElemTy);
791 
792   for (unsigned int i = 0; i < rank; ++i) {
793     mlir::Value index = builder.createIntegerConstant(loc, idxTy, i);
794     mlir::Value resultElemAddr =
795         builder.create<fir::CoordinateOp>(loc, resultRefTy, resultArr, index);
796     builder.create<fir::StoreOp>(loc, returnValue, resultElemAddr);
797   }
798 
799   auto genBodyOp =
800       [&rank, &resultArr](
801           fir::FirOpBuilder builder, mlir::Location loc, mlir::Type elementType,
802           mlir::Value elem1, mlir::Value elem2,
803           llvm::SmallVector<mlir::Value, Fortran::common::maxRank> indices)
804       -> mlir::Value {
805     mlir::Value cmp;
806     if (elementType.isa<mlir::FloatType>()) {
807       cmp = builder.create<mlir::arith::CmpFOp>(
808           loc, mlir::arith::CmpFPredicate::OLT, elem1, elem2);
809     } else if (elementType.isa<mlir::IntegerType>()) {
810       cmp = builder.create<mlir::arith::CmpIOp>(
811           loc, mlir::arith::CmpIPredicate::slt, elem1, elem2);
812     } else {
813       llvm_unreachable("unsupported type");
814     }
815 
816     fir::IfOp ifOp = builder.create<fir::IfOp>(loc, elementType, cmp,
817                                                /*withElseRegion*/ true);
818 
819     builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
820     mlir::Type resultElemTy = hlfir::getFortranElementType(resultArr.getType());
821     mlir::Type returnRefTy = builder.getRefType(resultElemTy);
822     mlir::IndexType idxTy = builder.getIndexType();
823 
824     mlir::Value one = builder.createIntegerConstant(loc, resultElemTy, 1);
825 
826     for (unsigned int i = 0; i < rank; ++i) {
827       mlir::Value index = builder.createIntegerConstant(loc, idxTy, i);
828       mlir::Value resultElemAddr =
829           builder.create<fir::CoordinateOp>(loc, returnRefTy, resultArr, index);
830       mlir::Value convert =
831           builder.create<fir::ConvertOp>(loc, resultElemTy, indices[i]);
832       mlir::Value fortranIndex =
833           builder.create<mlir::arith::AddIOp>(loc, convert, one);
834       builder.create<fir::StoreOp>(loc, fortranIndex, resultElemAddr);
835     }
836     builder.create<fir::ResultOp>(loc, elem1);
837     builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
838     builder.create<fir::ResultOp>(loc, elem2);
839     builder.setInsertionPointAfter(ifOp);
840     return ifOp.getResult(0);
841   };
842 
843   // if mask is a logical scalar, we can check its value before the main loop
844   // and either ignore the fact it is there or exit early.
845   if (maskRank == 0) {
846     mlir::Type logical = builder.getI1Type();
847     mlir::IndexType idxTy = builder.getIndexType();
848 
849     fir::SequenceType::Shape singleElement(1, 1);
850     mlir::Type arrTy = fir::SequenceType::get(singleElement, logical);
851     mlir::Type boxArrTy = fir::BoxType::get(arrTy);
852     mlir::Value array = builder.create<fir::ConvertOp>(loc, boxArrTy, mask);
853 
854     mlir::Value indx = builder.createIntegerConstant(loc, idxTy, 0);
855     mlir::Type logicalRefTy = builder.getRefType(logical);
856     mlir::Value condAddr =
857         builder.create<fir::CoordinateOp>(loc, logicalRefTy, array, indx);
858     mlir::Value cond = builder.create<fir::LoadOp>(loc, condAddr);
859 
860     fir::IfOp ifOp = builder.create<fir::IfOp>(loc, elementType, cond,
861                                                /*withElseRegion=*/true);
862 
863     builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
864     mlir::Value basicValue;
865     if (elementType.isa<mlir::IntegerType>()) {
866       basicValue = builder.createIntegerConstant(loc, elementType, 0);
867     } else {
868       basicValue = builder.createRealConstant(loc, elementType, 0);
869     }
870     builder.create<fir::ResultOp>(loc, basicValue);
871 
872     builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
873   }
874 
875   // bit of a hack - maskRank is set to -1 for absent mask arg, so don't
876   // generate high level mask or element by element mask.
877   bool hasMask = maskRank > 0;
878 
879   genMinlocReductionLoop(builder, funcOp, init, genBodyOp, rank, elementType,
880                          loc, hasMask, maskElemType, resultArr);
881 }
882 
883 /// Generate function type for the simplified version of RTNAME(DotProduct)
884 /// operating on the given \p elementType.
885 static mlir::FunctionType genRuntimeDotType(fir::FirOpBuilder &builder,
886                                             const mlir::Type &elementType) {
887   mlir::Type boxType = fir::BoxType::get(builder.getNoneType());
888   return mlir::FunctionType::get(builder.getContext(), {boxType, boxType},
889                                  {elementType});
890 }
891 
892 /// Generate function body of the simplified version of RTNAME(DotProduct)
893 /// with signature provided by \p funcOp. The caller is responsible
894 /// for saving/restoring the original insertion point of \p builder.
895 /// \p funcOp is expected to be empty on entry to this function.
896 /// \p arg1ElementTy and \p arg2ElementTy specify elements types
897 /// of the underlying array objects - they are used to generate proper
898 /// element accesses.
899 static void genRuntimeDotBody(fir::FirOpBuilder &builder,
900                               mlir::func::FuncOp &funcOp,
901                               mlir::Type arg1ElementTy,
902                               mlir::Type arg2ElementTy) {
903   // function RTNAME(DotProduct)<T>_simplified(arr1, arr2)
904   //   T, dimension(:) :: arr1, arr2
905   //   T product = 0
906   //   integer iter
907   //   do iter = 0, extent(arr1)
908   //     product = product + arr1[iter] * arr2[iter]
909   //   end do
910   //   RTNAME(ADotProduct)<T>_simplified = product
911   // end function RTNAME(DotProduct)<T>_simplified
912   auto loc = mlir::UnknownLoc::get(builder.getContext());
913   mlir::Type resultElementType = funcOp.getResultTypes()[0];
914   builder.setInsertionPointToEnd(funcOp.addEntryBlock());
915 
916   mlir::IndexType idxTy = builder.getIndexType();
917 
918   mlir::Value zero =
919       resultElementType.isa<mlir::FloatType>()
920           ? builder.createRealConstant(loc, resultElementType, 0.0)
921           : builder.createIntegerConstant(loc, resultElementType, 0);
922 
923   mlir::Block::BlockArgListType args = funcOp.front().getArguments();
924   mlir::Value arg1 = args[0];
925   mlir::Value arg2 = args[1];
926 
927   mlir::Value zeroIdx = builder.createIntegerConstant(loc, idxTy, 0);
928 
929   fir::SequenceType::Shape flatShape = {fir::SequenceType::getUnknownExtent()};
930   mlir::Type arrTy1 = fir::SequenceType::get(flatShape, arg1ElementTy);
931   mlir::Type boxArrTy1 = fir::BoxType::get(arrTy1);
932   mlir::Value array1 = builder.create<fir::ConvertOp>(loc, boxArrTy1, arg1);
933   mlir::Type arrTy2 = fir::SequenceType::get(flatShape, arg2ElementTy);
934   mlir::Type boxArrTy2 = fir::BoxType::get(arrTy2);
935   mlir::Value array2 = builder.create<fir::ConvertOp>(loc, boxArrTy2, arg2);
936   // This version takes the loop trip count from the first argument.
937   // If the first argument's box has unknown (at compilation time)
938   // extent, then it may be better to take the extent from the second
939   // argument - so that after inlining the loop may be better optimized, e.g.
940   // fully unrolled. This requires generating two versions of the simplified
941   // function and some analysis at the call site to choose which version
942   // is more profitable to call.
943   // Note that we can assume that both arguments have the same extent.
944   auto dims =
945       builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, array1, zeroIdx);
946   mlir::Value len = dims.getResult(1);
947   mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
948   mlir::Value step = one;
949 
950   // We use C indexing here, so len-1 as loopcount
951   mlir::Value loopCount = builder.create<mlir::arith::SubIOp>(loc, len, one);
952   auto loop = builder.create<fir::DoLoopOp>(loc, zeroIdx, loopCount, step,
953                                             /*unordered=*/false,
954                                             /*finalCountValue=*/false, zero);
955   mlir::Value sumVal = loop.getRegionIterArgs()[0];
956 
957   // Begin loop code
958   mlir::OpBuilder::InsertPoint loopEndPt = builder.saveInsertionPoint();
959   builder.setInsertionPointToStart(loop.getBody());
960 
961   mlir::Type eleRef1Ty = builder.getRefType(arg1ElementTy);
962   mlir::Value index = loop.getInductionVar();
963   mlir::Value addr1 =
964       builder.create<fir::CoordinateOp>(loc, eleRef1Ty, array1, index);
965   mlir::Value elem1 = builder.create<fir::LoadOp>(loc, addr1);
966   // Convert to the result type.
967   elem1 = builder.create<fir::ConvertOp>(loc, resultElementType, elem1);
968 
969   mlir::Type eleRef2Ty = builder.getRefType(arg2ElementTy);
970   mlir::Value addr2 =
971       builder.create<fir::CoordinateOp>(loc, eleRef2Ty, array2, index);
972   mlir::Value elem2 = builder.create<fir::LoadOp>(loc, addr2);
973   // Convert to the result type.
974   elem2 = builder.create<fir::ConvertOp>(loc, resultElementType, elem2);
975 
976   if (resultElementType.isa<mlir::FloatType>())
977     sumVal = builder.create<mlir::arith::AddFOp>(
978         loc, builder.create<mlir::arith::MulFOp>(loc, elem1, elem2), sumVal);
979   else if (resultElementType.isa<mlir::IntegerType>())
980     sumVal = builder.create<mlir::arith::AddIOp>(
981         loc, builder.create<mlir::arith::MulIOp>(loc, elem1, elem2), sumVal);
982   else
983     llvm_unreachable("unsupported type");
984 
985   builder.create<fir::ResultOp>(loc, sumVal);
986   // End of loop.
987   builder.restoreInsertionPoint(loopEndPt);
988 
989   mlir::Value resultVal = loop.getResult(0);
990   builder.create<mlir::func::ReturnOp>(loc, resultVal);
991 }
992 
993 mlir::func::FuncOp SimplifyIntrinsicsPass::getOrCreateFunction(
994     fir::FirOpBuilder &builder, const mlir::StringRef &baseName,
995     FunctionTypeGeneratorTy typeGenerator,
996     FunctionBodyGeneratorTy bodyGenerator) {
997   // WARNING: if the function generated here changes its signature
998   //          or behavior (the body code), we should probably embed some
999   //          versioning information into its name, otherwise libraries
1000   //          statically linked with older versions of Flang may stop
1001   //          working with object files created with newer Flang.
1002   //          We can also avoid this by using internal linkage, but
1003   //          this may increase the size of final executable/shared library.
1004   std::string replacementName = mlir::Twine{baseName, "_simplified"}.str();
1005   mlir::ModuleOp module = builder.getModule();
1006   // If we already have a function, just return it.
1007   mlir::func::FuncOp newFunc =
1008       fir::FirOpBuilder::getNamedFunction(module, replacementName);
1009   mlir::FunctionType fType = typeGenerator(builder);
1010   if (newFunc) {
1011     assert(newFunc.getFunctionType() == fType &&
1012            "type mismatch for simplified function");
1013     return newFunc;
1014   }
1015 
1016   // Need to build the function!
1017   auto loc = mlir::UnknownLoc::get(builder.getContext());
1018   newFunc =
1019       fir::FirOpBuilder::createFunction(loc, module, replacementName, fType);
1020   auto inlineLinkage = mlir::LLVM::linkage::Linkage::LinkonceODR;
1021   auto linkage =
1022       mlir::LLVM::LinkageAttr::get(builder.getContext(), inlineLinkage);
1023   newFunc->setAttr("llvm.linkage", linkage);
1024 
1025   // Save the position of the original call.
1026   mlir::OpBuilder::InsertPoint insertPt = builder.saveInsertionPoint();
1027 
1028   bodyGenerator(builder, newFunc);
1029 
1030   // Now back to where we were adding code earlier...
1031   builder.restoreInsertionPoint(insertPt);
1032 
1033   return newFunc;
1034 }
1035 
1036 void SimplifyIntrinsicsPass::simplifyIntOrFloatReduction(
1037     fir::CallOp call, const fir::KindMapping &kindMap,
1038     GenReductionBodyTy genBodyFunc) {
1039   // args[1] and args[2] are source filename and line number, ignored.
1040   mlir::Operation::operand_range args = call.getArgs();
1041 
1042   const mlir::Value &dim = args[3];
1043   const mlir::Value &mask = args[4];
1044   // dim is zero when it is absent, which is an implementation
1045   // detail in the runtime library.
1046 
1047   bool dimAndMaskAbsent = isZero(dim) && isOperandAbsent(mask);
1048   unsigned rank = getDimCount(args[0]);
1049 
1050   // Rank is set to 0 for assumed shape arrays, don't simplify
1051   // in these cases
1052   if (!(dimAndMaskAbsent && rank > 0))
1053     return;
1054 
1055   mlir::Type resultType = call.getResult(0).getType();
1056 
1057   if (!resultType.isa<mlir::FloatType>() &&
1058       !resultType.isa<mlir::IntegerType>())
1059     return;
1060 
1061   auto argType = getArgElementType(args[0]);
1062   if (!argType)
1063     return;
1064   assert(*argType == resultType &&
1065          "Argument/result types mismatch in reduction");
1066 
1067   mlir::SymbolRefAttr callee = call.getCalleeAttr();
1068 
1069   fir::FirOpBuilder builder{getSimplificationBuilder(call, kindMap)};
1070   std::string fmfString{builder.getFastMathFlagsString()};
1071   std::string funcName =
1072       (mlir::Twine{callee.getLeafReference().getValue(), "x"} +
1073        mlir::Twine{rank} +
1074        // We must mangle the generated function name with FastMathFlags
1075        // value.
1076        (fmfString.empty() ? mlir::Twine{} : mlir::Twine{"_", fmfString}))
1077           .str();
1078 
1079   simplifyReductionBody(call, kindMap, genBodyFunc, builder, funcName,
1080                         resultType);
1081 }
1082 
1083 void SimplifyIntrinsicsPass::simplifyLogicalDim0Reduction(
1084     fir::CallOp call, const fir::KindMapping &kindMap,
1085     GenReductionBodyTy genBodyFunc) {
1086 
1087   mlir::Operation::operand_range args = call.getArgs();
1088   const mlir::Value &dim = args[3];
1089   unsigned rank = getDimCount(args[0]);
1090 
1091   // getDimCount returns a rank of 0 for assumed shape arrays, don't simplify in
1092   // these cases.
1093   if (!(isZero(dim) && rank > 0))
1094     return;
1095 
1096   mlir::Value inputBox = findBoxDef(args[0]);
1097 
1098   mlir::Type elementType = hlfir::getFortranElementType(inputBox.getType());
1099   mlir::SymbolRefAttr callee = call.getCalleeAttr();
1100 
1101   fir::FirOpBuilder builder{getSimplificationBuilder(call, kindMap)};
1102 
1103   // Treating logicals as integers makes things a lot easier
1104   fir::LogicalType logicalType = {elementType.dyn_cast<fir::LogicalType>()};
1105   fir::KindTy kind = logicalType.getFKind();
1106   mlir::Type intElementType = builder.getIntegerType(kind * 8);
1107 
1108   // Mangle kind into function name as it is not done by default
1109   std::string funcName =
1110       (mlir::Twine{callee.getLeafReference().getValue(), "Logical"} +
1111        mlir::Twine{kind} + "x" + mlir::Twine{rank})
1112           .str();
1113 
1114   simplifyReductionBody(call, kindMap, genBodyFunc, builder, funcName,
1115                         intElementType);
1116 }
1117 
1118 void SimplifyIntrinsicsPass::simplifyLogicalDim1Reduction(
1119     fir::CallOp call, const fir::KindMapping &kindMap,
1120     GenReductionBodyTy genBodyFunc) {
1121 
1122   mlir::Operation::operand_range args = call.getArgs();
1123   mlir::SymbolRefAttr callee = call.getCalleeAttr();
1124   mlir::StringRef funcNameBase = callee.getLeafReference().getValue();
1125   unsigned rank = getDimCount(args[0]);
1126 
1127   // getDimCount returns a rank of 0 for assumed shape arrays, don't simplify in
1128   // these cases. We check for Dim at the end as some logical functions (Any,
1129   // All) set dim to 1 instead of 0 when the argument is not present.
1130   if (funcNameBase.ends_with("Dim") || !(rank > 0))
1131     return;
1132 
1133   mlir::Value inputBox = findBoxDef(args[0]);
1134   mlir::Type elementType = hlfir::getFortranElementType(inputBox.getType());
1135 
1136   fir::FirOpBuilder builder{getSimplificationBuilder(call, kindMap)};
1137 
1138   // Treating logicals as integers makes things a lot easier
1139   fir::LogicalType logicalType = {elementType.dyn_cast<fir::LogicalType>()};
1140   fir::KindTy kind = logicalType.getFKind();
1141   mlir::Type intElementType = builder.getIntegerType(kind * 8);
1142 
1143   // Mangle kind into function name as it is not done by default
1144   std::string funcName =
1145       (mlir::Twine{callee.getLeafReference().getValue(), "Logical"} +
1146        mlir::Twine{kind} + "x" + mlir::Twine{rank})
1147           .str();
1148 
1149   simplifyReductionBody(call, kindMap, genBodyFunc, builder, funcName,
1150                         intElementType);
1151 }
1152 
1153 void SimplifyIntrinsicsPass::simplifyMinlocReduction(
1154     fir::CallOp call, const fir::KindMapping &kindMap) {
1155 
1156   mlir::Operation::operand_range args = call.getArgs();
1157 
1158   mlir::Value back = args[6];
1159   if (isTrueOrNotConstant(back))
1160     return;
1161 
1162   mlir::Value mask = args[5];
1163   mlir::Value maskDef = findMaskDef(mask);
1164 
1165   // maskDef is set to NULL when the defining op is not one we accept.
1166   // This tends to be because it is a selectOp, in which case let the
1167   // runtime deal with it.
1168   if (maskDef == NULL)
1169     return;
1170 
1171   mlir::SymbolRefAttr callee = call.getCalleeAttr();
1172   mlir::StringRef funcNameBase = callee.getLeafReference().getValue();
1173   unsigned rank = getDimCount(args[1]);
1174   if (funcNameBase.ends_with("Dim") || !(rank > 0))
1175     return;
1176 
1177   fir::FirOpBuilder builder{getSimplificationBuilder(call, kindMap)};
1178   mlir::Location loc = call.getLoc();
1179   auto inputBox = findBoxDef(args[1]);
1180   mlir::Type inputType = hlfir::getFortranElementType(inputBox.getType());
1181 
1182   if (inputType.isa<fir::CharacterType>())
1183     return;
1184 
1185   int maskRank;
1186   fir::KindTy kind = 0;
1187   mlir::Type logicalElemType = builder.getI1Type();
1188   if (isOperandAbsent(mask)) {
1189     maskRank = -1;
1190   } else {
1191     maskRank = getDimCount(mask);
1192     mlir::Type maskElemTy = hlfir::getFortranElementType(maskDef.getType());
1193     fir::LogicalType logicalFirType = {maskElemTy.dyn_cast<fir::LogicalType>()};
1194     kind = logicalFirType.getFKind();
1195     // Convert fir::LogicalType to mlir::Type
1196     logicalElemType = logicalFirType;
1197   }
1198 
1199   mlir::Operation *outputDef = args[0].getDefiningOp();
1200   mlir::Value outputAlloc = outputDef->getOperand(0);
1201   mlir::Type outType = hlfir::getFortranElementType(outputAlloc.getType());
1202 
1203   std::string fmfString{builder.getFastMathFlagsString()};
1204   std::string funcName =
1205       (mlir::Twine{callee.getLeafReference().getValue(), "x"} +
1206        mlir::Twine{rank} +
1207        (maskRank >= 0
1208             ? "_Logical" + mlir::Twine{kind} + "x" + mlir::Twine{maskRank}
1209             : "") +
1210        "_")
1211           .str();
1212 
1213   llvm::raw_string_ostream nameOS(funcName);
1214   outType.print(nameOS);
1215   nameOS << '_' << fmfString;
1216 
1217   auto typeGenerator = [rank](fir::FirOpBuilder &builder) {
1218     return genRuntimeMinlocType(builder, rank);
1219   };
1220   auto bodyGenerator = [rank, maskRank, inputType, logicalElemType,
1221                         outType](fir::FirOpBuilder &builder,
1222                                  mlir::func::FuncOp &funcOp) {
1223     genRuntimeMinlocBody(builder, funcOp, rank, maskRank, inputType,
1224                          logicalElemType, outType);
1225   };
1226 
1227   mlir::func::FuncOp newFunc =
1228       getOrCreateFunction(builder, funcName, typeGenerator, bodyGenerator);
1229   builder.create<fir::CallOp>(loc, newFunc,
1230                               mlir::ValueRange{args[0], args[1], args[5]});
1231   call->dropAllReferences();
1232   call->erase();
1233 }
1234 
1235 void SimplifyIntrinsicsPass::simplifyReductionBody(
1236     fir::CallOp call, const fir::KindMapping &kindMap,
1237     GenReductionBodyTy genBodyFunc, fir::FirOpBuilder &builder,
1238     const mlir::StringRef &funcName, mlir::Type elementType) {
1239 
1240   mlir::Operation::operand_range args = call.getArgs();
1241 
1242   mlir::Type resultType = call.getResult(0).getType();
1243   unsigned rank = getDimCount(args[0]);
1244 
1245   mlir::Location loc = call.getLoc();
1246 
1247   auto typeGenerator = [&resultType](fir::FirOpBuilder &builder) {
1248     return genNoneBoxType(builder, resultType);
1249   };
1250   auto bodyGenerator = [&rank, &genBodyFunc,
1251                         &elementType](fir::FirOpBuilder &builder,
1252                                       mlir::func::FuncOp &funcOp) {
1253     genBodyFunc(builder, funcOp, rank, elementType);
1254   };
1255   // Mangle the function name with the rank value as "x<rank>".
1256   mlir::func::FuncOp newFunc =
1257       getOrCreateFunction(builder, funcName, typeGenerator, bodyGenerator);
1258   auto newCall =
1259       builder.create<fir::CallOp>(loc, newFunc, mlir::ValueRange{args[0]});
1260   call->replaceAllUsesWith(newCall.getResults());
1261   call->dropAllReferences();
1262   call->erase();
1263 }
1264 
1265 void SimplifyIntrinsicsPass::runOnOperation() {
1266   LLVM_DEBUG(llvm::dbgs() << "=== Begin " DEBUG_TYPE " ===\n");
1267   mlir::ModuleOp module = getOperation();
1268   fir::KindMapping kindMap = fir::getKindMapping(module);
1269   module.walk([&](mlir::Operation *op) {
1270     if (auto call = mlir::dyn_cast<fir::CallOp>(op)) {
1271       if (mlir::SymbolRefAttr callee = call.getCalleeAttr()) {
1272         mlir::StringRef funcName = callee.getLeafReference().getValue();
1273         // Replace call to runtime function for SUM when it has single
1274         // argument (no dim or mask argument) for 1D arrays with either
1275         // Integer4 or Real8 types. Other forms are ignored.
1276         // The new function is added to the module.
1277         //
1278         // Prototype for runtime call (from sum.cpp):
1279         // RTNAME(Sum<T>)(const Descriptor &x, const char *source, int line,
1280         //                int dim, const Descriptor *mask)
1281         //
1282         if (funcName.startswith(RTNAME_STRING(Sum))) {
1283           simplifyIntOrFloatReduction(call, kindMap, genRuntimeSumBody);
1284           return;
1285         }
1286         if (funcName.startswith(RTNAME_STRING(DotProduct))) {
1287           LLVM_DEBUG(llvm::dbgs() << "Handling " << funcName << "\n");
1288           LLVM_DEBUG(llvm::dbgs() << "Call operation:\n"; op->dump();
1289                      llvm::dbgs() << "\n");
1290           mlir::Operation::operand_range args = call.getArgs();
1291           const mlir::Value &v1 = args[0];
1292           const mlir::Value &v2 = args[1];
1293           mlir::Location loc = call.getLoc();
1294           fir::FirOpBuilder builder{getSimplificationBuilder(op, kindMap)};
1295           // Stringize the builder's FastMathFlags flags for mangling
1296           // the generated function name.
1297           std::string fmfString{builder.getFastMathFlagsString()};
1298 
1299           mlir::Type type = call.getResult(0).getType();
1300           if (!type.isa<mlir::FloatType>() && !type.isa<mlir::IntegerType>())
1301             return;
1302 
1303           // Try to find the element types of the boxed arguments.
1304           auto arg1Type = getArgElementType(v1);
1305           auto arg2Type = getArgElementType(v2);
1306 
1307           if (!arg1Type || !arg2Type)
1308             return;
1309 
1310           // Support only floating point and integer arguments
1311           // now (e.g. logical is skipped here).
1312           if (!arg1Type->isa<mlir::FloatType>() &&
1313               !arg1Type->isa<mlir::IntegerType>())
1314             return;
1315           if (!arg2Type->isa<mlir::FloatType>() &&
1316               !arg2Type->isa<mlir::IntegerType>())
1317             return;
1318 
1319           auto typeGenerator = [&type](fir::FirOpBuilder &builder) {
1320             return genRuntimeDotType(builder, type);
1321           };
1322           auto bodyGenerator = [&arg1Type,
1323                                 &arg2Type](fir::FirOpBuilder &builder,
1324                                            mlir::func::FuncOp &funcOp) {
1325             genRuntimeDotBody(builder, funcOp, *arg1Type, *arg2Type);
1326           };
1327 
1328           // Suffix the function name with the element types
1329           // of the arguments.
1330           std::string typedFuncName(funcName);
1331           llvm::raw_string_ostream nameOS(typedFuncName);
1332           // We must mangle the generated function name with FastMathFlags
1333           // value.
1334           if (!fmfString.empty())
1335             nameOS << '_' << fmfString;
1336           nameOS << '_';
1337           arg1Type->print(nameOS);
1338           nameOS << '_';
1339           arg2Type->print(nameOS);
1340 
1341           mlir::func::FuncOp newFunc = getOrCreateFunction(
1342               builder, typedFuncName, typeGenerator, bodyGenerator);
1343           auto newCall = builder.create<fir::CallOp>(loc, newFunc,
1344                                                      mlir::ValueRange{v1, v2});
1345           call->replaceAllUsesWith(newCall.getResults());
1346           call->dropAllReferences();
1347           call->erase();
1348 
1349           LLVM_DEBUG(llvm::dbgs() << "Replaced with:\n"; newCall.dump();
1350                      llvm::dbgs() << "\n");
1351           return;
1352         }
1353         if (funcName.startswith(RTNAME_STRING(Maxval))) {
1354           simplifyIntOrFloatReduction(call, kindMap, genRuntimeMaxvalBody);
1355           return;
1356         }
1357         if (funcName.startswith(RTNAME_STRING(Count))) {
1358           simplifyLogicalDim0Reduction(call, kindMap, genRuntimeCountBody);
1359           return;
1360         }
1361         if (funcName.startswith(RTNAME_STRING(Any))) {
1362           simplifyLogicalDim1Reduction(call, kindMap, genRuntimeAnyBody);
1363           return;
1364         }
1365         if (funcName.endswith(RTNAME_STRING(All))) {
1366           simplifyLogicalDim1Reduction(call, kindMap, genRuntimeAllBody);
1367           return;
1368         }
1369         if (funcName.startswith(RTNAME_STRING(Minloc))) {
1370           simplifyMinlocReduction(call, kindMap);
1371           return;
1372         }
1373       }
1374     }
1375   });
1376   LLVM_DEBUG(llvm::dbgs() << "=== End " DEBUG_TYPE " ===\n");
1377 }
1378 
1379 void SimplifyIntrinsicsPass::getDependentDialects(
1380     mlir::DialectRegistry &registry) const {
1381   // LLVM::LinkageAttr creation requires that LLVM dialect is loaded.
1382   registry.insert<mlir::LLVM::LLVMDialect>();
1383 }
1384 std::unique_ptr<mlir::Pass> fir::createSimplifyIntrinsicsPass() {
1385   return std::make_unique<SimplifyIntrinsicsPass>();
1386 }
1387