1 //===-- IntrinsicCall.cpp -------------------------------------------------===//
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 // Helper routines for constructing the FIR dialect of MLIR. As FIR is a
10 // dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding
11 // style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this
12 // module.
13 //
14 //===----------------------------------------------------------------------===//
15 
16 #include "flang/Lower/IntrinsicCall.h"
17 #include "flang/Common/static-multimap-view.h"
18 #include "flang/Lower/Mangler.h"
19 #include "flang/Lower/Runtime.h"
20 #include "flang/Lower/StatementContext.h"
21 #include "flang/Lower/SymbolMap.h"
22 #include "flang/Optimizer/Builder/Character.h"
23 #include "flang/Optimizer/Builder/Complex.h"
24 #include "flang/Optimizer/Builder/FIRBuilder.h"
25 #include "flang/Optimizer/Builder/MutableBox.h"
26 #include "flang/Optimizer/Builder/Runtime/Character.h"
27 #include "flang/Optimizer/Builder/Runtime/Command.h"
28 #include "flang/Optimizer/Builder/Runtime/Inquiry.h"
29 #include "flang/Optimizer/Builder/Runtime/Numeric.h"
30 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
31 #include "flang/Optimizer/Builder/Runtime/Reduction.h"
32 #include "flang/Optimizer/Builder/Runtime/Stop.h"
33 #include "flang/Optimizer/Builder/Runtime/Transformational.h"
34 #include "flang/Optimizer/Builder/Todo.h"
35 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
36 #include "flang/Optimizer/Support/FatalError.h"
37 #include "mlir/Dialect/LLVMIR/LLVMDialect.h"
38 #include "mlir/Dialect/Math/IR/Math.h"
39 #include "llvm/Support/CommandLine.h"
40 #include "llvm/Support/Debug.h"
41 
42 #define DEBUG_TYPE "flang-lower-intrinsic"
43 
44 #define PGMATH_DECLARE
45 #include "flang/Evaluate/pgmath.h.inc"
46 
47 /// This file implements lowering of Fortran intrinsic procedures and Fortran
48 /// intrinsic module procedures.  A call may be inlined with a mix of FIR and
49 /// MLIR operations, or as a call to a runtime function or LLVM intrinsic.
50 
51 /// Lowering of intrinsic procedure calls is based on a map that associates
52 /// Fortran intrinsic generic names to FIR generator functions.
53 /// All generator functions are member functions of the IntrinsicLibrary class
54 /// and have the same interface.
55 /// If no generator is given for an intrinsic name, a math runtime library
56 /// is searched for an implementation and, if a runtime function is found,
57 /// a call is generated for it. LLVM intrinsics are handled as a math
58 /// runtime library here.
59 
60 /// Enums used to templatize and share lowering of MIN and MAX.
61 enum class Extremum { Min, Max };
62 
63 // There are different ways to deal with NaNs in MIN and MAX.
64 // Known existing behaviors are listed below and can be selected for
65 // f18 MIN/MAX implementation.
66 enum class ExtremumBehavior {
67   // Note: the Signaling/quiet aspect of NaNs in the behaviors below are
68   // not described because there is no way to control/observe such aspect in
69   // MLIR/LLVM yet. The IEEE behaviors come with requirements regarding this
70   // aspect that are therefore currently not enforced. In the descriptions
71   // below, NaNs can be signaling or quite. Returned NaNs may be signaling
72   // if one of the input NaN was signaling but it cannot be guaranteed either.
73   // Existing compilers using an IEEE behavior (gfortran) also do not fulfill
74   // signaling/quiet requirements.
75   IeeeMinMaximumNumber,
76   // IEEE minimumNumber/maximumNumber behavior (754-2019, section 9.6):
77   // If one of the argument is and number and the other is NaN, return the
78   // number. If both arguements are NaN, return NaN.
79   // Compilers: gfortran.
80   IeeeMinMaximum,
81   // IEEE minimum/maximum behavior (754-2019, section 9.6):
82   // If one of the argument is NaN, return NaN.
83   MinMaxss,
84   // x86 minss/maxss behavior:
85   // If the second argument is a number and the other is NaN, return the number.
86   // In all other cases where at least one operand is NaN, return NaN.
87   // Compilers: xlf (only for MAX), ifort, pgfortran -nollvm, and nagfor.
88   PgfortranLlvm,
89   // "Opposite of" x86 minss/maxss behavior:
90   // If the first argument is a number and the other is NaN, return the
91   // number.
92   // In all other cases where at least one operand is NaN, return NaN.
93   // Compilers: xlf (only for MIN), and pgfortran (with llvm).
94   IeeeMinMaxNum
95   // IEEE minNum/maxNum behavior (754-2008, section 5.3.1):
96   // TODO: Not implemented.
97   // It is the only behavior where the signaling/quiet aspect of a NaN argument
98   // impacts if the result should be NaN or the argument that is a number.
99   // LLVM/MLIR do not provide ways to observe this aspect, so it is not
100   // possible to implement it without some target dependent runtime.
101 };
102 
103 fir::ExtendedValue Fortran::lower::getAbsentIntrinsicArgument() {
104   return fir::UnboxedValue{};
105 }
106 
107 /// Test if an ExtendedValue is absent. This is used to test if an intrinsic
108 /// argument are absent at compile time.
109 static bool isStaticallyAbsent(const fir::ExtendedValue &exv) {
110   return !fir::getBase(exv);
111 }
112 static bool isStaticallyAbsent(llvm::ArrayRef<fir::ExtendedValue> args,
113                                size_t argIndex) {
114   return args.size() <= argIndex || isStaticallyAbsent(args[argIndex]);
115 }
116 static bool isStaticallyAbsent(llvm::ArrayRef<mlir::Value> args,
117                                size_t argIndex) {
118   return args.size() <= argIndex || !args[argIndex];
119 }
120 
121 /// Test if an ExtendedValue is present. This is used to test if an intrinsic
122 /// argument is present at compile time. This does not imply that the related
123 /// value may not be an absent dummy optional, disassociated pointer, or a
124 /// deallocated allocatable. See `handleDynamicOptional` to deal with these
125 /// cases when it makes sense.
126 static bool isStaticallyPresent(const fir::ExtendedValue &exv) {
127   return !isStaticallyAbsent(exv);
128 }
129 
130 /// Process calls to Maxval, Minval, Product, Sum intrinsic functions that
131 /// take a DIM argument.
132 template <typename FD>
133 static fir::ExtendedValue
134 genFuncDim(FD funcDim, mlir::Type resultType, fir::FirOpBuilder &builder,
135            mlir::Location loc, Fortran::lower::StatementContext *stmtCtx,
136            llvm::StringRef errMsg, mlir::Value array, fir::ExtendedValue dimArg,
137            mlir::Value mask, int rank) {
138 
139   // Create mutable fir.box to be passed to the runtime for the result.
140   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
141   fir::MutableBoxValue resultMutableBox =
142       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
143   mlir::Value resultIrBox =
144       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
145 
146   mlir::Value dim =
147       isStaticallyAbsent(dimArg)
148           ? builder.createIntegerConstant(loc, builder.getIndexType(), 0)
149           : fir::getBase(dimArg);
150   funcDim(builder, loc, resultIrBox, array, dim, mask);
151 
152   fir::ExtendedValue res =
153       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
154   return res.match(
155       [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
156         // Add cleanup code
157         assert(stmtCtx);
158         fir::FirOpBuilder *bldr = &builder;
159         mlir::Value temp = box.getAddr();
160         stmtCtx->attachCleanup(
161             [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
162         return box;
163       },
164       [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue {
165         // Add cleanup code
166         assert(stmtCtx);
167         fir::FirOpBuilder *bldr = &builder;
168         mlir::Value temp = box.getAddr();
169         stmtCtx->attachCleanup(
170             [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
171         return box;
172       },
173       [&](const auto &) -> fir::ExtendedValue {
174         fir::emitFatalError(loc, errMsg);
175       });
176 }
177 
178 /// Process calls to Product, Sum intrinsic functions
179 template <typename FN, typename FD>
180 static fir::ExtendedValue
181 genProdOrSum(FN func, FD funcDim, mlir::Type resultType,
182              fir::FirOpBuilder &builder, mlir::Location loc,
183              Fortran::lower::StatementContext *stmtCtx, llvm::StringRef errMsg,
184              llvm::ArrayRef<fir::ExtendedValue> args) {
185 
186   assert(args.size() == 3);
187 
188   // Handle required array argument
189   fir::BoxValue arryTmp = builder.createBox(loc, args[0]);
190   mlir::Value array = fir::getBase(arryTmp);
191   int rank = arryTmp.rank();
192   assert(rank >= 1);
193 
194   // Handle optional mask argument
195   auto mask = isStaticallyAbsent(args[2])
196                   ? builder.create<fir::AbsentOp>(
197                         loc, fir::BoxType::get(builder.getI1Type()))
198                   : builder.createBox(loc, args[2]);
199 
200   bool absentDim = isStaticallyAbsent(args[1]);
201 
202   // We call the type specific versions because the result is scalar
203   // in the case below.
204   if (absentDim || rank == 1) {
205     mlir::Type ty = array.getType();
206     mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
207     auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
208     if (fir::isa_complex(eleTy)) {
209       mlir::Value result = builder.createTemporary(loc, eleTy);
210       func(builder, loc, array, mask, result);
211       return builder.create<fir::LoadOp>(loc, result);
212     }
213     auto resultBox = builder.create<fir::AbsentOp>(
214         loc, fir::BoxType::get(builder.getI1Type()));
215     return func(builder, loc, array, mask, resultBox);
216   }
217   // Handle Product/Sum cases that have an array result.
218   return genFuncDim(funcDim, resultType, builder, loc, stmtCtx, errMsg, array,
219                     args[1], mask, rank);
220 }
221 
222 /// Process calls to DotProduct
223 template <typename FN>
224 static fir::ExtendedValue
225 genDotProd(FN func, mlir::Type resultType, fir::FirOpBuilder &builder,
226            mlir::Location loc, Fortran::lower::StatementContext *stmtCtx,
227            llvm::ArrayRef<fir::ExtendedValue> args) {
228 
229   assert(args.size() == 2);
230 
231   // Handle required vector arguments
232   mlir::Value vectorA = fir::getBase(args[0]);
233   mlir::Value vectorB = fir::getBase(args[1]);
234 
235   mlir::Type eleTy = fir::dyn_cast_ptrOrBoxEleTy(vectorA.getType())
236                          .cast<fir::SequenceType>()
237                          .getEleTy();
238   if (fir::isa_complex(eleTy)) {
239     mlir::Value result = builder.createTemporary(loc, eleTy);
240     func(builder, loc, vectorA, vectorB, result);
241     return builder.create<fir::LoadOp>(loc, result);
242   }
243 
244   auto resultBox = builder.create<fir::AbsentOp>(
245       loc, fir::BoxType::get(builder.getI1Type()));
246   return func(builder, loc, vectorA, vectorB, resultBox);
247 }
248 
249 /// Process calls to Maxval, Minval, Product, Sum intrinsic functions
250 template <typename FN, typename FD, typename FC>
251 static fir::ExtendedValue
252 genExtremumVal(FN func, FD funcDim, FC funcChar, mlir::Type resultType,
253                fir::FirOpBuilder &builder, mlir::Location loc,
254                Fortran::lower::StatementContext *stmtCtx,
255                llvm::StringRef errMsg,
256                llvm::ArrayRef<fir::ExtendedValue> args) {
257 
258   assert(args.size() == 3);
259 
260   // Handle required array argument
261   fir::BoxValue arryTmp = builder.createBox(loc, args[0]);
262   mlir::Value array = fir::getBase(arryTmp);
263   int rank = arryTmp.rank();
264   assert(rank >= 1);
265   bool hasCharacterResult = arryTmp.isCharacter();
266 
267   // Handle optional mask argument
268   auto mask = isStaticallyAbsent(args[2])
269                   ? builder.create<fir::AbsentOp>(
270                         loc, fir::BoxType::get(builder.getI1Type()))
271                   : builder.createBox(loc, args[2]);
272 
273   bool absentDim = isStaticallyAbsent(args[1]);
274 
275   // For Maxval/MinVal, we call the type specific versions of
276   // Maxval/Minval because the result is scalar in the case below.
277   if (!hasCharacterResult && (absentDim || rank == 1))
278     return func(builder, loc, array, mask);
279 
280   if (hasCharacterResult && (absentDim || rank == 1)) {
281     // Create mutable fir.box to be passed to the runtime for the result.
282     fir::MutableBoxValue resultMutableBox =
283         fir::factory::createTempMutableBox(builder, loc, resultType);
284     mlir::Value resultIrBox =
285         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
286 
287     funcChar(builder, loc, resultIrBox, array, mask);
288 
289     // Handle cleanup of allocatable result descriptor and return
290     fir::ExtendedValue res =
291         fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
292     return res.match(
293         [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
294           // Add cleanup code
295           assert(stmtCtx);
296           fir::FirOpBuilder *bldr = &builder;
297           mlir::Value temp = box.getAddr();
298           stmtCtx->attachCleanup(
299               [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
300           return box;
301         },
302         [&](const auto &) -> fir::ExtendedValue {
303           fir::emitFatalError(loc, errMsg);
304         });
305   }
306 
307   // Handle Min/Maxval cases that have an array result.
308   return genFuncDim(funcDim, resultType, builder, loc, stmtCtx, errMsg, array,
309                     args[1], mask, rank);
310 }
311 
312 /// Process calls to Minloc, Maxloc intrinsic functions
313 template <typename FN, typename FD>
314 static fir::ExtendedValue genExtremumloc(
315     FN func, FD funcDim, mlir::Type resultType, fir::FirOpBuilder &builder,
316     mlir::Location loc, Fortran::lower::StatementContext *stmtCtx,
317     llvm::StringRef errMsg, llvm::ArrayRef<fir::ExtendedValue> args) {
318 
319   assert(args.size() == 5);
320 
321   // Handle required array argument
322   mlir::Value array = builder.createBox(loc, args[0]);
323   unsigned rank = fir::BoxValue(array).rank();
324   assert(rank >= 1);
325 
326   // Handle optional mask argument
327   auto mask = isStaticallyAbsent(args[2])
328                   ? builder.create<fir::AbsentOp>(
329                         loc, fir::BoxType::get(builder.getI1Type()))
330                   : builder.createBox(loc, args[2]);
331 
332   // Handle optional kind argument
333   auto kind = isStaticallyAbsent(args[3])
334                   ? builder.createIntegerConstant(
335                         loc, builder.getIndexType(),
336                         builder.getKindMap().defaultIntegerKind())
337                   : fir::getBase(args[3]);
338 
339   // Handle optional back argument
340   auto back = isStaticallyAbsent(args[4]) ? builder.createBool(loc, false)
341                                           : fir::getBase(args[4]);
342 
343   bool absentDim = isStaticallyAbsent(args[1]);
344 
345   if (!absentDim && rank == 1) {
346     // If dim argument is present and the array is rank 1, then the result is
347     // a scalar (since the the result is rank-1 or 0).
348     // Therefore, we use a scalar result descriptor with Min/MaxlocDim().
349     mlir::Value dim = fir::getBase(args[1]);
350     // Create mutable fir.box to be passed to the runtime for the result.
351     fir::MutableBoxValue resultMutableBox =
352         fir::factory::createTempMutableBox(builder, loc, resultType);
353     mlir::Value resultIrBox =
354         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
355 
356     funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back);
357 
358     // Handle cleanup of allocatable result descriptor and return
359     fir::ExtendedValue res =
360         fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
361     return res.match(
362         [&](const mlir::Value &tempAddr) -> fir::ExtendedValue {
363           // Add cleanup code
364           assert(stmtCtx);
365           fir::FirOpBuilder *bldr = &builder;
366           stmtCtx->attachCleanup(
367               [=]() { bldr->create<fir::FreeMemOp>(loc, tempAddr); });
368           return builder.create<fir::LoadOp>(loc, resultType, tempAddr);
369         },
370         [&](const auto &) -> fir::ExtendedValue {
371           fir::emitFatalError(loc, errMsg);
372         });
373   }
374 
375   // Note: The Min/Maxloc/val cases below have an array result.
376 
377   // Create mutable fir.box to be passed to the runtime for the result.
378   mlir::Type resultArrayType =
379       builder.getVarLenSeqTy(resultType, absentDim ? 1 : rank - 1);
380   fir::MutableBoxValue resultMutableBox =
381       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
382   mlir::Value resultIrBox =
383       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
384 
385   if (absentDim) {
386     // Handle min/maxloc/val case where there is no dim argument
387     // (calls Min/Maxloc()/MinMaxval() runtime routine)
388     func(builder, loc, resultIrBox, array, mask, kind, back);
389   } else {
390     // else handle min/maxloc case with dim argument (calls
391     // Min/Max/loc/val/Dim() runtime routine).
392     mlir::Value dim = fir::getBase(args[1]);
393     funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back);
394   }
395 
396   return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
397       .match(
398           [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
399             // Add cleanup code
400             assert(stmtCtx);
401             fir::FirOpBuilder *bldr = &builder;
402             mlir::Value temp = box.getAddr();
403             stmtCtx->attachCleanup(
404                 [=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
405             return box;
406           },
407           [&](const auto &) -> fir::ExtendedValue {
408             fir::emitFatalError(loc, errMsg);
409           });
410 }
411 
412 // TODO error handling -> return a code or directly emit messages ?
413 struct IntrinsicLibrary {
414 
415   // Constructors.
416   explicit IntrinsicLibrary(fir::FirOpBuilder &builder, mlir::Location loc,
417                             Fortran::lower::StatementContext *stmtCtx = nullptr)
418       : builder{builder}, loc{loc}, stmtCtx{stmtCtx} {}
419   IntrinsicLibrary() = delete;
420   IntrinsicLibrary(const IntrinsicLibrary &) = delete;
421 
422   /// Generate FIR for call to Fortran intrinsic \p name with arguments \p arg
423   /// and expected result type \p resultType.
424   fir::ExtendedValue genIntrinsicCall(llvm::StringRef name,
425                                       llvm::Optional<mlir::Type> resultType,
426                                       llvm::ArrayRef<fir::ExtendedValue> arg);
427 
428   /// Search a runtime function that is associated to the generic intrinsic name
429   /// and whose signature matches the intrinsic arguments and result types.
430   /// If no such runtime function is found but a runtime function associated
431   /// with the Fortran generic exists and has the same number of arguments,
432   /// conversions will be inserted before and/or after the call. This is to
433   /// mainly to allow 16 bits float support even-though little or no math
434   /// runtime is currently available for it.
435   mlir::Value genRuntimeCall(llvm::StringRef name, mlir::Type,
436                              llvm::ArrayRef<mlir::Value>);
437 
438   using RuntimeCallGenerator = std::function<mlir::Value(
439       fir::FirOpBuilder &, mlir::Location, llvm::ArrayRef<mlir::Value>)>;
440   RuntimeCallGenerator
441   getRuntimeCallGenerator(llvm::StringRef name,
442                           mlir::FunctionType soughtFuncType);
443 
444   /// Lowering for the ABS intrinsic. The ABS intrinsic expects one argument in
445   /// the llvm::ArrayRef. The ABS intrinsic is lowered into MLIR/FIR operation
446   /// if the argument is an integer, into llvm intrinsics if the argument is
447   /// real and to the `hypot` math routine if the argument is of complex type.
448   mlir::Value genAbs(mlir::Type, llvm::ArrayRef<mlir::Value>);
449   template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc,
450                                 mlir::Value, mlir::Value)>
451   fir::ExtendedValue genAdjustRtCall(mlir::Type,
452                                      llvm::ArrayRef<fir::ExtendedValue>);
453   mlir::Value genAimag(mlir::Type, llvm::ArrayRef<mlir::Value>);
454   mlir::Value genAint(mlir::Type, llvm::ArrayRef<mlir::Value>);
455   fir::ExtendedValue genAll(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
456   fir::ExtendedValue genAllocated(mlir::Type,
457                                   llvm::ArrayRef<fir::ExtendedValue>);
458   mlir::Value genAnint(mlir::Type, llvm::ArrayRef<mlir::Value>);
459   fir::ExtendedValue genAny(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
460   fir::ExtendedValue
461       genCommandArgumentCount(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
462   fir::ExtendedValue genAssociated(mlir::Type,
463                                    llvm::ArrayRef<fir::ExtendedValue>);
464 
465   /// Lower a bitwise comparison intrinsic using the given comparator.
466   template <mlir::arith::CmpIPredicate pred>
467   mlir::Value genBitwiseCompare(mlir::Type resultType,
468                                 llvm::ArrayRef<mlir::Value> args);
469 
470   mlir::Value genBtest(mlir::Type, llvm::ArrayRef<mlir::Value>);
471   mlir::Value genCeiling(mlir::Type, llvm::ArrayRef<mlir::Value>);
472   fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
473   template <mlir::arith::CmpIPredicate pred>
474   fir::ExtendedValue genCharacterCompare(mlir::Type,
475                                          llvm::ArrayRef<fir::ExtendedValue>);
476   mlir::Value genCmplx(mlir::Type, llvm::ArrayRef<mlir::Value>);
477   mlir::Value genConjg(mlir::Type, llvm::ArrayRef<mlir::Value>);
478   fir::ExtendedValue genCount(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
479   void genCpuTime(llvm::ArrayRef<fir::ExtendedValue>);
480   fir::ExtendedValue genCshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
481   void genDateAndTime(llvm::ArrayRef<fir::ExtendedValue>);
482   mlir::Value genDim(mlir::Type, llvm::ArrayRef<mlir::Value>);
483   fir::ExtendedValue genDotProduct(mlir::Type,
484                                    llvm::ArrayRef<fir::ExtendedValue>);
485   mlir::Value genDprod(mlir::Type, llvm::ArrayRef<mlir::Value>);
486   mlir::Value genDshiftl(mlir::Type, llvm::ArrayRef<mlir::Value>);
487   mlir::Value genDshiftr(mlir::Type, llvm::ArrayRef<mlir::Value>);
488   fir::ExtendedValue genEoshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
489   void genExit(llvm::ArrayRef<fir::ExtendedValue>);
490   mlir::Value genExponent(mlir::Type, llvm::ArrayRef<mlir::Value>);
491   template <Extremum, ExtremumBehavior>
492   mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
493   mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
494   mlir::Value genFraction(mlir::Type resultType,
495                           mlir::ArrayRef<mlir::Value> args);
496   void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args);
497   void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>);
498   /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments
499   /// in the llvm::ArrayRef.
500   mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
501   mlir::Value genIbclr(mlir::Type, llvm::ArrayRef<mlir::Value>);
502   mlir::Value genIbits(mlir::Type, llvm::ArrayRef<mlir::Value>);
503   mlir::Value genIbset(mlir::Type, llvm::ArrayRef<mlir::Value>);
504   fir::ExtendedValue genIchar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
505   mlir::Value genIeeeIsFinite(mlir::Type, llvm::ArrayRef<mlir::Value>);
506   template <mlir::arith::CmpIPredicate pred>
507   fir::ExtendedValue genIeeeTypeCompare(mlir::Type,
508                                         llvm::ArrayRef<fir::ExtendedValue>);
509   mlir::Value genIeor(mlir::Type, llvm::ArrayRef<mlir::Value>);
510   fir::ExtendedValue genIndex(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
511   mlir::Value genIor(mlir::Type, llvm::ArrayRef<mlir::Value>);
512   mlir::Value genIshft(mlir::Type, llvm::ArrayRef<mlir::Value>);
513   mlir::Value genIshftc(mlir::Type, llvm::ArrayRef<mlir::Value>);
514   fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
515   mlir::Value genLeadz(mlir::Type, llvm::ArrayRef<mlir::Value>);
516   fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
517   fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
518   template <typename Shift>
519   mlir::Value genMask(mlir::Type, llvm::ArrayRef<mlir::Value>);
520   fir::ExtendedValue genMatmul(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
521   fir::ExtendedValue genMaxloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
522   fir::ExtendedValue genMaxval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
523   fir::ExtendedValue genMerge(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
524   mlir::Value genMergeBits(mlir::Type, llvm::ArrayRef<mlir::Value>);
525   fir::ExtendedValue genMinloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
526   fir::ExtendedValue genMinval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
527   mlir::Value genMod(mlir::Type, llvm::ArrayRef<mlir::Value>);
528   mlir::Value genModulo(mlir::Type, llvm::ArrayRef<mlir::Value>);
529   void genMvbits(llvm::ArrayRef<fir::ExtendedValue>);
530   mlir::Value genNearest(mlir::Type, llvm::ArrayRef<mlir::Value>);
531   mlir::Value genNint(mlir::Type, llvm::ArrayRef<mlir::Value>);
532   mlir::Value genNot(mlir::Type, llvm::ArrayRef<mlir::Value>);
533   fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
534   fir::ExtendedValue genPack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
535   mlir::Value genPopcnt(mlir::Type, llvm::ArrayRef<mlir::Value>);
536   mlir::Value genPoppar(mlir::Type, llvm::ArrayRef<mlir::Value>);
537   fir::ExtendedValue genPresent(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
538   fir::ExtendedValue genProduct(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
539   void genRandomInit(llvm::ArrayRef<fir::ExtendedValue>);
540   void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
541   void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
542   fir::ExtendedValue genRepeat(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
543   fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
544   mlir::Value genRRSpacing(mlir::Type resultType,
545                            llvm::ArrayRef<mlir::Value> args);
546   mlir::Value genScale(mlir::Type, llvm::ArrayRef<mlir::Value>);
547   fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
548   mlir::Value genSetExponent(mlir::Type resultType,
549                              llvm::ArrayRef<mlir::Value> args);
550   template <typename Shift>
551   mlir::Value genShift(mlir::Type resultType, llvm::ArrayRef<mlir::Value>);
552   mlir::Value genSign(mlir::Type, llvm::ArrayRef<mlir::Value>);
553   fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
554   mlir::Value genSpacing(mlir::Type resultType,
555                          llvm::ArrayRef<mlir::Value> args);
556   fir::ExtendedValue genSpread(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
557   fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
558   void genSystemClock(llvm::ArrayRef<fir::ExtendedValue>);
559   mlir::Value genTrailz(mlir::Type, llvm::ArrayRef<mlir::Value>);
560   fir::ExtendedValue genTransfer(mlir::Type,
561                                  llvm::ArrayRef<fir::ExtendedValue>);
562   fir::ExtendedValue genTranspose(mlir::Type,
563                                   llvm::ArrayRef<fir::ExtendedValue>);
564   fir::ExtendedValue genTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
565   fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
566   fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
567   fir::ExtendedValue genVerify(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
568   /// Implement all conversion functions like DBLE, the first argument is
569   /// the value to convert. There may be an additional KIND arguments that
570   /// is ignored because this is already reflected in the result type.
571   mlir::Value genConversion(mlir::Type, llvm::ArrayRef<mlir::Value>);
572 
573   /// Define the different FIR generators that can be mapped to intrinsic to
574   /// generate the related code.
575   using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs);
576   using ExtendedGenerator = decltype(&IntrinsicLibrary::genLenTrim);
577   using SubroutineGenerator = decltype(&IntrinsicLibrary::genDateAndTime);
578   using Generator =
579       std::variant<ElementalGenerator, ExtendedGenerator, SubroutineGenerator>;
580 
581   /// All generators can be outlined. This will build a function named
582   /// "fir."+ <generic name> + "." + <result type code> and generate the
583   /// intrinsic implementation inside instead of at the intrinsic call sites.
584   /// This can be used to keep the FIR more readable. Only one function will
585   /// be generated for all the similar calls in a program.
586   /// If the Generator is nullptr, the wrapper uses genRuntimeCall.
587   template <typename GeneratorType>
588   mlir::Value outlineInWrapper(GeneratorType, llvm::StringRef name,
589                                mlir::Type resultType,
590                                llvm::ArrayRef<mlir::Value> args);
591   template <typename GeneratorType>
592   fir::ExtendedValue
593   outlineInExtendedWrapper(GeneratorType, llvm::StringRef name,
594                            llvm::Optional<mlir::Type> resultType,
595                            llvm::ArrayRef<fir::ExtendedValue> args);
596 
597   template <typename GeneratorType>
598   mlir::func::FuncOp getWrapper(GeneratorType, llvm::StringRef name,
599                                 mlir::FunctionType,
600                                 bool loadRefArguments = false);
601 
602   /// Generate calls to ElementalGenerator, handling the elemental aspects
603   template <typename GeneratorType>
604   fir::ExtendedValue
605   genElementalCall(GeneratorType, llvm::StringRef name, mlir::Type resultType,
606                    llvm::ArrayRef<fir::ExtendedValue> args, bool outline);
607 
608   /// Helper to invoke code generator for the intrinsics given arguments.
609   mlir::Value invokeGenerator(ElementalGenerator generator,
610                               mlir::Type resultType,
611                               llvm::ArrayRef<mlir::Value> args);
612   mlir::Value invokeGenerator(RuntimeCallGenerator generator,
613                               mlir::Type resultType,
614                               llvm::ArrayRef<mlir::Value> args);
615   mlir::Value invokeGenerator(ExtendedGenerator generator,
616                               mlir::Type resultType,
617                               llvm::ArrayRef<mlir::Value> args);
618   mlir::Value invokeGenerator(SubroutineGenerator generator,
619                               llvm::ArrayRef<mlir::Value> args);
620 
621   /// Get pointer to unrestricted intrinsic. Generate the related unrestricted
622   /// intrinsic if it is not defined yet.
623   mlir::SymbolRefAttr
624   getUnrestrictedIntrinsicSymbolRefAttr(llvm::StringRef name,
625                                         mlir::FunctionType signature);
626 
627   /// Add clean-up for \p temp to the current statement context;
628   void addCleanUpForTemp(mlir::Location loc, mlir::Value temp);
629   /// Helper function for generating code clean-up for result descriptors
630   fir::ExtendedValue readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,
631                                        mlir::Type resultType,
632                                        llvm::StringRef errMsg);
633 
634   fir::FirOpBuilder &builder;
635   mlir::Location loc;
636   Fortran::lower::StatementContext *stmtCtx;
637 };
638 
639 struct IntrinsicDummyArgument {
640   const char *name = nullptr;
641   Fortran::lower::LowerIntrinsicArgAs lowerAs =
642       Fortran::lower::LowerIntrinsicArgAs::Value;
643   bool handleDynamicOptional = false;
644 };
645 
646 struct Fortran::lower::IntrinsicArgumentLoweringRules {
647   /// There is no more than 7 non repeated arguments in Fortran intrinsics.
648   IntrinsicDummyArgument args[7];
649   constexpr bool hasDefaultRules() const { return args[0].name == nullptr; }
650 };
651 
652 /// Structure describing what needs to be done to lower intrinsic "name".
653 struct IntrinsicHandler {
654   const char *name;
655   IntrinsicLibrary::Generator generator;
656   // The following may be omitted in the table below.
657   Fortran::lower::IntrinsicArgumentLoweringRules argLoweringRules = {};
658   bool isElemental = true;
659   /// Code heavy intrinsic can be outlined to make FIR
660   /// more readable.
661   bool outline = false;
662 };
663 
664 constexpr auto asValue = Fortran::lower::LowerIntrinsicArgAs::Value;
665 constexpr auto asAddr = Fortran::lower::LowerIntrinsicArgAs::Addr;
666 constexpr auto asBox = Fortran::lower::LowerIntrinsicArgAs::Box;
667 constexpr auto asInquired = Fortran::lower::LowerIntrinsicArgAs::Inquired;
668 using I = IntrinsicLibrary;
669 
670 /// Flag to indicate that an intrinsic argument has to be handled as
671 /// being dynamically optional (e.g. special handling when actual
672 /// argument is an optional variable in the current scope).
673 static constexpr bool handleDynamicOptional = true;
674 
675 /// Table that drives the fir generation depending on the intrinsic.
676 /// one to one mapping with Fortran arguments. If no mapping is
677 /// defined here for a generic intrinsic, genRuntimeCall will be called
678 /// to look for a match in the runtime a emit a call. Note that the argument
679 /// lowering rules for an intrinsic need to be provided only if at least one
680 /// argument must not be lowered by value. In which case, the lowering rules
681 /// should be provided for all the intrinsic arguments for completeness.
682 static constexpr IntrinsicHandler handlers[]{
683     {"abs", &I::genAbs},
684     {"achar", &I::genChar},
685     {"adjustl",
686      &I::genAdjustRtCall<fir::runtime::genAdjustL>,
687      {{{"string", asAddr}}},
688      /*isElemental=*/true},
689     {"adjustr",
690      &I::genAdjustRtCall<fir::runtime::genAdjustR>,
691      {{{"string", asAddr}}},
692      /*isElemental=*/true},
693     {"aimag", &I::genAimag},
694     {"aint", &I::genAint},
695     {"all",
696      &I::genAll,
697      {{{"mask", asAddr}, {"dim", asValue}}},
698      /*isElemental=*/false},
699     {"allocated",
700      &I::genAllocated,
701      {{{"array", asInquired}, {"scalar", asInquired}}},
702      /*isElemental=*/false},
703     {"anint", &I::genAnint},
704     {"any",
705      &I::genAny,
706      {{{"mask", asAddr}, {"dim", asValue}}},
707      /*isElemental=*/false},
708     {"associated",
709      &I::genAssociated,
710      {{{"pointer", asInquired}, {"target", asInquired}}},
711      /*isElemental=*/false},
712     {"bge", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::uge>},
713     {"bgt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ugt>},
714     {"ble", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ule>},
715     {"blt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ult>},
716     {"btest", &I::genBtest},
717     {"ceiling", &I::genCeiling},
718     {"char", &I::genChar},
719     {"cmplx",
720      &I::genCmplx,
721      {{{"x", asValue}, {"y", asValue, handleDynamicOptional}}}},
722     {"command_argument_count", &I::genCommandArgumentCount},
723     {"conjg", &I::genConjg},
724     {"count",
725      &I::genCount,
726      {{{"mask", asAddr}, {"dim", asValue}, {"kind", asValue}}},
727      /*isElemental=*/false},
728     {"cpu_time",
729      &I::genCpuTime,
730      {{{"time", asAddr}}},
731      /*isElemental=*/false},
732     {"cshift",
733      &I::genCshift,
734      {{{"array", asAddr}, {"shift", asAddr}, {"dim", asValue}}},
735      /*isElemental=*/false},
736     {"date_and_time",
737      &I::genDateAndTime,
738      {{{"date", asAddr, handleDynamicOptional},
739        {"time", asAddr, handleDynamicOptional},
740        {"zone", asAddr, handleDynamicOptional},
741        {"values", asBox, handleDynamicOptional}}},
742      /*isElemental=*/false},
743     {"dble", &I::genConversion},
744     {"dim", &I::genDim},
745     {"dot_product",
746      &I::genDotProduct,
747      {{{"vector_a", asBox}, {"vector_b", asBox}}},
748      /*isElemental=*/false},
749     {"dprod", &I::genDprod},
750     {"dshiftl", &I::genDshiftl},
751     {"dshiftr", &I::genDshiftr},
752     {"eoshift",
753      &I::genEoshift,
754      {{{"array", asBox},
755        {"shift", asAddr},
756        {"boundary", asBox, handleDynamicOptional},
757        {"dim", asValue}}},
758      /*isElemental=*/false},
759     {"exit",
760      &I::genExit,
761      {{{"status", asValue, handleDynamicOptional}}},
762      /*isElemental=*/false},
763     {"exponent", &I::genExponent},
764     {"floor", &I::genFloor},
765     {"fraction", &I::genFraction},
766     {"get_command_argument",
767      &I::genGetCommandArgument,
768      {{{"number", asValue},
769        {"value", asBox, handleDynamicOptional},
770        {"length", asAddr},
771        {"status", asAddr},
772        {"errmsg", asBox, handleDynamicOptional}}},
773      /*isElemental=*/false},
774     {"get_environment_variable",
775      &I::genGetEnvironmentVariable,
776      {{{"name", asBox},
777        {"value", asBox, handleDynamicOptional},
778        {"length", asAddr},
779        {"status", asAddr},
780        {"trim_name", asAddr},
781        {"errmsg", asBox, handleDynamicOptional}}},
782      /*isElemental=*/false},
783     {"iachar", &I::genIchar},
784     {"iand", &I::genIand},
785     {"ibclr", &I::genIbclr},
786     {"ibits", &I::genIbits},
787     {"ibset", &I::genIbset},
788     {"ichar", &I::genIchar},
789     {"ieee_class_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
790     {"ieee_class_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
791     {"ieee_is_finite", &I::genIeeeIsFinite},
792     {"ieee_round_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
793     {"ieee_round_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
794     {"ieor", &I::genIeor},
795     {"index",
796      &I::genIndex,
797      {{{"string", asAddr},
798        {"substring", asAddr},
799        {"back", asValue, handleDynamicOptional},
800        {"kind", asValue}}}},
801     {"ior", &I::genIor},
802     {"ishft", &I::genIshft},
803     {"ishftc", &I::genIshftc},
804     {"lbound",
805      &I::genLbound,
806      {{{"array", asInquired}, {"dim", asValue}, {"kind", asValue}}},
807      /*isElemental=*/false},
808     {"leadz", &I::genLeadz},
809     {"len",
810      &I::genLen,
811      {{{"string", asInquired}, {"kind", asValue}}},
812      /*isElemental=*/false},
813     {"len_trim", &I::genLenTrim},
814     {"lge", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sge>},
815     {"lgt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sgt>},
816     {"lle", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sle>},
817     {"llt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::slt>},
818     {"maskl", &I::genMask<mlir::arith::ShLIOp>},
819     {"maskr", &I::genMask<mlir::arith::ShRUIOp>},
820     {"matmul",
821      &I::genMatmul,
822      {{{"matrix_a", asAddr}, {"matrix_b", asAddr}}},
823      /*isElemental=*/false},
824     {"max", &I::genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>},
825     {"maxloc",
826      &I::genMaxloc,
827      {{{"array", asBox},
828        {"dim", asValue},
829        {"mask", asBox, handleDynamicOptional},
830        {"kind", asValue},
831        {"back", asValue, handleDynamicOptional}}},
832      /*isElemental=*/false},
833     {"maxval",
834      &I::genMaxval,
835      {{{"array", asBox},
836        {"dim", asValue},
837        {"mask", asBox, handleDynamicOptional}}},
838      /*isElemental=*/false},
839     {"merge", &I::genMerge},
840     {"merge_bits", &I::genMergeBits},
841     {"min", &I::genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>},
842     {"minloc",
843      &I::genMinloc,
844      {{{"array", asBox},
845        {"dim", asValue},
846        {"mask", asBox, handleDynamicOptional},
847        {"kind", asValue},
848        {"back", asValue, handleDynamicOptional}}},
849      /*isElemental=*/false},
850     {"minval",
851      &I::genMinval,
852      {{{"array", asBox},
853        {"dim", asValue},
854        {"mask", asBox, handleDynamicOptional}}},
855      /*isElemental=*/false},
856     {"mod", &I::genMod},
857     {"modulo", &I::genModulo},
858     {"mvbits",
859      &I::genMvbits,
860      {{{"from", asValue},
861        {"frompos", asValue},
862        {"len", asValue},
863        {"to", asAddr},
864        {"topos", asValue}}}},
865     {"nearest", &I::genNearest},
866     {"nint", &I::genNint},
867     {"not", &I::genNot},
868     {"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false},
869     {"pack",
870      &I::genPack,
871      {{{"array", asBox},
872        {"mask", asBox},
873        {"vector", asBox, handleDynamicOptional}}},
874      /*isElemental=*/false},
875     {"popcnt", &I::genPopcnt},
876     {"poppar", &I::genPoppar},
877     {"present",
878      &I::genPresent,
879      {{{"a", asInquired}}},
880      /*isElemental=*/false},
881     {"product",
882      &I::genProduct,
883      {{{"array", asBox},
884        {"dim", asValue},
885        {"mask", asBox, handleDynamicOptional}}},
886      /*isElemental=*/false},
887     {"random_init",
888      &I::genRandomInit,
889      {{{"repeatable", asValue}, {"image_distinct", asValue}}},
890      /*isElemental=*/false},
891     {"random_number",
892      &I::genRandomNumber,
893      {{{"harvest", asBox}}},
894      /*isElemental=*/false},
895     {"random_seed",
896      &I::genRandomSeed,
897      {{{"size", asBox}, {"put", asBox}, {"get", asBox}}},
898      /*isElemental=*/false},
899     {"repeat",
900      &I::genRepeat,
901      {{{"string", asAddr}, {"ncopies", asValue}}},
902      /*isElemental=*/false},
903     {"reshape",
904      &I::genReshape,
905      {{{"source", asBox},
906        {"shape", asBox},
907        {"pad", asBox, handleDynamicOptional},
908        {"order", asBox, handleDynamicOptional}}},
909      /*isElemental=*/false},
910     {"rrspacing", &I::genRRSpacing},
911     {"scale",
912      &I::genScale,
913      {{{"x", asValue}, {"i", asValue}}},
914      /*isElemental=*/true},
915     {"scan",
916      &I::genScan,
917      {{{"string", asAddr},
918        {"set", asAddr},
919        {"back", asValue, handleDynamicOptional},
920        {"kind", asValue}}},
921      /*isElemental=*/true},
922     {"set_exponent", &I::genSetExponent},
923     {"shifta", &I::genShift<mlir::arith::ShRSIOp>},
924     {"shiftl", &I::genShift<mlir::arith::ShLIOp>},
925     {"shiftr", &I::genShift<mlir::arith::ShRUIOp>},
926     {"sign", &I::genSign},
927     {"size",
928      &I::genSize,
929      {{{"array", asBox},
930        {"dim", asAddr, handleDynamicOptional},
931        {"kind", asValue}}},
932      /*isElemental=*/false},
933     {"spacing", &I::genSpacing},
934     {"spread",
935      &I::genSpread,
936      {{{"source", asAddr}, {"dim", asValue}, {"ncopies", asValue}}},
937      /*isElemental=*/false},
938     {"sum",
939      &I::genSum,
940      {{{"array", asBox},
941        {"dim", asValue},
942        {"mask", asBox, handleDynamicOptional}}},
943      /*isElemental=*/false},
944     {"system_clock",
945      &I::genSystemClock,
946      {{{"count", asAddr}, {"count_rate", asAddr}, {"count_max", asAddr}}},
947      /*isElemental=*/false},
948     {"trailz", &I::genTrailz},
949     {"transfer",
950      &I::genTransfer,
951      {{{"source", asAddr}, {"mold", asAddr}, {"size", asValue}}},
952      /*isElemental=*/false},
953     {"transpose",
954      &I::genTranspose,
955      {{{"matrix", asAddr}}},
956      /*isElemental=*/false},
957     {"trim", &I::genTrim, {{{"string", asAddr}}}, /*isElemental=*/false},
958     {"ubound",
959      &I::genUbound,
960      {{{"array", asBox}, {"dim", asValue}, {"kind", asValue}}},
961      /*isElemental=*/false},
962     {"unpack",
963      &I::genUnpack,
964      {{{"vector", asBox}, {"mask", asBox}, {"field", asBox}}},
965      /*isElemental=*/false},
966     {"verify",
967      &I::genVerify,
968      {{{"string", asAddr},
969        {"set", asAddr},
970        {"back", asValue, handleDynamicOptional},
971        {"kind", asValue}}},
972      /*isElemental=*/true},
973 };
974 
975 static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) {
976   auto compare = [](const IntrinsicHandler &handler, llvm::StringRef name) {
977     return name.compare(handler.name) > 0;
978   };
979   auto result =
980       std::lower_bound(std::begin(handlers), std::end(handlers), name, compare);
981   return result != std::end(handlers) && result->name == name ? result
982                                                               : nullptr;
983 }
984 
985 /// To make fir output more readable for debug, one can outline all intrinsic
986 /// implementation in wrappers (overrides the IntrinsicHandler::outline flag).
987 static llvm::cl::opt<bool> outlineAllIntrinsics(
988     "outline-intrinsics",
989     llvm::cl::desc(
990         "Lower all intrinsic procedure implementation in their own functions"),
991     llvm::cl::init(false));
992 
993 //===----------------------------------------------------------------------===//
994 // Math runtime description and matching utility
995 //===----------------------------------------------------------------------===//
996 
997 /// Command line option to modify math runtime behavior used to implement
998 /// intrinsics. This option applies both to early and late math-lowering modes.
999 enum MathRuntimeVersion { fastVersion, relaxedVersion, preciseVersion };
1000 llvm::cl::opt<MathRuntimeVersion> mathRuntimeVersion(
1001     "math-runtime", llvm::cl::desc("Select math operations' runtime behavior:"),
1002     llvm::cl::values(
1003         clEnumValN(fastVersion, "fast", "use fast runtime behavior"),
1004         clEnumValN(relaxedVersion, "relaxed", "use relaxed runtime behavior"),
1005         clEnumValN(preciseVersion, "precise", "use precise runtime behavior")),
1006     llvm::cl::init(fastVersion));
1007 
1008 struct RuntimeFunction {
1009   // llvm::StringRef comparison operator are not constexpr, so use string_view.
1010   using Key = std::string_view;
1011   // Needed for implicit compare with keys.
1012   constexpr operator Key() const { return key; }
1013   Key key; // intrinsic name
1014 
1015   // Name of a runtime function that implements the operation.
1016   llvm::StringRef symbol;
1017   fir::runtime::FuncTypeBuilderFunc typeGenerator;
1018 };
1019 
1020 #define RUNTIME_STATIC_DESCRIPTION(name, func)                                 \
1021   {#name, #func, fir::runtime::RuntimeTableKey<decltype(func)>::getTypeModel()},
1022 static constexpr RuntimeFunction pgmathFast[] = {
1023 #define PGMATH_FAST
1024 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
1025 #include "flang/Evaluate/pgmath.h.inc"
1026 };
1027 static constexpr RuntimeFunction pgmathRelaxed[] = {
1028 #define PGMATH_RELAXED
1029 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
1030 #include "flang/Evaluate/pgmath.h.inc"
1031 };
1032 static constexpr RuntimeFunction pgmathPrecise[] = {
1033 #define PGMATH_PRECISE
1034 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
1035 #include "flang/Evaluate/pgmath.h.inc"
1036 };
1037 
1038 static mlir::FunctionType genF32F32FuncType(mlir::MLIRContext *context) {
1039   mlir::Type t = mlir::FloatType::getF32(context);
1040   return mlir::FunctionType::get(context, {t}, {t});
1041 }
1042 
1043 static mlir::FunctionType genF64F64FuncType(mlir::MLIRContext *context) {
1044   mlir::Type t = mlir::FloatType::getF64(context);
1045   return mlir::FunctionType::get(context, {t}, {t});
1046 }
1047 
1048 static mlir::FunctionType genF128F128FuncType(mlir::MLIRContext *context) {
1049   mlir::Type t = mlir::FloatType::getF128(context);
1050   return mlir::FunctionType::get(context, {t}, {t});
1051 }
1052 
1053 static mlir::FunctionType genF32F32F32FuncType(mlir::MLIRContext *context) {
1054   auto t = mlir::FloatType::getF32(context);
1055   return mlir::FunctionType::get(context, {t, t}, {t});
1056 }
1057 
1058 static mlir::FunctionType genF64F64F64FuncType(mlir::MLIRContext *context) {
1059   auto t = mlir::FloatType::getF64(context);
1060   return mlir::FunctionType::get(context, {t, t}, {t});
1061 }
1062 
1063 static mlir::FunctionType genF80F80F80FuncType(mlir::MLIRContext *context) {
1064   auto t = mlir::FloatType::getF80(context);
1065   return mlir::FunctionType::get(context, {t, t}, {t});
1066 }
1067 
1068 static mlir::FunctionType genF128F128F128FuncType(mlir::MLIRContext *context) {
1069   auto t = mlir::FloatType::getF128(context);
1070   return mlir::FunctionType::get(context, {t, t}, {t});
1071 }
1072 
1073 template <int Bits>
1074 static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) {
1075   auto t = mlir::FloatType::getF64(context);
1076   auto r = mlir::IntegerType::get(context, Bits);
1077   return mlir::FunctionType::get(context, {t}, {r});
1078 }
1079 
1080 template <int Bits>
1081 static mlir::FunctionType genIntF32FuncType(mlir::MLIRContext *context) {
1082   auto t = mlir::FloatType::getF32(context);
1083   auto r = mlir::IntegerType::get(context, Bits);
1084   return mlir::FunctionType::get(context, {t}, {r});
1085 }
1086 
1087 template <int Bits>
1088 static mlir::FunctionType genF64F64IntFuncType(mlir::MLIRContext *context) {
1089   auto ftype = mlir::FloatType::getF64(context);
1090   auto itype = mlir::IntegerType::get(context, Bits);
1091   return mlir::FunctionType::get(context, {ftype, itype}, {ftype});
1092 }
1093 
1094 template <int Bits>
1095 static mlir::FunctionType genF32F32IntFuncType(mlir::MLIRContext *context) {
1096   auto ftype = mlir::FloatType::getF32(context);
1097   auto itype = mlir::IntegerType::get(context, Bits);
1098   return mlir::FunctionType::get(context, {ftype, itype}, {ftype});
1099 }
1100 
1101 /// Callback type for generating lowering for a math operation.
1102 using MathGeneratorTy = mlir::Value (*)(fir::FirOpBuilder &, mlir::Location,
1103                                         llvm::StringRef, mlir::FunctionType,
1104                                         llvm::ArrayRef<mlir::Value>);
1105 
1106 struct MathOperation {
1107   // llvm::StringRef comparison operator are not constexpr, so use string_view.
1108   using Key = std::string_view;
1109   // Needed for implicit compare with keys.
1110   constexpr operator Key() const { return key; }
1111   // Intrinsic name.
1112   Key key;
1113 
1114   // Name of a runtime function that implements the operation.
1115   llvm::StringRef runtimeFunc;
1116   fir::runtime::FuncTypeBuilderFunc typeGenerator;
1117 
1118   // A callback to generate FIR for the intrinsic defined by 'key'.
1119   // A callback may generate either dedicated MLIR operation(s) or
1120   // a function call to a runtime function with name defined by
1121   // 'runtimeFunc'.
1122   MathGeneratorTy funcGenerator;
1123 };
1124 
1125 static mlir::Value genLibCall(fir::FirOpBuilder &builder, mlir::Location loc,
1126                               llvm::StringRef libFuncName,
1127                               mlir::FunctionType libFuncType,
1128                               llvm::ArrayRef<mlir::Value> args) {
1129   LLVM_DEBUG(llvm::dbgs() << "Generating '" << libFuncName
1130                           << "' call with type ";
1131              libFuncType.dump(); llvm::dbgs() << "\n");
1132   mlir::func::FuncOp funcOp =
1133       builder.addNamedFunction(loc, libFuncName, libFuncType);
1134   // TODO: ensure 'strictfp' setting on the call for "precise/strict"
1135   //       FP mode. Set appropriate Fast-Math Flags otherwise.
1136   // TODO: we should also mark as many libm function as possible
1137   //       with 'pure' attribute (of course, not in strict FP mode).
1138   auto libCall = builder.create<fir::CallOp>(loc, funcOp, args);
1139   LLVM_DEBUG(libCall.dump(); llvm::dbgs() << "\n");
1140   return libCall.getResult(0);
1141 }
1142 
1143 template <typename T>
1144 static mlir::Value genMathOp(fir::FirOpBuilder &builder, mlir::Location loc,
1145                              llvm::StringRef mathLibFuncName,
1146                              mlir::FunctionType mathLibFuncType,
1147                              llvm::ArrayRef<mlir::Value> args) {
1148   // TODO: we have to annotate the math operations with flags
1149   //       that will allow to define FP accuracy/exception
1150   //       behavior per operation, so that after early multi-module
1151   //       MLIR inlining we can distiguish operation that were
1152   //       compiled with different settings.
1153   //       Suggestion:
1154   //         * For "relaxed" FP mode set all Fast-Math Flags
1155   //           (see "[RFC] FastMath flags support in MLIR (arith dialect)"
1156   //           topic at discourse.llvm.org).
1157   //         * For "fast" FP mode set all Fast-Math Flags except 'afn'.
1158   //         * For "precise/strict" FP mode generate fir.calls to libm
1159   //           entries and annotate them with an attribute that will
1160   //           end up transformed into 'strictfp' LLVM attribute (TBD).
1161   //           Elsewhere, "precise/strict" FP mode should also set
1162   //           'strictfp' for all user functions and calls so that
1163   //           LLVM backend does the right job.
1164   //         * Operations that cannot be reasonably optimized in MLIR
1165   //           can be also lowered to libm calls for "fast" and "relaxed"
1166   //           modes.
1167   mlir::Value result;
1168   if (mathRuntimeVersion == preciseVersion) {
1169     result = genLibCall(builder, loc, mathLibFuncName, mathLibFuncType, args);
1170   } else {
1171     LLVM_DEBUG(llvm::dbgs() << "Generating '" << mathLibFuncName
1172                             << "' operation with type ";
1173                mathLibFuncType.dump(); llvm::dbgs() << "\n");
1174     result = builder.create<T>(loc, args);
1175   }
1176   LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n");
1177   return result;
1178 }
1179 
1180 /// Mapping between mathematical intrinsic operations and MLIR operations
1181 /// of some appropriate dialect (math, complex, etc.) or libm calls.
1182 /// TODO: support remaining Fortran math intrinsics.
1183 ///       See https://gcc.gnu.org/onlinedocs/gcc-12.1.0/gfortran/\
1184 ///       Intrinsic-Procedures.html for a reference.
1185 static constexpr MathOperation mathOperations[] = {
1186     {"abs", "fabsf", genF32F32FuncType, genMathOp<mlir::math::AbsOp>},
1187     {"abs", "fabs", genF64F64FuncType, genMathOp<mlir::math::AbsOp>},
1188     {"abs", "llvm.fabs.f128", genF128F128FuncType,
1189      genMathOp<mlir::math::AbsOp>},
1190     // llvm.trunc behaves the same way as libm's trunc.
1191     {"aint", "llvm.trunc.f32", genF32F32FuncType, genLibCall},
1192     {"aint", "llvm.trunc.f64", genF64F64FuncType, genLibCall},
1193     // llvm.round behaves the same way as libm's round.
1194     {"anint", "llvm.round.f32", genF32F32FuncType,
1195      genMathOp<mlir::LLVM::RoundOp>},
1196     {"anint", "llvm.round.f64", genF64F64FuncType,
1197      genMathOp<mlir::LLVM::RoundOp>},
1198     {"atan", "atanf", genF32F32FuncType, genMathOp<mlir::math::AtanOp>},
1199     {"atan", "atan", genF64F64FuncType, genMathOp<mlir::math::AtanOp>},
1200     {"atan2", "atan2f", genF32F32F32FuncType, genMathOp<mlir::math::Atan2Op>},
1201     {"atan2", "atan2", genF64F64F64FuncType, genMathOp<mlir::math::Atan2Op>},
1202     // math::CeilOp returns a real, while Fortran CEILING returns integer.
1203     {"ceil", "ceilf", genF32F32FuncType, genMathOp<mlir::math::CeilOp>},
1204     {"ceil", "ceil", genF64F64FuncType, genMathOp<mlir::math::CeilOp>},
1205     {"cos", "cosf", genF32F32FuncType, genMathOp<mlir::math::CosOp>},
1206     {"cos", "cos", genF64F64FuncType, genMathOp<mlir::math::CosOp>},
1207     {"cosh", "coshf", genF32F32FuncType, genLibCall},
1208     {"cosh", "cosh", genF64F64FuncType, genLibCall},
1209     {"erf", "erff", genF32F32FuncType, genMathOp<mlir::math::ErfOp>},
1210     {"erf", "erf", genF64F64FuncType, genMathOp<mlir::math::ErfOp>},
1211     {"exp", "expf", genF32F32FuncType, genMathOp<mlir::math::ExpOp>},
1212     {"exp", "exp", genF64F64FuncType, genMathOp<mlir::math::ExpOp>},
1213     // math::FloorOp returns a real, while Fortran FLOOR returns integer.
1214     {"floor", "floorf", genF32F32FuncType, genMathOp<mlir::math::FloorOp>},
1215     {"floor", "floor", genF64F64FuncType, genMathOp<mlir::math::FloorOp>},
1216     {"hypot", "hypotf", genF32F32F32FuncType, genLibCall},
1217     {"hypot", "hypot", genF64F64F64FuncType, genLibCall},
1218     {"log", "logf", genF32F32FuncType, genMathOp<mlir::math::LogOp>},
1219     {"log", "log", genF64F64FuncType, genMathOp<mlir::math::LogOp>},
1220     {"log10", "log10f", genF32F32FuncType, genMathOp<mlir::math::Log10Op>},
1221     {"log10", "log10", genF64F64FuncType, genMathOp<mlir::math::Log10Op>},
1222     // llvm.lround behaves the same way as libm's lround.
1223     {"nint", "llvm.lround.i64.f64", genIntF64FuncType<64>, genLibCall},
1224     {"nint", "llvm.lround.i64.f32", genIntF32FuncType<64>, genLibCall},
1225     {"nint", "llvm.lround.i32.f64", genIntF64FuncType<32>, genLibCall},
1226     {"nint", "llvm.lround.i32.f32", genIntF32FuncType<32>, genLibCall},
1227     {"pow", "powf", genF32F32F32FuncType, genMathOp<mlir::math::PowFOp>},
1228     {"pow", "pow", genF64F64F64FuncType, genMathOp<mlir::math::PowFOp>},
1229     // TODO: add PowIOp in math and complex dialects.
1230     {"pow", "llvm.powi.f32.i32", genF32F32IntFuncType<32>, genLibCall},
1231     {"pow", "llvm.powi.f64.i32", genF64F64IntFuncType<32>, genLibCall},
1232     {"sign", "copysignf", genF32F32F32FuncType,
1233      genMathOp<mlir::math::CopySignOp>},
1234     {"sign", "copysign", genF64F64F64FuncType,
1235      genMathOp<mlir::math::CopySignOp>},
1236     {"sign", "copysignl", genF80F80F80FuncType,
1237      genMathOp<mlir::math::CopySignOp>},
1238     {"sign", "llvm.copysign.f128", genF128F128F128FuncType,
1239      genMathOp<mlir::math::CopySignOp>},
1240     {"sin", "sinf", genF32F32FuncType, genMathOp<mlir::math::SinOp>},
1241     {"sin", "sin", genF64F64FuncType, genMathOp<mlir::math::SinOp>},
1242     {"sinh", "sinhf", genF32F32FuncType, genLibCall},
1243     {"sinh", "sinh", genF64F64FuncType, genLibCall},
1244     {"sqrt", "sqrtf", genF32F32FuncType, genMathOp<mlir::math::SqrtOp>},
1245     {"sqrt", "sqrt", genF64F64FuncType, genMathOp<mlir::math::SqrtOp>},
1246     {"tan", "tanf", genF32F32FuncType, genMathOp<mlir::math::TanOp>},
1247     {"tan", "tan", genF64F64FuncType, genMathOp<mlir::math::TanOp>},
1248     {"tanh", "tanhf", genF32F32FuncType, genMathOp<mlir::math::TanhOp>},
1249     {"tanh", "tanh", genF64F64FuncType, genMathOp<mlir::math::TanhOp>},
1250 };
1251 
1252 // This helper class computes a "distance" between two function types.
1253 // The distance measures how many narrowing conversions of actual arguments
1254 // and result of "from" must be made in order to use "to" instead of "from".
1255 // For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is
1256 // greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means
1257 // if no implementation of ACOS(REAL(10)) is available, it is better to use
1258 // ACOS(REAL(16)) with casts rather than ACOS(REAL(8)).
1259 // Note that this is not a symmetric distance and the order of "from" and "to"
1260 // arguments matters, d(foo, bar) may not be the same as d(bar, foo) because it
1261 // may be safe to replace foo by bar, but not the opposite.
1262 class FunctionDistance {
1263 public:
1264   FunctionDistance() : infinite{true} {}
1265 
1266   FunctionDistance(mlir::FunctionType from, mlir::FunctionType to) {
1267     unsigned nInputs = from.getNumInputs();
1268     unsigned nResults = from.getNumResults();
1269     if (nResults != to.getNumResults() || nInputs != to.getNumInputs()) {
1270       infinite = true;
1271     } else {
1272       for (decltype(nInputs) i = 0; i < nInputs && !infinite; ++i)
1273         addArgumentDistance(from.getInput(i), to.getInput(i));
1274       for (decltype(nResults) i = 0; i < nResults && !infinite; ++i)
1275         addResultDistance(to.getResult(i), from.getResult(i));
1276     }
1277   }
1278 
1279   /// Beware both d1.isSmallerThan(d2) *and* d2.isSmallerThan(d1) may be
1280   /// false if both d1 and d2 are infinite. This implies that
1281   ///  d1.isSmallerThan(d2) is not equivalent to !d2.isSmallerThan(d1)
1282   bool isSmallerThan(const FunctionDistance &d) const {
1283     return !infinite &&
1284            (d.infinite || std::lexicographical_compare(
1285                               conversions.begin(), conversions.end(),
1286                               d.conversions.begin(), d.conversions.end()));
1287   }
1288 
1289   bool isLosingPrecision() const {
1290     return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0;
1291   }
1292 
1293   bool isInfinite() const { return infinite; }
1294 
1295 private:
1296   enum class Conversion { Forbidden, None, Narrow, Extend };
1297 
1298   void addArgumentDistance(mlir::Type from, mlir::Type to) {
1299     switch (conversionBetweenTypes(from, to)) {
1300     case Conversion::Forbidden:
1301       infinite = true;
1302       break;
1303     case Conversion::None:
1304       break;
1305     case Conversion::Narrow:
1306       conversions[narrowingArg]++;
1307       break;
1308     case Conversion::Extend:
1309       conversions[nonNarrowingArg]++;
1310       break;
1311     }
1312   }
1313 
1314   void addResultDistance(mlir::Type from, mlir::Type to) {
1315     switch (conversionBetweenTypes(from, to)) {
1316     case Conversion::Forbidden:
1317       infinite = true;
1318       break;
1319     case Conversion::None:
1320       break;
1321     case Conversion::Narrow:
1322       conversions[nonExtendingResult]++;
1323       break;
1324     case Conversion::Extend:
1325       conversions[extendingResult]++;
1326       break;
1327     }
1328   }
1329 
1330   // Floating point can be mlir::FloatType or fir::real
1331   static unsigned getFloatingPointWidth(mlir::Type t) {
1332     if (auto f{t.dyn_cast<mlir::FloatType>()})
1333       return f.getWidth();
1334     // FIXME: Get width another way for fir.real/complex
1335     // - use fir/KindMapping.h and llvm::Type
1336     // - or use evaluate/type.h
1337     if (auto r{t.dyn_cast<fir::RealType>()})
1338       return r.getFKind() * 4;
1339     if (auto cplx{t.dyn_cast<fir::ComplexType>()})
1340       return cplx.getFKind() * 4;
1341     llvm_unreachable("not a floating-point type");
1342   }
1343 
1344   static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) {
1345     if (from == to)
1346       return Conversion::None;
1347 
1348     if (auto fromIntTy{from.dyn_cast<mlir::IntegerType>()}) {
1349       if (auto toIntTy{to.dyn_cast<mlir::IntegerType>()}) {
1350         return fromIntTy.getWidth() > toIntTy.getWidth() ? Conversion::Narrow
1351                                                          : Conversion::Extend;
1352       }
1353     }
1354 
1355     if (fir::isa_real(from) && fir::isa_real(to)) {
1356       return getFloatingPointWidth(from) > getFloatingPointWidth(to)
1357                  ? Conversion::Narrow
1358                  : Conversion::Extend;
1359     }
1360 
1361     if (auto fromCplxTy{from.dyn_cast<fir::ComplexType>()}) {
1362       if (auto toCplxTy{to.dyn_cast<fir::ComplexType>()}) {
1363         return getFloatingPointWidth(fromCplxTy) >
1364                        getFloatingPointWidth(toCplxTy)
1365                    ? Conversion::Narrow
1366                    : Conversion::Extend;
1367       }
1368     }
1369     // Notes:
1370     // - No conversion between character types, specialization of runtime
1371     // functions should be made instead.
1372     // - It is not clear there is a use case for automatic conversions
1373     // around Logical and it may damage hidden information in the physical
1374     // storage so do not do it.
1375     return Conversion::Forbidden;
1376   }
1377 
1378   // Below are indexes to access data in conversions.
1379   // The order in data does matter for lexicographical_compare
1380   enum {
1381     narrowingArg = 0,   // usually bad
1382     extendingResult,    // usually bad
1383     nonExtendingResult, // usually ok
1384     nonNarrowingArg,    // usually ok
1385     dataSize
1386   };
1387 
1388   std::array<int, dataSize> conversions = {};
1389   bool infinite = false; // When forbidden conversion or wrong argument number
1390 };
1391 
1392 /// Build mlir::func::FuncOp from runtime symbol description and add
1393 /// fir.runtime attribute.
1394 static mlir::func::FuncOp getFuncOp(mlir::Location loc,
1395                                     fir::FirOpBuilder &builder,
1396                                     const RuntimeFunction &runtime) {
1397   mlir::func::FuncOp function = builder.addNamedFunction(
1398       loc, runtime.symbol, runtime.typeGenerator(builder.getContext()));
1399   function->setAttr("fir.runtime", builder.getUnitAttr());
1400   return function;
1401 }
1402 
1403 /// Select runtime function that has the smallest distance to the intrinsic
1404 /// function type and that will not imply narrowing arguments or extending the
1405 /// result.
1406 /// If nothing is found, the mlir::func::FuncOp will contain a nullptr.
1407 static mlir::func::FuncOp searchFunctionInLibrary(
1408     mlir::Location loc, fir::FirOpBuilder &builder,
1409     const Fortran::common::StaticMultimapView<RuntimeFunction> &lib,
1410     llvm::StringRef name, mlir::FunctionType funcType,
1411     const RuntimeFunction **bestNearMatch,
1412     FunctionDistance &bestMatchDistance) {
1413   std::pair<const RuntimeFunction *, const RuntimeFunction *> range =
1414       lib.equal_range(name);
1415   for (auto iter = range.first; iter != range.second && iter; ++iter) {
1416     const RuntimeFunction &impl = *iter;
1417     mlir::FunctionType implType = impl.typeGenerator(builder.getContext());
1418     if (funcType == implType)
1419       return getFuncOp(loc, builder, impl); // exact match
1420 
1421     FunctionDistance distance(funcType, implType);
1422     if (distance.isSmallerThan(bestMatchDistance)) {
1423       *bestNearMatch = &impl;
1424       bestMatchDistance = std::move(distance);
1425     }
1426   }
1427   return {};
1428 }
1429 
1430 using RtMap = Fortran::common::StaticMultimapView<MathOperation>;
1431 static constexpr RtMap mathOps(mathOperations);
1432 static_assert(mathOps.Verify() && "map must be sorted");
1433 
1434 /// Look for a MathOperation entry specifying how to lower a mathematical
1435 /// operation defined by \p name with its result' and operands' types
1436 /// specified in the form of a FunctionType \p funcType.
1437 /// If exact match for the given types is found, then the function
1438 /// returns a pointer to the corresponding MathOperation.
1439 /// Otherwise, the function returns nullptr.
1440 /// If there is a MathOperation that can be used with additional
1441 /// type casts for the operands or/and result (non-exact match),
1442 /// then it is returned via \p bestNearMatch argument, and
1443 /// \p bestMatchDistance specifies the FunctionDistance between
1444 /// the requested operation and the non-exact match.
1445 static const MathOperation *
1446 searchMathOperation(fir::FirOpBuilder &builder, llvm::StringRef name,
1447                     mlir::FunctionType funcType,
1448                     const MathOperation **bestNearMatch,
1449                     FunctionDistance &bestMatchDistance) {
1450   auto range = mathOps.equal_range(name);
1451   for (auto iter = range.first; iter != range.second && iter; ++iter) {
1452     const auto &impl = *iter;
1453     auto implType = impl.typeGenerator(builder.getContext());
1454     if (funcType == implType)
1455       return &impl; // exact match
1456 
1457     FunctionDistance distance(funcType, implType);
1458     if (distance.isSmallerThan(bestMatchDistance)) {
1459       *bestNearMatch = &impl;
1460       bestMatchDistance = std::move(distance);
1461     }
1462   }
1463   return nullptr;
1464 }
1465 
1466 /// Implementation of the operation defined by \p name with type
1467 /// \p funcType is not precise, and the actual available implementation
1468 /// is \p distance away from the requested. If using the available
1469 /// implementation results in a precision loss, emit an error message
1470 /// with the given code location \p loc.
1471 static void checkPrecisionLoss(llvm::StringRef name,
1472                                mlir::FunctionType funcType,
1473                                const FunctionDistance &distance,
1474                                mlir::Location loc) {
1475   if (!distance.isLosingPrecision())
1476     return;
1477 
1478   // Using this runtime version requires narrowing the arguments
1479   // or extending the result. It is not numerically safe. There
1480   // is currently no quad math library that was described in
1481   // lowering and could be used here. Emit an error and continue
1482   // generating the code with the narrowing cast so that the user
1483   // can get a complete list of the problematic intrinsic calls.
1484   std::string message("not yet implemented: no math runtime available for '");
1485   llvm::raw_string_ostream sstream(message);
1486   if (name == "pow") {
1487     assert(funcType.getNumInputs() == 2 && "power operator has two arguments");
1488     sstream << funcType.getInput(0) << " ** " << funcType.getInput(1);
1489   } else {
1490     sstream << name << "(";
1491     if (funcType.getNumInputs() > 0)
1492       sstream << funcType.getInput(0);
1493     for (mlir::Type argType : funcType.getInputs().drop_front())
1494       sstream << ", " << argType;
1495     sstream << ")";
1496   }
1497   sstream << "'";
1498   mlir::emitError(loc, message);
1499 }
1500 
1501 /// Search runtime for the best runtime function given an intrinsic name
1502 /// and interface. The interface may not be a perfect match in which case
1503 /// the caller is responsible to insert argument and return value conversions.
1504 /// If nothing is found, the mlir::func::FuncOp will contain a nullptr.
1505 static mlir::func::FuncOp getRuntimeFunction(mlir::Location loc,
1506                                              fir::FirOpBuilder &builder,
1507                                              llvm::StringRef name,
1508                                              mlir::FunctionType funcType) {
1509   const RuntimeFunction *bestNearMatch = nullptr;
1510   FunctionDistance bestMatchDistance;
1511   mlir::func::FuncOp match;
1512   using RtMap = Fortran::common::StaticMultimapView<RuntimeFunction>;
1513   static constexpr RtMap pgmathF(pgmathFast);
1514   static_assert(pgmathF.Verify() && "map must be sorted");
1515   static constexpr RtMap pgmathR(pgmathRelaxed);
1516   static_assert(pgmathR.Verify() && "map must be sorted");
1517   static constexpr RtMap pgmathP(pgmathPrecise);
1518   static_assert(pgmathP.Verify() && "map must be sorted");
1519 
1520   if (mathRuntimeVersion == fastVersion)
1521     match = searchFunctionInLibrary(loc, builder, pgmathF, name, funcType,
1522                                     &bestNearMatch, bestMatchDistance);
1523   else if (mathRuntimeVersion == relaxedVersion)
1524     match = searchFunctionInLibrary(loc, builder, pgmathR, name, funcType,
1525                                     &bestNearMatch, bestMatchDistance);
1526   else if (mathRuntimeVersion == preciseVersion)
1527     match = searchFunctionInLibrary(loc, builder, pgmathP, name, funcType,
1528                                     &bestNearMatch, bestMatchDistance);
1529   else
1530     llvm_unreachable("unsupported mathRuntimeVersion");
1531 
1532   return match;
1533 }
1534 
1535 /// Helpers to get function type from arguments and result type.
1536 static mlir::FunctionType getFunctionType(llvm::Optional<mlir::Type> resultType,
1537                                           llvm::ArrayRef<mlir::Value> arguments,
1538                                           fir::FirOpBuilder &builder) {
1539   llvm::SmallVector<mlir::Type> argTypes;
1540   for (mlir::Value arg : arguments)
1541     argTypes.push_back(arg.getType());
1542   llvm::SmallVector<mlir::Type> resTypes;
1543   if (resultType)
1544     resTypes.push_back(*resultType);
1545   return mlir::FunctionType::get(builder.getModule().getContext(), argTypes,
1546                                  resTypes);
1547 }
1548 
1549 /// fir::ExtendedValue to mlir::Value translation layer
1550 
1551 fir::ExtendedValue toExtendedValue(mlir::Value val, fir::FirOpBuilder &builder,
1552                                    mlir::Location loc) {
1553   assert(val && "optional unhandled here");
1554   mlir::Type type = val.getType();
1555   mlir::Value base = val;
1556   mlir::IndexType indexType = builder.getIndexType();
1557   llvm::SmallVector<mlir::Value> extents;
1558 
1559   fir::factory::CharacterExprHelper charHelper{builder, loc};
1560   // FIXME: we may want to allow non character scalar here.
1561   if (charHelper.isCharacterScalar(type))
1562     return charHelper.toExtendedValue(val);
1563 
1564   if (auto refType = type.dyn_cast<fir::ReferenceType>())
1565     type = refType.getEleTy();
1566 
1567   if (auto arrayType = type.dyn_cast<fir::SequenceType>()) {
1568     type = arrayType.getEleTy();
1569     for (fir::SequenceType::Extent extent : arrayType.getShape()) {
1570       if (extent == fir::SequenceType::getUnknownExtent())
1571         break;
1572       extents.emplace_back(
1573           builder.createIntegerConstant(loc, indexType, extent));
1574     }
1575     // Last extent might be missing in case of assumed-size. If more extents
1576     // could not be deduced from type, that's an error (a fir.box should
1577     // have been used in the interface).
1578     if (extents.size() + 1 < arrayType.getShape().size())
1579       mlir::emitError(loc, "cannot retrieve array extents from type");
1580   } else if (type.isa<fir::BoxType>() || type.isa<fir::RecordType>()) {
1581     fir::emitFatalError(loc, "not yet implemented: descriptor or derived type");
1582   }
1583 
1584   if (!extents.empty())
1585     return fir::ArrayBoxValue{base, extents};
1586   return base;
1587 }
1588 
1589 mlir::Value toValue(const fir::ExtendedValue &val, fir::FirOpBuilder &builder,
1590                     mlir::Location loc) {
1591   if (const fir::CharBoxValue *charBox = val.getCharBox()) {
1592     mlir::Value buffer = charBox->getBuffer();
1593     auto buffTy = buffer.getType();
1594     if (buffTy.isa<mlir::FunctionType>())
1595       fir::emitFatalError(
1596           loc, "A character's buffer type cannot be a function type.");
1597     if (buffTy.isa<fir::BoxCharType>())
1598       return buffer;
1599     return fir::factory::CharacterExprHelper{builder, loc}.createEmboxChar(
1600         buffer, charBox->getLen());
1601   }
1602 
1603   // FIXME: need to access other ExtendedValue variants and handle them
1604   // properly.
1605   return fir::getBase(val);
1606 }
1607 
1608 //===----------------------------------------------------------------------===//
1609 // IntrinsicLibrary
1610 //===----------------------------------------------------------------------===//
1611 
1612 static bool isIntrinsicModuleProcedure(llvm::StringRef name) {
1613   return name.startswith("c_") || name.startswith("compiler_") ||
1614          name.startswith("ieee_");
1615 }
1616 
1617 /// Return the generic name of an intrinsic module procedure specific name.
1618 /// Remove any "__builtin_" prefix, and any specific suffix of the form
1619 /// {_[ail]?[0-9]+}*, such as _1 or _a4.
1620 llvm::StringRef genericName(llvm::StringRef specificName) {
1621   const std::string builtin = "__builtin_";
1622   llvm::StringRef name = specificName.startswith(builtin)
1623                              ? specificName.drop_front(builtin.size())
1624                              : specificName;
1625   size_t size = name.size();
1626   if (isIntrinsicModuleProcedure(name))
1627     while (isdigit(name[size - 1]))
1628       while (name[--size] != '_')
1629         ;
1630   return name.drop_back(name.size() - size);
1631 }
1632 
1633 /// Generate a TODO error message for an as yet unimplemented intrinsic.
1634 void crashOnMissingIntrinsic(mlir::Location loc, llvm::StringRef name) {
1635   if (isIntrinsicModuleProcedure(name))
1636     TODO(loc, "intrinsic module procedure: " + llvm::Twine(name));
1637   else
1638     TODO(loc, "intrinsic: " + llvm::Twine(name));
1639 }
1640 
1641 template <typename GeneratorType>
1642 fir::ExtendedValue IntrinsicLibrary::genElementalCall(
1643     GeneratorType generator, llvm::StringRef name, mlir::Type resultType,
1644     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1645   llvm::SmallVector<mlir::Value> scalarArgs;
1646   for (const fir::ExtendedValue &arg : args)
1647     if (arg.getUnboxed() || arg.getCharBox())
1648       scalarArgs.emplace_back(fir::getBase(arg));
1649     else
1650       fir::emitFatalError(loc, "nonscalar intrinsic argument");
1651   if (outline)
1652     return outlineInWrapper(generator, name, resultType, scalarArgs);
1653   return invokeGenerator(generator, resultType, scalarArgs);
1654 }
1655 
1656 template <>
1657 fir::ExtendedValue
1658 IntrinsicLibrary::genElementalCall<IntrinsicLibrary::ExtendedGenerator>(
1659     ExtendedGenerator generator, llvm::StringRef name, mlir::Type resultType,
1660     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1661   for (const fir::ExtendedValue &arg : args)
1662     if (!arg.getUnboxed() && !arg.getCharBox())
1663       fir::emitFatalError(loc, "nonscalar intrinsic argument");
1664   if (outline)
1665     return outlineInExtendedWrapper(generator, name, resultType, args);
1666   return std::invoke(generator, *this, resultType, args);
1667 }
1668 
1669 template <>
1670 fir::ExtendedValue
1671 IntrinsicLibrary::genElementalCall<IntrinsicLibrary::SubroutineGenerator>(
1672     SubroutineGenerator generator, llvm::StringRef name, mlir::Type resultType,
1673     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1674   for (const fir::ExtendedValue &arg : args)
1675     if (!arg.getUnboxed() && !arg.getCharBox())
1676       // fir::emitFatalError(loc, "nonscalar intrinsic argument");
1677       crashOnMissingIntrinsic(loc, name);
1678   if (outline)
1679     return outlineInExtendedWrapper(generator, name, resultType, args);
1680   std::invoke(generator, *this, args);
1681   return mlir::Value();
1682 }
1683 
1684 static fir::ExtendedValue
1685 invokeHandler(IntrinsicLibrary::ElementalGenerator generator,
1686               const IntrinsicHandler &handler,
1687               llvm::Optional<mlir::Type> resultType,
1688               llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1689               IntrinsicLibrary &lib) {
1690   assert(resultType && "expect elemental intrinsic to be functions");
1691   return lib.genElementalCall(generator, handler.name, *resultType, args,
1692                               outline);
1693 }
1694 
1695 static fir::ExtendedValue
1696 invokeHandler(IntrinsicLibrary::ExtendedGenerator generator,
1697               const IntrinsicHandler &handler,
1698               llvm::Optional<mlir::Type> resultType,
1699               llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1700               IntrinsicLibrary &lib) {
1701   assert(resultType && "expect intrinsic function");
1702   if (handler.isElemental)
1703     return lib.genElementalCall(generator, handler.name, *resultType, args,
1704                                 outline);
1705   if (outline)
1706     return lib.outlineInExtendedWrapper(generator, handler.name, *resultType,
1707                                         args);
1708   return std::invoke(generator, lib, *resultType, args);
1709 }
1710 
1711 static fir::ExtendedValue
1712 invokeHandler(IntrinsicLibrary::SubroutineGenerator generator,
1713               const IntrinsicHandler &handler,
1714               llvm::Optional<mlir::Type> resultType,
1715               llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1716               IntrinsicLibrary &lib) {
1717   if (handler.isElemental)
1718     return lib.genElementalCall(generator, handler.name, mlir::Type{}, args,
1719                                 outline);
1720   if (outline)
1721     return lib.outlineInExtendedWrapper(generator, handler.name, resultType,
1722                                         args);
1723   std::invoke(generator, lib, args);
1724   return mlir::Value{};
1725 }
1726 
1727 fir::ExtendedValue
1728 IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName,
1729                                    llvm::Optional<mlir::Type> resultType,
1730                                    llvm::ArrayRef<fir::ExtendedValue> args) {
1731   llvm::StringRef name = genericName(specificName);
1732   if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) {
1733     bool outline = handler->outline || outlineAllIntrinsics;
1734     return std::visit(
1735         [&](auto &generator) -> fir::ExtendedValue {
1736           return invokeHandler(generator, *handler, resultType, args, outline,
1737                                *this);
1738         },
1739         handler->generator);
1740   }
1741 
1742   if (!resultType)
1743     // Subroutine should have a handler, they are likely missing for now.
1744     crashOnMissingIntrinsic(loc, name);
1745 
1746   // Try the runtime if no special handler was defined for the
1747   // intrinsic being called. Maths runtime only has numerical elemental.
1748   // No optional arguments are expected at this point, the code will
1749   // crash if it gets absent optional.
1750 
1751   // FIXME: using toValue to get the type won't work with array arguments.
1752   llvm::SmallVector<mlir::Value> mlirArgs;
1753   for (const fir::ExtendedValue &extendedVal : args) {
1754     mlir::Value val = toValue(extendedVal, builder, loc);
1755     if (!val)
1756       // If an absent optional gets there, most likely its handler has just
1757       // not yet been defined.
1758       crashOnMissingIntrinsic(loc, name);
1759     mlirArgs.emplace_back(val);
1760   }
1761   mlir::FunctionType soughtFuncType =
1762       getFunctionType(*resultType, mlirArgs, builder);
1763 
1764   IntrinsicLibrary::RuntimeCallGenerator runtimeCallGenerator =
1765       getRuntimeCallGenerator(name, soughtFuncType);
1766   return genElementalCall(runtimeCallGenerator, name, *resultType, args,
1767                           /*outline=*/outlineAllIntrinsics);
1768 }
1769 
1770 mlir::Value
1771 IntrinsicLibrary::invokeGenerator(ElementalGenerator generator,
1772                                   mlir::Type resultType,
1773                                   llvm::ArrayRef<mlir::Value> args) {
1774   return std::invoke(generator, *this, resultType, args);
1775 }
1776 
1777 mlir::Value
1778 IntrinsicLibrary::invokeGenerator(RuntimeCallGenerator generator,
1779                                   mlir::Type resultType,
1780                                   llvm::ArrayRef<mlir::Value> args) {
1781   return generator(builder, loc, args);
1782 }
1783 
1784 mlir::Value
1785 IntrinsicLibrary::invokeGenerator(ExtendedGenerator generator,
1786                                   mlir::Type resultType,
1787                                   llvm::ArrayRef<mlir::Value> args) {
1788   llvm::SmallVector<fir::ExtendedValue> extendedArgs;
1789   for (mlir::Value arg : args)
1790     extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
1791   auto extendedResult = std::invoke(generator, *this, resultType, extendedArgs);
1792   return toValue(extendedResult, builder, loc);
1793 }
1794 
1795 mlir::Value
1796 IntrinsicLibrary::invokeGenerator(SubroutineGenerator generator,
1797                                   llvm::ArrayRef<mlir::Value> args) {
1798   llvm::SmallVector<fir::ExtendedValue> extendedArgs;
1799   for (mlir::Value arg : args)
1800     extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
1801   std::invoke(generator, *this, extendedArgs);
1802   return {};
1803 }
1804 
1805 template <typename GeneratorType>
1806 mlir::func::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator,
1807                                                 llvm::StringRef name,
1808                                                 mlir::FunctionType funcType,
1809                                                 bool loadRefArguments) {
1810   std::string wrapperName = fir::mangleIntrinsicProcedure(name, funcType);
1811   mlir::func::FuncOp function = builder.getNamedFunction(wrapperName);
1812   if (!function) {
1813     // First time this wrapper is needed, build it.
1814     function = builder.createFunction(loc, wrapperName, funcType);
1815     function->setAttr("fir.intrinsic", builder.getUnitAttr());
1816     auto internalLinkage = mlir::LLVM::linkage::Linkage::Internal;
1817     auto linkage =
1818         mlir::LLVM::LinkageAttr::get(builder.getContext(), internalLinkage);
1819     function->setAttr("llvm.linkage", linkage);
1820     function.addEntryBlock();
1821 
1822     // Create local context to emit code into the newly created function
1823     // This new function is not linked to a source file location, only
1824     // its calls will be.
1825     auto localBuilder =
1826         std::make_unique<fir::FirOpBuilder>(function, builder.getKindMap());
1827     localBuilder->setInsertionPointToStart(&function.front());
1828     // Location of code inside wrapper of the wrapper is independent from
1829     // the location of the intrinsic call.
1830     mlir::Location localLoc = localBuilder->getUnknownLoc();
1831     llvm::SmallVector<mlir::Value> localArguments;
1832     for (mlir::BlockArgument bArg : function.front().getArguments()) {
1833       auto refType = bArg.getType().dyn_cast<fir::ReferenceType>();
1834       if (loadRefArguments && refType) {
1835         auto loaded = localBuilder->create<fir::LoadOp>(localLoc, bArg);
1836         localArguments.push_back(loaded);
1837       } else {
1838         localArguments.push_back(bArg);
1839       }
1840     }
1841 
1842     IntrinsicLibrary localLib{*localBuilder, localLoc};
1843 
1844     if constexpr (std::is_same_v<GeneratorType, SubroutineGenerator>) {
1845       localLib.invokeGenerator(generator, localArguments);
1846       localBuilder->create<mlir::func::ReturnOp>(localLoc);
1847     } else {
1848       assert(funcType.getNumResults() == 1 &&
1849              "expect one result for intrinsic function wrapper type");
1850       mlir::Type resultType = funcType.getResult(0);
1851       auto result =
1852           localLib.invokeGenerator(generator, resultType, localArguments);
1853       localBuilder->create<mlir::func::ReturnOp>(localLoc, result);
1854     }
1855   } else {
1856     // Wrapper was already built, ensure it has the sought type
1857     assert(function.getFunctionType() == funcType &&
1858            "conflict between intrinsic wrapper types");
1859   }
1860   return function;
1861 }
1862 
1863 /// Helpers to detect absent optional (not yet supported in outlining).
1864 bool static hasAbsentOptional(llvm::ArrayRef<mlir::Value> args) {
1865   for (const mlir::Value &arg : args)
1866     if (!arg)
1867       return true;
1868   return false;
1869 }
1870 bool static hasAbsentOptional(llvm::ArrayRef<fir::ExtendedValue> args) {
1871   for (const fir::ExtendedValue &arg : args)
1872     if (!fir::getBase(arg))
1873       return true;
1874   return false;
1875 }
1876 
1877 template <typename GeneratorType>
1878 mlir::Value
1879 IntrinsicLibrary::outlineInWrapper(GeneratorType generator,
1880                                    llvm::StringRef name, mlir::Type resultType,
1881                                    llvm::ArrayRef<mlir::Value> args) {
1882   if (hasAbsentOptional(args)) {
1883     // TODO: absent optional in outlining is an issue: we cannot just ignore
1884     // them. Needs a better interface here. The issue is that we cannot easily
1885     // tell that a value is optional or not here if it is presents. And if it is
1886     // absent, we cannot tell what it type should be.
1887     TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) +
1888                   " with absent optional argument");
1889   }
1890 
1891   mlir::FunctionType funcType = getFunctionType(resultType, args, builder);
1892   mlir::func::FuncOp wrapper = getWrapper(generator, name, funcType);
1893   return builder.create<fir::CallOp>(loc, wrapper, args).getResult(0);
1894 }
1895 
1896 template <typename GeneratorType>
1897 fir::ExtendedValue IntrinsicLibrary::outlineInExtendedWrapper(
1898     GeneratorType generator, llvm::StringRef name,
1899     llvm::Optional<mlir::Type> resultType,
1900     llvm::ArrayRef<fir::ExtendedValue> args) {
1901   if (hasAbsentOptional(args))
1902     TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) +
1903                   " with absent optional argument");
1904   llvm::SmallVector<mlir::Value> mlirArgs;
1905   for (const auto &extendedVal : args)
1906     mlirArgs.emplace_back(toValue(extendedVal, builder, loc));
1907   mlir::FunctionType funcType = getFunctionType(resultType, mlirArgs, builder);
1908   mlir::func::FuncOp wrapper = getWrapper(generator, name, funcType);
1909   auto call = builder.create<fir::CallOp>(loc, wrapper, mlirArgs);
1910   if (resultType)
1911     return toExtendedValue(call.getResult(0), builder, loc);
1912   // Subroutine calls
1913   return mlir::Value{};
1914 }
1915 
1916 IntrinsicLibrary::RuntimeCallGenerator
1917 IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,
1918                                           mlir::FunctionType soughtFuncType) {
1919   mlir::func::FuncOp funcOp;
1920   mlir::FunctionType actualFuncType;
1921   const MathOperation *mathOp = nullptr;
1922 
1923   // Look for a dedicated math operation generator, which
1924   // normally produces a single MLIR operation implementing
1925   // the math operation.
1926   // If not found fall back to a runtime function lookup.
1927   const MathOperation *bestNearMatch = nullptr;
1928   FunctionDistance bestMatchDistance;
1929   mathOp = searchMathOperation(builder, name, soughtFuncType, &bestNearMatch,
1930                                bestMatchDistance);
1931   if (!mathOp && bestNearMatch) {
1932     // Use the best near match, optionally issuing an error,
1933     // if types conversions cause precision loss.
1934     bool useBestNearMatch = true;
1935     // TODO: temporary workaround to avoid using math::PowFOp
1936     //       for pow(fp, i64) case and fall back to pgmath runtime.
1937     //       When proper Math dialect operations are available
1938     //       and added into mathOperations table, this can be removed.
1939     //       This is WIP in D129812.
1940     if (name == "pow" && soughtFuncType.getInput(0).isa<mlir::FloatType>())
1941       if (auto exponentTy =
1942               soughtFuncType.getInput(1).dyn_cast<mlir::IntegerType>())
1943         useBestNearMatch = exponentTy.getWidth() != 64;
1944 
1945     if (useBestNearMatch) {
1946       checkPrecisionLoss(name, soughtFuncType, bestMatchDistance, loc);
1947       mathOp = bestNearMatch;
1948     }
1949   }
1950   if (mathOp)
1951     actualFuncType = mathOp->typeGenerator(builder.getContext());
1952 
1953   if (!mathOp)
1954     if ((funcOp = getRuntimeFunction(loc, builder, name, soughtFuncType)))
1955       actualFuncType = funcOp.getFunctionType();
1956 
1957   if (!mathOp && !funcOp) {
1958     std::string nameAndType;
1959     llvm::raw_string_ostream sstream(nameAndType);
1960     sstream << name << "\nrequested type: " << soughtFuncType;
1961     crashOnMissingIntrinsic(loc, nameAndType);
1962   }
1963 
1964   assert(actualFuncType.getNumResults() == soughtFuncType.getNumResults() &&
1965          actualFuncType.getNumInputs() == soughtFuncType.getNumInputs() &&
1966          actualFuncType.getNumResults() == 1 && "Bad intrinsic match");
1967 
1968   return [funcOp, actualFuncType, mathOp,
1969           soughtFuncType](fir::FirOpBuilder &builder, mlir::Location loc,
1970                           llvm::ArrayRef<mlir::Value> args) {
1971     llvm::SmallVector<mlir::Value> convertedArguments;
1972     for (auto [fst, snd] : llvm::zip(actualFuncType.getInputs(), args))
1973       convertedArguments.push_back(builder.createConvert(loc, fst, snd));
1974     mlir::Value result;
1975     // Use math operation generator, if available.
1976     if (mathOp)
1977       result = mathOp->funcGenerator(builder, loc, mathOp->runtimeFunc,
1978                                      actualFuncType, convertedArguments);
1979     else
1980       result = builder.create<fir::CallOp>(loc, funcOp, convertedArguments)
1981                    .getResult(0);
1982     mlir::Type soughtType = soughtFuncType.getResult(0);
1983     return builder.createConvert(loc, soughtType, result);
1984   };
1985 }
1986 
1987 mlir::SymbolRefAttr IntrinsicLibrary::getUnrestrictedIntrinsicSymbolRefAttr(
1988     llvm::StringRef name, mlir::FunctionType signature) {
1989   // Unrestricted intrinsics signature follows implicit rules: argument
1990   // are passed by references. But the runtime versions expect values.
1991   // So instead of duplicating the runtime, just have the wrappers loading
1992   // this before calling the code generators.
1993   bool loadRefArguments = true;
1994   mlir::func::FuncOp funcOp;
1995   if (const IntrinsicHandler *handler = findIntrinsicHandler(name))
1996     funcOp = std::visit(
1997         [&](auto generator) {
1998           return getWrapper(generator, name, signature, loadRefArguments);
1999         },
2000         handler->generator);
2001 
2002   if (!funcOp) {
2003     llvm::SmallVector<mlir::Type> argTypes;
2004     for (mlir::Type type : signature.getInputs()) {
2005       if (auto refType = type.dyn_cast<fir::ReferenceType>())
2006         argTypes.push_back(refType.getEleTy());
2007       else
2008         argTypes.push_back(type);
2009     }
2010     mlir::FunctionType soughtFuncType =
2011         builder.getFunctionType(argTypes, signature.getResults());
2012     IntrinsicLibrary::RuntimeCallGenerator rtCallGenerator =
2013         getRuntimeCallGenerator(name, soughtFuncType);
2014     funcOp = getWrapper(rtCallGenerator, name, signature, loadRefArguments);
2015   }
2016 
2017   return mlir::SymbolRefAttr::get(funcOp);
2018 }
2019 
2020 void IntrinsicLibrary::addCleanUpForTemp(mlir::Location loc, mlir::Value temp) {
2021   assert(stmtCtx);
2022   fir::FirOpBuilder *bldr = &builder;
2023   stmtCtx->attachCleanup([=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
2024 }
2025 
2026 fir::ExtendedValue
2027 IntrinsicLibrary::readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,
2028                                     mlir::Type resultType,
2029                                     llvm::StringRef intrinsicName) {
2030   fir::ExtendedValue res =
2031       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
2032   return res.match(
2033       [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2034         // Add cleanup code
2035         addCleanUpForTemp(loc, box.getAddr());
2036         return box;
2037       },
2038       [&](const fir::BoxValue &box) -> fir::ExtendedValue {
2039         // Add cleanup code
2040         auto addr =
2041             builder.create<fir::BoxAddrOp>(loc, box.getMemTy(), box.getAddr());
2042         addCleanUpForTemp(loc, addr);
2043         return box;
2044       },
2045       [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue {
2046         // Add cleanup code
2047         addCleanUpForTemp(loc, box.getAddr());
2048         return box;
2049       },
2050       [&](const mlir::Value &tempAddr) -> fir::ExtendedValue {
2051         // Add cleanup code
2052         addCleanUpForTemp(loc, tempAddr);
2053         return builder.create<fir::LoadOp>(loc, resultType, tempAddr);
2054       },
2055       [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
2056         // Add cleanup code
2057         addCleanUpForTemp(loc, box.getAddr());
2058         return box;
2059       },
2060       [&](const auto &) -> fir::ExtendedValue {
2061         fir::emitFatalError(loc, "unexpected result for " + intrinsicName);
2062       });
2063 }
2064 
2065 //===----------------------------------------------------------------------===//
2066 // Code generators for the intrinsic
2067 //===----------------------------------------------------------------------===//
2068 
2069 mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name,
2070                                              mlir::Type resultType,
2071                                              llvm::ArrayRef<mlir::Value> args) {
2072   mlir::FunctionType soughtFuncType =
2073       getFunctionType(resultType, args, builder);
2074   return getRuntimeCallGenerator(name, soughtFuncType)(builder, loc, args);
2075 }
2076 
2077 mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType,
2078                                             llvm::ArrayRef<mlir::Value> args) {
2079   // There can be an optional kind in second argument.
2080   assert(args.size() >= 1);
2081   return builder.convertWithSemantics(loc, resultType, args[0]);
2082 }
2083 
2084 // ABS
2085 mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType,
2086                                      llvm::ArrayRef<mlir::Value> args) {
2087   assert(args.size() == 1);
2088   mlir::Value arg = args[0];
2089   mlir::Type type = arg.getType();
2090   if (fir::isa_real(type)) {
2091     // Runtime call to fp abs. An alternative would be to use mlir
2092     // math::AbsFOp but it does not support all fir floating point types.
2093     return genRuntimeCall("abs", resultType, args);
2094   }
2095   if (auto intType = type.dyn_cast<mlir::IntegerType>()) {
2096     // At the time of this implementation there is no abs op in mlir.
2097     // So, implement abs here without branching.
2098     mlir::Value shift =
2099         builder.createIntegerConstant(loc, intType, intType.getWidth() - 1);
2100     auto mask = builder.create<mlir::arith::ShRSIOp>(loc, arg, shift);
2101     auto xored = builder.create<mlir::arith::XOrIOp>(loc, arg, mask);
2102     return builder.create<mlir::arith::SubIOp>(loc, xored, mask);
2103   }
2104   if (fir::isa_complex(type)) {
2105     // Use HYPOT to fulfill the no underflow/overflow requirement.
2106     auto parts = fir::factory::Complex{builder, loc}.extractParts(arg);
2107     llvm::SmallVector<mlir::Value> args = {parts.first, parts.second};
2108     return genRuntimeCall("hypot", resultType, args);
2109   }
2110   llvm_unreachable("unexpected type in ABS argument");
2111 }
2112 
2113 // ADJUSTL & ADJUSTR
2114 template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc,
2115                               mlir::Value, mlir::Value)>
2116 fir::ExtendedValue
2117 IntrinsicLibrary::genAdjustRtCall(mlir::Type resultType,
2118                                   llvm::ArrayRef<fir::ExtendedValue> args) {
2119   assert(args.size() == 1);
2120   mlir::Value string = builder.createBox(loc, args[0]);
2121   // Create a mutable fir.box to be passed to the runtime for the result.
2122   fir::MutableBoxValue resultMutableBox =
2123       fir::factory::createTempMutableBox(builder, loc, resultType);
2124   mlir::Value resultIrBox =
2125       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2126 
2127   // Call the runtime -- the runtime will allocate the result.
2128   CallRuntime(builder, loc, resultIrBox, string);
2129 
2130   // Read result from mutable fir.box and add it to the list of temps to be
2131   // finalized by the StatementContext.
2132   fir::ExtendedValue res =
2133       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
2134   return res.match(
2135       [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
2136         addCleanUpForTemp(loc, fir::getBase(box));
2137         return box;
2138       },
2139       [&](const auto &) -> fir::ExtendedValue {
2140         fir::emitFatalError(loc, "result of ADJUSTL is not a scalar character");
2141       });
2142 }
2143 
2144 // AIMAG
2145 mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType,
2146                                        llvm::ArrayRef<mlir::Value> args) {
2147   assert(args.size() == 1);
2148   return fir::factory::Complex{builder, loc}.extractComplexPart(
2149       args[0], /*isImagPart=*/true);
2150 }
2151 
2152 // AINT
2153 mlir::Value IntrinsicLibrary::genAint(mlir::Type resultType,
2154                                       llvm::ArrayRef<mlir::Value> args) {
2155   assert(args.size() >= 1 && args.size() <= 2);
2156   // Skip optional kind argument to search the runtime; it is already reflected
2157   // in result type.
2158   return genRuntimeCall("aint", resultType, {args[0]});
2159 }
2160 
2161 // ALL
2162 fir::ExtendedValue
2163 IntrinsicLibrary::genAll(mlir::Type resultType,
2164                          llvm::ArrayRef<fir::ExtendedValue> args) {
2165 
2166   assert(args.size() == 2);
2167   // Handle required mask argument
2168   mlir::Value mask = builder.createBox(loc, args[0]);
2169 
2170   fir::BoxValue maskArry = builder.createBox(loc, args[0]);
2171   int rank = maskArry.rank();
2172   assert(rank >= 1);
2173 
2174   // Handle optional dim argument
2175   bool absentDim = isStaticallyAbsent(args[1]);
2176   mlir::Value dim =
2177       absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2178                 : fir::getBase(args[1]);
2179 
2180   if (rank == 1 || absentDim)
2181     return builder.createConvert(loc, resultType,
2182                                  fir::runtime::genAll(builder, loc, mask, dim));
2183 
2184   // else use the result descriptor AllDim() intrinsic
2185 
2186   // Create mutable fir.box to be passed to the runtime for the result.
2187 
2188   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
2189   fir::MutableBoxValue resultMutableBox =
2190       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2191   mlir::Value resultIrBox =
2192       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2193 
2194   // Call runtime. The runtime is allocating the result.
2195   fir::runtime::genAllDescriptor(builder, loc, resultIrBox, mask, dim);
2196   return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
2197       .match(
2198           [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2199             addCleanUpForTemp(loc, box.getAddr());
2200             return box;
2201           },
2202           [&](const auto &) -> fir::ExtendedValue {
2203             fir::emitFatalError(loc, "Invalid result for ALL");
2204           });
2205 }
2206 
2207 // ALLOCATED
2208 fir::ExtendedValue
2209 IntrinsicLibrary::genAllocated(mlir::Type resultType,
2210                                llvm::ArrayRef<fir::ExtendedValue> args) {
2211   assert(args.size() == 1);
2212   return args[0].match(
2213       [&](const fir::MutableBoxValue &x) -> fir::ExtendedValue {
2214         return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, x);
2215       },
2216       [&](const auto &) -> fir::ExtendedValue {
2217         fir::emitFatalError(loc,
2218                             "allocated arg not lowered to MutableBoxValue");
2219       });
2220 }
2221 
2222 // ANINT
2223 mlir::Value IntrinsicLibrary::genAnint(mlir::Type resultType,
2224                                        llvm::ArrayRef<mlir::Value> args) {
2225   assert(args.size() >= 1 && args.size() <= 2);
2226   // Skip optional kind argument to search the runtime; it is already reflected
2227   // in result type.
2228   return genRuntimeCall("anint", resultType, {args[0]});
2229 }
2230 
2231 // ANY
2232 fir::ExtendedValue
2233 IntrinsicLibrary::genAny(mlir::Type resultType,
2234                          llvm::ArrayRef<fir::ExtendedValue> args) {
2235 
2236   assert(args.size() == 2);
2237   // Handle required mask argument
2238   mlir::Value mask = builder.createBox(loc, args[0]);
2239 
2240   fir::BoxValue maskArry = builder.createBox(loc, args[0]);
2241   int rank = maskArry.rank();
2242   assert(rank >= 1);
2243 
2244   // Handle optional dim argument
2245   bool absentDim = isStaticallyAbsent(args[1]);
2246   mlir::Value dim =
2247       absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2248                 : fir::getBase(args[1]);
2249 
2250   if (rank == 1 || absentDim)
2251     return builder.createConvert(loc, resultType,
2252                                  fir::runtime::genAny(builder, loc, mask, dim));
2253 
2254   // else use the result descriptor AnyDim() intrinsic
2255 
2256   // Create mutable fir.box to be passed to the runtime for the result.
2257 
2258   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
2259   fir::MutableBoxValue resultMutableBox =
2260       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2261   mlir::Value resultIrBox =
2262       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2263 
2264   // Call runtime. The runtime is allocating the result.
2265   fir::runtime::genAnyDescriptor(builder, loc, resultIrBox, mask, dim);
2266   return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
2267       .match(
2268           [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2269             addCleanUpForTemp(loc, box.getAddr());
2270             return box;
2271           },
2272           [&](const auto &) -> fir::ExtendedValue {
2273             fir::emitFatalError(loc, "Invalid result for ANY");
2274           });
2275 }
2276 
2277 // ASSOCIATED
2278 fir::ExtendedValue
2279 IntrinsicLibrary::genAssociated(mlir::Type resultType,
2280                                 llvm::ArrayRef<fir::ExtendedValue> args) {
2281   assert(args.size() == 2);
2282   auto *pointer =
2283       args[0].match([&](const fir::MutableBoxValue &x) { return &x; },
2284                     [&](const auto &) -> const fir::MutableBoxValue * {
2285                       fir::emitFatalError(loc, "pointer not a MutableBoxValue");
2286                     });
2287   const fir::ExtendedValue &target = args[1];
2288   if (isStaticallyAbsent(target))
2289     return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *pointer);
2290 
2291   mlir::Value targetBox = builder.createBox(loc, target);
2292   if (fir::valueHasFirAttribute(fir::getBase(target),
2293                                 fir::getOptionalAttrName())) {
2294     // Subtle: contrary to other intrinsic optional arguments, disassociated
2295     // POINTER and unallocated ALLOCATABLE actual argument are not considered
2296     // absent here. This is because ASSOCIATED has special requirements for
2297     // TARGET actual arguments that are POINTERs. There is no precise
2298     // requirements for ALLOCATABLEs, but all existing Fortran compilers treat
2299     // them similarly to POINTERs. That is: unallocated TARGETs cause ASSOCIATED
2300     // to rerun false.  The runtime deals with the disassociated/unallocated
2301     // case. Simply ensures that TARGET that are OPTIONAL get conditionally
2302     // emboxed here to convey the optional aspect to the runtime.
2303     auto isPresent = builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
2304                                                       fir::getBase(target));
2305     auto absentBox = builder.create<fir::AbsentOp>(loc, targetBox.getType());
2306     targetBox = builder.create<mlir::arith::SelectOp>(loc, isPresent, targetBox,
2307                                                       absentBox);
2308   }
2309   mlir::Value pointerBoxRef =
2310       fir::factory::getMutableIRBox(builder, loc, *pointer);
2311   auto pointerBox = builder.create<fir::LoadOp>(loc, pointerBoxRef);
2312   return Fortran::lower::genAssociated(builder, loc, pointerBox, targetBox);
2313 }
2314 
2315 // BGE, BGT, BLE, BLT
2316 template <mlir::arith::CmpIPredicate pred>
2317 mlir::Value
2318 IntrinsicLibrary::genBitwiseCompare(mlir::Type resultType,
2319                                     llvm::ArrayRef<mlir::Value> args) {
2320   assert(args.size() == 2);
2321 
2322   mlir::Value arg0 = args[0];
2323   mlir::Value arg1 = args[1];
2324   mlir::Type arg0Ty = arg0.getType();
2325   mlir::Type arg1Ty = arg1.getType();
2326   unsigned bits0 = arg0Ty.getIntOrFloatBitWidth();
2327   unsigned bits1 = arg1Ty.getIntOrFloatBitWidth();
2328 
2329   // Arguments do not have to be of the same integer type. However, if neither
2330   // of the arguments is a BOZ literal, then the shorter of the two needs
2331   // to be converted to the longer by zero-extending (not sign-extending)
2332   // to the left [Fortran 2008, 13.3.2].
2333   //
2334   // In the case of BOZ literals, the standard describes zero-extension or
2335   // truncation depending on the kind of the result [Fortran 2008, 13.3.3].
2336   // However, that seems to be relevant for the case where the type of the
2337   // result must match the type of the BOZ literal. That is not the case for
2338   // these intrinsics, so, again, zero-extend to the larger type.
2339   //
2340   if (bits0 > bits1)
2341     arg1 = builder.create<mlir::arith::ExtUIOp>(loc, arg0Ty, arg1);
2342   else if (bits0 < bits1)
2343     arg0 = builder.create<mlir::arith::ExtUIOp>(loc, arg1Ty, arg0);
2344 
2345   return builder.create<mlir::arith::CmpIOp>(loc, pred, arg0, arg1);
2346 }
2347 
2348 // BTEST
2349 mlir::Value IntrinsicLibrary::genBtest(mlir::Type resultType,
2350                                        llvm::ArrayRef<mlir::Value> args) {
2351   // A conformant BTEST(I,POS) call satisfies:
2352   //     POS >= 0
2353   //     POS < BIT_SIZE(I)
2354   // Return:  (I >> POS) & 1
2355   assert(args.size() == 2);
2356   mlir::Type argType = args[0].getType();
2357   mlir::Value pos = builder.createConvert(loc, argType, args[1]);
2358   auto shift = builder.create<mlir::arith::ShRUIOp>(loc, args[0], pos);
2359   mlir::Value one = builder.createIntegerConstant(loc, argType, 1);
2360   auto res = builder.create<mlir::arith::AndIOp>(loc, shift, one);
2361   return builder.createConvert(loc, resultType, res);
2362 }
2363 
2364 // CEILING
2365 mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType,
2366                                          llvm::ArrayRef<mlir::Value> args) {
2367   // Optional KIND argument.
2368   assert(args.size() >= 1);
2369   mlir::Value arg = args[0];
2370   // Use ceil that is not an actual Fortran intrinsic but that is
2371   // an llvm intrinsic that does the same, but return a floating
2372   // point.
2373   mlir::Value ceil = genRuntimeCall("ceil", arg.getType(), {arg});
2374   return builder.createConvert(loc, resultType, ceil);
2375 }
2376 
2377 // CHAR
2378 fir::ExtendedValue
2379 IntrinsicLibrary::genChar(mlir::Type type,
2380                           llvm::ArrayRef<fir::ExtendedValue> args) {
2381   // Optional KIND argument.
2382   assert(args.size() >= 1);
2383   const mlir::Value *arg = args[0].getUnboxed();
2384   // expect argument to be a scalar integer
2385   if (!arg)
2386     mlir::emitError(loc, "CHAR intrinsic argument not unboxed");
2387   fir::factory::CharacterExprHelper helper{builder, loc};
2388   fir::CharacterType::KindTy kind = helper.getCharacterType(type).getFKind();
2389   mlir::Value cast = helper.createSingletonFromCode(*arg, kind);
2390   mlir::Value len =
2391       builder.createIntegerConstant(loc, builder.getCharacterLengthType(), 1);
2392   return fir::CharBoxValue{cast, len};
2393 }
2394 
2395 // CMPLX
2396 mlir::Value IntrinsicLibrary::genCmplx(mlir::Type resultType,
2397                                        llvm::ArrayRef<mlir::Value> args) {
2398   assert(args.size() >= 1);
2399   fir::factory::Complex complexHelper(builder, loc);
2400   mlir::Type partType = complexHelper.getComplexPartType(resultType);
2401   mlir::Value real = builder.createConvert(loc, partType, args[0]);
2402   mlir::Value imag = isStaticallyAbsent(args, 1)
2403                          ? builder.createRealZeroConstant(loc, partType)
2404                          : builder.createConvert(loc, partType, args[1]);
2405   return fir::factory::Complex{builder, loc}.createComplex(resultType, real,
2406                                                            imag);
2407 }
2408 
2409 // COMMAND_ARGUMENT_COUNT
2410 fir::ExtendedValue IntrinsicLibrary::genCommandArgumentCount(
2411     mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
2412   assert(args.size() == 0);
2413   assert(resultType == builder.getDefaultIntegerType() &&
2414          "result type is not default integer kind type");
2415   return builder.createConvert(
2416       loc, resultType, fir::runtime::genCommandArgumentCount(builder, loc));
2417   ;
2418 }
2419 
2420 // CONJG
2421 mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType,
2422                                        llvm::ArrayRef<mlir::Value> args) {
2423   assert(args.size() == 1);
2424   if (resultType != args[0].getType())
2425     llvm_unreachable("argument type mismatch");
2426 
2427   mlir::Value cplx = args[0];
2428   auto imag = fir::factory::Complex{builder, loc}.extractComplexPart(
2429       cplx, /*isImagPart=*/true);
2430   auto negImag = builder.create<mlir::arith::NegFOp>(loc, imag);
2431   return fir::factory::Complex{builder, loc}.insertComplexPart(
2432       cplx, negImag, /*isImagPart=*/true);
2433 }
2434 
2435 // COUNT
2436 fir::ExtendedValue
2437 IntrinsicLibrary::genCount(mlir::Type resultType,
2438                            llvm::ArrayRef<fir::ExtendedValue> args) {
2439   assert(args.size() == 3);
2440 
2441   // Handle mask argument
2442   fir::BoxValue mask = builder.createBox(loc, args[0]);
2443   unsigned maskRank = mask.rank();
2444 
2445   assert(maskRank > 0);
2446 
2447   // Handle optional dim argument
2448   bool absentDim = isStaticallyAbsent(args[1]);
2449   mlir::Value dim =
2450       absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 0)
2451                 : fir::getBase(args[1]);
2452 
2453   if (absentDim || maskRank == 1) {
2454     // Result is scalar if no dim argument or mask is rank 1.
2455     // So, call specialized Count runtime routine.
2456     return builder.createConvert(
2457         loc, resultType,
2458         fir::runtime::genCount(builder, loc, fir::getBase(mask), dim));
2459   }
2460 
2461   // Call general CountDim runtime routine.
2462 
2463   // Handle optional kind argument
2464   bool absentKind = isStaticallyAbsent(args[2]);
2465   mlir::Value kind = absentKind ? builder.createIntegerConstant(
2466                                       loc, builder.getIndexType(),
2467                                       builder.getKindMap().defaultIntegerKind())
2468                                 : fir::getBase(args[2]);
2469 
2470   // Create mutable fir.box to be passed to the runtime for the result.
2471   mlir::Type type = builder.getVarLenSeqTy(resultType, maskRank - 1);
2472   fir::MutableBoxValue resultMutableBox =
2473       fir::factory::createTempMutableBox(builder, loc, type);
2474 
2475   mlir::Value resultIrBox =
2476       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2477 
2478   fir::runtime::genCountDim(builder, loc, resultIrBox, fir::getBase(mask), dim,
2479                             kind);
2480 
2481   // Handle cleanup of allocatable result descriptor and return
2482   fir::ExtendedValue res =
2483       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
2484   return res.match(
2485       [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2486         // Add cleanup code
2487         addCleanUpForTemp(loc, box.getAddr());
2488         return box;
2489       },
2490       [&](const auto &) -> fir::ExtendedValue {
2491         fir::emitFatalError(loc, "unexpected result for COUNT");
2492       });
2493 }
2494 
2495 // CPU_TIME
2496 void IntrinsicLibrary::genCpuTime(llvm::ArrayRef<fir::ExtendedValue> args) {
2497   assert(args.size() == 1);
2498   const mlir::Value *arg = args[0].getUnboxed();
2499   assert(arg && "nonscalar cpu_time argument");
2500   mlir::Value res1 = Fortran::lower::genCpuTime(builder, loc);
2501   mlir::Value res2 =
2502       builder.createConvert(loc, fir::dyn_cast_ptrEleTy(arg->getType()), res1);
2503   builder.create<fir::StoreOp>(loc, res2, *arg);
2504 }
2505 
2506 // CSHIFT
2507 fir::ExtendedValue
2508 IntrinsicLibrary::genCshift(mlir::Type resultType,
2509                             llvm::ArrayRef<fir::ExtendedValue> args) {
2510   assert(args.size() == 3);
2511 
2512   // Handle required ARRAY argument
2513   fir::BoxValue arrayBox = builder.createBox(loc, args[0]);
2514   mlir::Value array = fir::getBase(arrayBox);
2515   unsigned arrayRank = arrayBox.rank();
2516 
2517   // Create mutable fir.box to be passed to the runtime for the result.
2518   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank);
2519   fir::MutableBoxValue resultMutableBox =
2520       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2521   mlir::Value resultIrBox =
2522       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2523 
2524   if (arrayRank == 1) {
2525     // Vector case
2526     // Handle required SHIFT argument as a scalar
2527     const mlir::Value *shiftAddr = args[1].getUnboxed();
2528     assert(shiftAddr && "nonscalar CSHIFT argument");
2529     auto shift = builder.create<fir::LoadOp>(loc, *shiftAddr);
2530 
2531     fir::runtime::genCshiftVector(builder, loc, resultIrBox, array, shift);
2532   } else {
2533     // Non-vector case
2534     // Handle required SHIFT argument as an array
2535     mlir::Value shift = builder.createBox(loc, args[1]);
2536 
2537     // Handle optional DIM argument
2538     mlir::Value dim =
2539         isStaticallyAbsent(args[2])
2540             ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2541             : fir::getBase(args[2]);
2542     fir::runtime::genCshift(builder, loc, resultIrBox, array, shift, dim);
2543   }
2544   return readAndAddCleanUp(resultMutableBox, resultType, "CSHIFT");
2545 }
2546 
2547 // DATE_AND_TIME
2548 void IntrinsicLibrary::genDateAndTime(llvm::ArrayRef<fir::ExtendedValue> args) {
2549   assert(args.size() == 4 && "date_and_time has 4 args");
2550   llvm::SmallVector<llvm::Optional<fir::CharBoxValue>> charArgs(3);
2551   for (unsigned i = 0; i < 3; ++i)
2552     if (const fir::CharBoxValue *charBox = args[i].getCharBox())
2553       charArgs[i] = *charBox;
2554 
2555   mlir::Value values = fir::getBase(args[3]);
2556   if (!values)
2557     values = builder.create<fir::AbsentOp>(
2558         loc, fir::BoxType::get(builder.getNoneType()));
2559 
2560   Fortran::lower::genDateAndTime(builder, loc, charArgs[0], charArgs[1],
2561                                  charArgs[2], values);
2562 }
2563 
2564 // DIM
2565 mlir::Value IntrinsicLibrary::genDim(mlir::Type resultType,
2566                                      llvm::ArrayRef<mlir::Value> args) {
2567   assert(args.size() == 2);
2568   if (resultType.isa<mlir::IntegerType>()) {
2569     mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
2570     auto diff = builder.create<mlir::arith::SubIOp>(loc, args[0], args[1]);
2571     auto cmp = builder.create<mlir::arith::CmpIOp>(
2572         loc, mlir::arith::CmpIPredicate::sgt, diff, zero);
2573     return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero);
2574   }
2575   assert(fir::isa_real(resultType) && "Only expects real and integer in DIM");
2576   mlir::Value zero = builder.createRealZeroConstant(loc, resultType);
2577   auto diff = builder.create<mlir::arith::SubFOp>(loc, args[0], args[1]);
2578   auto cmp = builder.create<mlir::arith::CmpFOp>(
2579       loc, mlir::arith::CmpFPredicate::OGT, diff, zero);
2580   return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero);
2581 }
2582 
2583 // DOT_PRODUCT
2584 fir::ExtendedValue
2585 IntrinsicLibrary::genDotProduct(mlir::Type resultType,
2586                                 llvm::ArrayRef<fir::ExtendedValue> args) {
2587   return genDotProd(fir::runtime::genDotProduct, resultType, builder, loc,
2588                     stmtCtx, args);
2589 }
2590 
2591 // DPROD
2592 mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType,
2593                                        llvm::ArrayRef<mlir::Value> args) {
2594   assert(args.size() == 2);
2595   assert(fir::isa_real(resultType) &&
2596          "Result must be double precision in DPROD");
2597   mlir::Value a = builder.createConvert(loc, resultType, args[0]);
2598   mlir::Value b = builder.createConvert(loc, resultType, args[1]);
2599   return builder.create<mlir::arith::MulFOp>(loc, a, b);
2600 }
2601 
2602 // DSHIFTL
2603 mlir::Value IntrinsicLibrary::genDshiftl(mlir::Type resultType,
2604                                          llvm::ArrayRef<mlir::Value> args) {
2605   assert(args.size() == 3);
2606 
2607   mlir::Value i = args[0];
2608   mlir::Value j = args[1];
2609   mlir::Value shift = builder.createConvert(loc, resultType, args[2]);
2610   mlir::Value bitSize = builder.createIntegerConstant(
2611       loc, resultType, resultType.getIntOrFloatBitWidth());
2612 
2613   // Per the standard, the value of DSHIFTL(I, J, SHIFT) is equal to
2614   // IOR (SHIFTL(I, SHIFT), SHIFTR(J, BIT_SIZE(J) - SHIFT))
2615   mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, bitSize, shift);
2616 
2617   mlir::Value lArgs[2]{i, shift};
2618   mlir::Value lft = genShift<mlir::arith::ShLIOp>(resultType, lArgs);
2619 
2620   mlir::Value rArgs[2]{j, diff};
2621   mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(resultType, rArgs);
2622 
2623   return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
2624 }
2625 
2626 // DSHIFTR
2627 mlir::Value IntrinsicLibrary::genDshiftr(mlir::Type resultType,
2628                                          llvm::ArrayRef<mlir::Value> args) {
2629   assert(args.size() == 3);
2630 
2631   mlir::Value i = args[0];
2632   mlir::Value j = args[1];
2633   mlir::Value shift = builder.createConvert(loc, resultType, args[2]);
2634   mlir::Value bitSize = builder.createIntegerConstant(
2635       loc, resultType, resultType.getIntOrFloatBitWidth());
2636 
2637   // Per the standard, the value of DSHIFTR(I, J, SHIFT) is equal to
2638   // IOR (SHIFTL(I, BIT_SIZE(I) - SHIFT), SHIFTR(J, SHIFT))
2639   mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, bitSize, shift);
2640 
2641   mlir::Value lArgs[2]{i, diff};
2642   mlir::Value lft = genShift<mlir::arith::ShLIOp>(resultType, lArgs);
2643 
2644   mlir::Value rArgs[2]{j, shift};
2645   mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(resultType, rArgs);
2646 
2647   return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
2648 }
2649 
2650 // EOSHIFT
2651 fir::ExtendedValue
2652 IntrinsicLibrary::genEoshift(mlir::Type resultType,
2653                              llvm::ArrayRef<fir::ExtendedValue> args) {
2654   assert(args.size() == 4);
2655 
2656   // Handle required ARRAY argument
2657   fir::BoxValue arrayBox = builder.createBox(loc, args[0]);
2658   mlir::Value array = fir::getBase(arrayBox);
2659   unsigned arrayRank = arrayBox.rank();
2660 
2661   // Create mutable fir.box to be passed to the runtime for the result.
2662   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank);
2663   fir::MutableBoxValue resultMutableBox =
2664       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2665   mlir::Value resultIrBox =
2666       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2667 
2668   // Handle optional BOUNDARY argument
2669   mlir::Value boundary =
2670       isStaticallyAbsent(args[2])
2671           ? builder.create<fir::AbsentOp>(
2672                 loc, fir::BoxType::get(builder.getNoneType()))
2673           : builder.createBox(loc, args[2]);
2674 
2675   if (arrayRank == 1) {
2676     // Vector case
2677     // Handle required SHIFT argument as a scalar
2678     const mlir::Value *shiftAddr = args[1].getUnboxed();
2679     assert(shiftAddr && "nonscalar EOSHIFT SHIFT argument");
2680     auto shift = builder.create<fir::LoadOp>(loc, *shiftAddr);
2681     fir::runtime::genEoshiftVector(builder, loc, resultIrBox, array, shift,
2682                                    boundary);
2683   } else {
2684     // Non-vector case
2685     // Handle required SHIFT argument as an array
2686     mlir::Value shift = builder.createBox(loc, args[1]);
2687 
2688     // Handle optional DIM argument
2689     mlir::Value dim =
2690         isStaticallyAbsent(args[3])
2691             ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2692             : fir::getBase(args[3]);
2693     fir::runtime::genEoshift(builder, loc, resultIrBox, array, shift, boundary,
2694                              dim);
2695   }
2696   return readAndAddCleanUp(resultMutableBox, resultType,
2697                            "unexpected result for EOSHIFT");
2698 }
2699 
2700 // EXIT
2701 void IntrinsicLibrary::genExit(llvm::ArrayRef<fir::ExtendedValue> args) {
2702   assert(args.size() == 1);
2703 
2704   mlir::Value status =
2705       isStaticallyAbsent(args[0])
2706           ? builder.createIntegerConstant(loc, builder.getDefaultIntegerType(),
2707                                           EXIT_SUCCESS)
2708           : fir::getBase(args[0]);
2709 
2710   assert(status.getType() == builder.getDefaultIntegerType() &&
2711          "STATUS parameter must be an INTEGER of default kind");
2712 
2713   fir::runtime::genExit(builder, loc, status);
2714 }
2715 
2716 // EXPONENT
2717 mlir::Value IntrinsicLibrary::genExponent(mlir::Type resultType,
2718                                           llvm::ArrayRef<mlir::Value> args) {
2719   assert(args.size() == 1);
2720 
2721   return builder.createConvert(
2722       loc, resultType,
2723       fir::runtime::genExponent(builder, loc, resultType,
2724                                 fir::getBase(args[0])));
2725 }
2726 
2727 // FLOOR
2728 mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType,
2729                                        llvm::ArrayRef<mlir::Value> args) {
2730   // Optional KIND argument.
2731   assert(args.size() >= 1);
2732   mlir::Value arg = args[0];
2733   // Use LLVM floor that returns real.
2734   mlir::Value floor = genRuntimeCall("floor", arg.getType(), {arg});
2735   return builder.createConvert(loc, resultType, floor);
2736 }
2737 
2738 // FRACTION
2739 mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
2740                                           llvm::ArrayRef<mlir::Value> args) {
2741   assert(args.size() == 1);
2742 
2743   return builder.createConvert(
2744       loc, resultType,
2745       fir::runtime::genFraction(builder, loc, fir::getBase(args[0])));
2746 }
2747 
2748 // GET_COMMAND_ARGUMENT
2749 void IntrinsicLibrary::genGetCommandArgument(
2750     llvm::ArrayRef<fir::ExtendedValue> args) {
2751   assert(args.size() == 5);
2752   mlir::Value number = fir::getBase(args[0]);
2753   const fir::ExtendedValue &value = args[1];
2754   const fir::ExtendedValue &length = args[2];
2755   const fir::ExtendedValue &status = args[3];
2756   const fir::ExtendedValue &errmsg = args[4];
2757 
2758   if (!number)
2759     fir::emitFatalError(loc, "expected NUMBER parameter");
2760 
2761   if (isStaticallyPresent(value) || isStaticallyPresent(status) ||
2762       isStaticallyPresent(errmsg)) {
2763     mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
2764     mlir::Value valBox =
2765         isStaticallyPresent(value)
2766             ? fir::getBase(value)
2767             : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
2768     mlir::Value errBox =
2769         isStaticallyPresent(errmsg)
2770             ? fir::getBase(errmsg)
2771             : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
2772     mlir::Value stat =
2773         fir::runtime::genArgumentValue(builder, loc, number, valBox, errBox);
2774     if (isStaticallyPresent(status)) {
2775       mlir::Value statAddr = fir::getBase(status);
2776       mlir::Value statIsPresentAtRuntime =
2777           builder.genIsNotNullAddr(loc, statAddr);
2778       builder.genIfThen(loc, statIsPresentAtRuntime)
2779           .genThen(
2780               [&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
2781           .end();
2782     }
2783   }
2784   if (isStaticallyPresent(length)) {
2785     mlir::Value lenAddr = fir::getBase(length);
2786     mlir::Value lenIsPresentAtRuntime = builder.genIsNotNullAddr(loc, lenAddr);
2787     builder.genIfThen(loc, lenIsPresentAtRuntime)
2788         .genThen([&]() {
2789           mlir::Value len =
2790               fir::runtime::genArgumentLength(builder, loc, number);
2791           builder.createStoreWithConvert(loc, len, lenAddr);
2792         })
2793         .end();
2794   }
2795 }
2796 
2797 // GET_ENVIRONMENT_VARIABLE
2798 void IntrinsicLibrary::genGetEnvironmentVariable(
2799     llvm::ArrayRef<fir::ExtendedValue> args) {
2800   assert(args.size() == 6);
2801   mlir::Value name = fir::getBase(args[0]);
2802   const fir::ExtendedValue &value = args[1];
2803   const fir::ExtendedValue &length = args[2];
2804   const fir::ExtendedValue &status = args[3];
2805   const fir::ExtendedValue &trimName = args[4];
2806   const fir::ExtendedValue &errmsg = args[5];
2807 
2808   // Handle optional TRIM_NAME argument
2809   mlir::Value trim;
2810   if (isStaticallyAbsent(trimName)) {
2811     trim = builder.createBool(loc, true);
2812   } else {
2813     mlir::Type i1Ty = builder.getI1Type();
2814     mlir::Value trimNameAddr = fir::getBase(trimName);
2815     mlir::Value trimNameIsPresentAtRuntime =
2816         builder.genIsNotNullAddr(loc, trimNameAddr);
2817     trim = builder
2818                .genIfOp(loc, {i1Ty}, trimNameIsPresentAtRuntime,
2819                         /*withElseRegion=*/true)
2820                .genThen([&]() {
2821                  auto trimLoad = builder.create<fir::LoadOp>(loc, trimNameAddr);
2822                  mlir::Value cast = builder.createConvert(loc, i1Ty, trimLoad);
2823                  builder.create<fir::ResultOp>(loc, cast);
2824                })
2825                .genElse([&]() {
2826                  mlir::Value trueVal = builder.createBool(loc, true);
2827                  builder.create<fir::ResultOp>(loc, trueVal);
2828                })
2829                .getResults()[0];
2830   }
2831 
2832   if (isStaticallyPresent(value) || isStaticallyPresent(status) ||
2833       isStaticallyPresent(errmsg)) {
2834     mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
2835     mlir::Value valBox =
2836         isStaticallyPresent(value)
2837             ? fir::getBase(value)
2838             : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
2839     mlir::Value errBox =
2840         isStaticallyPresent(errmsg)
2841             ? fir::getBase(errmsg)
2842             : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
2843     mlir::Value stat = fir::runtime::genEnvVariableValue(builder, loc, name,
2844                                                          valBox, trim, errBox);
2845     if (isStaticallyPresent(status)) {
2846       mlir::Value statAddr = fir::getBase(status);
2847       mlir::Value statIsPresentAtRuntime =
2848           builder.genIsNotNullAddr(loc, statAddr);
2849       builder.genIfThen(loc, statIsPresentAtRuntime)
2850           .genThen(
2851               [&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
2852           .end();
2853     }
2854   }
2855 
2856   if (isStaticallyPresent(length)) {
2857     mlir::Value lenAddr = fir::getBase(length);
2858     mlir::Value lenIsPresentAtRuntime = builder.genIsNotNullAddr(loc, lenAddr);
2859     builder.genIfThen(loc, lenIsPresentAtRuntime)
2860         .genThen([&]() {
2861           mlir::Value len =
2862               fir::runtime::genEnvVariableLength(builder, loc, name, trim);
2863           builder.createStoreWithConvert(loc, len, lenAddr);
2864         })
2865         .end();
2866   }
2867 }
2868 
2869 // IAND
2870 mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType,
2871                                       llvm::ArrayRef<mlir::Value> args) {
2872   assert(args.size() == 2);
2873   auto arg0 = builder.createConvert(loc, resultType, args[0]);
2874   auto arg1 = builder.createConvert(loc, resultType, args[1]);
2875   return builder.create<mlir::arith::AndIOp>(loc, arg0, arg1);
2876 }
2877 
2878 // IBCLR
2879 mlir::Value IntrinsicLibrary::genIbclr(mlir::Type resultType,
2880                                        llvm::ArrayRef<mlir::Value> args) {
2881   // A conformant IBCLR(I,POS) call satisfies:
2882   //     POS >= 0
2883   //     POS < BIT_SIZE(I)
2884   // Return:  I & (!(1 << POS))
2885   assert(args.size() == 2);
2886   mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
2887   mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
2888   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
2889   auto mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
2890   auto res = builder.create<mlir::arith::XOrIOp>(loc, ones, mask);
2891   return builder.create<mlir::arith::AndIOp>(loc, args[0], res);
2892 }
2893 
2894 // IBITS
2895 mlir::Value IntrinsicLibrary::genIbits(mlir::Type resultType,
2896                                        llvm::ArrayRef<mlir::Value> args) {
2897   // A conformant IBITS(I,POS,LEN) call satisfies:
2898   //     POS >= 0
2899   //     LEN >= 0
2900   //     POS + LEN <= BIT_SIZE(I)
2901   // Return:  LEN == 0 ? 0 : (I >> POS) & (-1 >> (BIT_SIZE(I) - LEN))
2902   // For a conformant call, implementing (I >> POS) with a signed or an
2903   // unsigned shift produces the same result.  For a nonconformant call,
2904   // the two choices may produce different results.
2905   assert(args.size() == 3);
2906   mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
2907   mlir::Value len = builder.createConvert(loc, resultType, args[2]);
2908   mlir::Value bitSize = builder.createIntegerConstant(
2909       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
2910   auto shiftCount = builder.create<mlir::arith::SubIOp>(loc, bitSize, len);
2911   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
2912   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
2913   auto mask = builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount);
2914   auto res1 = builder.create<mlir::arith::ShRSIOp>(loc, args[0], pos);
2915   auto res2 = builder.create<mlir::arith::AndIOp>(loc, res1, mask);
2916   auto lenIsZero = builder.create<mlir::arith::CmpIOp>(
2917       loc, mlir::arith::CmpIPredicate::eq, len, zero);
2918   return builder.create<mlir::arith::SelectOp>(loc, lenIsZero, zero, res2);
2919 }
2920 
2921 // IBSET
2922 mlir::Value IntrinsicLibrary::genIbset(mlir::Type resultType,
2923                                        llvm::ArrayRef<mlir::Value> args) {
2924   // A conformant IBSET(I,POS) call satisfies:
2925   //     POS >= 0
2926   //     POS < BIT_SIZE(I)
2927   // Return:  I | (1 << POS)
2928   assert(args.size() == 2);
2929   mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
2930   mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
2931   auto mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
2932   return builder.create<mlir::arith::OrIOp>(loc, args[0], mask);
2933 }
2934 
2935 // ICHAR
2936 fir::ExtendedValue
2937 IntrinsicLibrary::genIchar(mlir::Type resultType,
2938                            llvm::ArrayRef<fir::ExtendedValue> args) {
2939   // There can be an optional kind in second argument.
2940   assert(args.size() == 2);
2941   const fir::CharBoxValue *charBox = args[0].getCharBox();
2942   if (!charBox)
2943     llvm::report_fatal_error("expected character scalar");
2944 
2945   fir::factory::CharacterExprHelper helper{builder, loc};
2946   mlir::Value buffer = charBox->getBuffer();
2947   mlir::Type bufferTy = buffer.getType();
2948   mlir::Value charVal;
2949   if (auto charTy = bufferTy.dyn_cast<fir::CharacterType>()) {
2950     assert(charTy.singleton());
2951     charVal = buffer;
2952   } else {
2953     // Character is in memory, cast to fir.ref<char> and load.
2954     mlir::Type ty = fir::dyn_cast_ptrEleTy(bufferTy);
2955     if (!ty)
2956       llvm::report_fatal_error("expected memory type");
2957     // The length of in the character type may be unknown. Casting
2958     // to a singleton ref is required before loading.
2959     fir::CharacterType eleType = helper.getCharacterType(ty);
2960     fir::CharacterType charType =
2961         fir::CharacterType::get(builder.getContext(), eleType.getFKind(), 1);
2962     mlir::Type toTy = builder.getRefType(charType);
2963     mlir::Value cast = builder.createConvert(loc, toTy, buffer);
2964     charVal = builder.create<fir::LoadOp>(loc, cast);
2965   }
2966   LLVM_DEBUG(llvm::dbgs() << "ichar(" << charVal << ")\n");
2967   auto code = helper.extractCodeFromSingleton(charVal);
2968   if (code.getType() == resultType)
2969     return code;
2970   return builder.create<mlir::arith::ExtUIOp>(loc, resultType, code);
2971 }
2972 
2973 // IEEE_CLASS_TYPE OPERATOR(==), OPERATOR(/=)
2974 // IEEE_ROUND_TYPE OPERATOR(==), OPERATOR(/=)
2975 template <mlir::arith::CmpIPredicate pred>
2976 fir::ExtendedValue
2977 IntrinsicLibrary::genIeeeTypeCompare(mlir::Type resultType,
2978                                      llvm::ArrayRef<fir::ExtendedValue> args) {
2979   assert(args.size() == 2);
2980   mlir::Value arg0 = fir::getBase(args[0]);
2981   mlir::Value arg1 = fir::getBase(args[1]);
2982   auto recType =
2983       fir::unwrapPassByRefType(arg0.getType()).dyn_cast<fir::RecordType>();
2984   assert(recType.getTypeList().size() == 1 && "expected exactly one component");
2985   auto [fieldName, fieldType] = recType.getTypeList().front();
2986   mlir::Type fieldIndexType = fir::FieldType::get(recType.getContext());
2987   mlir::Value field = builder.create<fir::FieldIndexOp>(
2988       loc, fieldIndexType, fieldName, recType, fir::getTypeParams(arg0));
2989   mlir::Value left = builder.create<fir::LoadOp>(
2990       loc, fieldType,
2991       builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldType),
2992                                         arg0, field));
2993   mlir::Value right = builder.create<fir::LoadOp>(
2994       loc, fieldType,
2995       builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldType),
2996                                         arg1, field));
2997   return builder.create<mlir::arith::CmpIOp>(loc, pred, left, right);
2998 }
2999 
3000 // IEEE_IS_FINITE
3001 mlir::Value
3002 IntrinsicLibrary::genIeeeIsFinite(mlir::Type resultType,
3003                                   llvm::ArrayRef<mlir::Value> args) {
3004   // IEEE_IS_FINITE(X) is true iff exponent(X) is the max exponent of kind(X).
3005   assert(args.size() == 1);
3006   mlir::Value floatVal = fir::getBase(args[0]);
3007   mlir::FloatType floatType = floatVal.getType().dyn_cast<mlir::FloatType>();
3008   int floatBits = floatType.getWidth();
3009   mlir::Type intType = builder.getIntegerType(
3010       floatType.isa<mlir::Float80Type>() ? 128 : floatBits);
3011   mlir::Value intVal =
3012       builder.create<mlir::arith::BitcastOp>(loc, intType, floatVal);
3013   int significandBits;
3014   if (floatType.isa<mlir::Float32Type>())
3015     significandBits = 23;
3016   else if (floatType.isa<mlir::Float64Type>())
3017     significandBits = 52;
3018   else // problems elsewhere for other kinds
3019     TODO(loc, "intrinsic module procedure: ieee_is_finite");
3020   mlir::Value significand =
3021       builder.createIntegerConstant(loc, intType, significandBits);
3022   int exponentBits = floatBits - 1 - significandBits;
3023   mlir::Value maxExponent =
3024       builder.createIntegerConstant(loc, intType, (1 << exponentBits) - 1);
3025   mlir::Value exponent = genIbits(
3026       intType, {intVal, significand,
3027                 builder.createIntegerConstant(loc, intType, exponentBits)});
3028   return builder.createConvert(
3029       loc, resultType,
3030       builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::ne,
3031                                           exponent, maxExponent));
3032 }
3033 
3034 // IEOR
3035 mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType,
3036                                       llvm::ArrayRef<mlir::Value> args) {
3037   assert(args.size() == 2);
3038   return builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
3039 }
3040 
3041 // INDEX
3042 fir::ExtendedValue
3043 IntrinsicLibrary::genIndex(mlir::Type resultType,
3044                            llvm::ArrayRef<fir::ExtendedValue> args) {
3045   assert(args.size() >= 2 && args.size() <= 4);
3046 
3047   mlir::Value stringBase = fir::getBase(args[0]);
3048   fir::KindTy kind =
3049       fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
3050           stringBase.getType());
3051   mlir::Value stringLen = fir::getLen(args[0]);
3052   mlir::Value substringBase = fir::getBase(args[1]);
3053   mlir::Value substringLen = fir::getLen(args[1]);
3054   mlir::Value back =
3055       isStaticallyAbsent(args, 2)
3056           ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
3057           : fir::getBase(args[2]);
3058   if (isStaticallyAbsent(args, 3))
3059     return builder.createConvert(
3060         loc, resultType,
3061         fir::runtime::genIndex(builder, loc, kind, stringBase, stringLen,
3062                                substringBase, substringLen, back));
3063 
3064   // Call the descriptor-based Index implementation
3065   mlir::Value string = builder.createBox(loc, args[0]);
3066   mlir::Value substring = builder.createBox(loc, args[1]);
3067   auto makeRefThenEmbox = [&](mlir::Value b) {
3068     fir::LogicalType logTy = fir::LogicalType::get(
3069         builder.getContext(), builder.getKindMap().defaultLogicalKind());
3070     mlir::Value temp = builder.createTemporary(loc, logTy);
3071     mlir::Value castb = builder.createConvert(loc, logTy, b);
3072     builder.create<fir::StoreOp>(loc, castb, temp);
3073     return builder.createBox(loc, temp);
3074   };
3075   mlir::Value backOpt = isStaticallyAbsent(args, 2)
3076                             ? builder.create<fir::AbsentOp>(
3077                                   loc, fir::BoxType::get(builder.getI1Type()))
3078                             : makeRefThenEmbox(fir::getBase(args[2]));
3079   mlir::Value kindVal = isStaticallyAbsent(args, 3)
3080                             ? builder.createIntegerConstant(
3081                                   loc, builder.getIndexType(),
3082                                   builder.getKindMap().defaultIntegerKind())
3083                             : fir::getBase(args[3]);
3084   // Create mutable fir.box to be passed to the runtime for the result.
3085   fir::MutableBoxValue mutBox =
3086       fir::factory::createTempMutableBox(builder, loc, resultType);
3087   mlir::Value resBox = fir::factory::getMutableIRBox(builder, loc, mutBox);
3088   // Call runtime. The runtime is allocating the result.
3089   fir::runtime::genIndexDescriptor(builder, loc, resBox, string, substring,
3090                                    backOpt, kindVal);
3091   // Read back the result from the mutable box.
3092   return readAndAddCleanUp(mutBox, resultType, "INDEX");
3093 }
3094 
3095 // IOR
3096 mlir::Value IntrinsicLibrary::genIor(mlir::Type resultType,
3097                                      llvm::ArrayRef<mlir::Value> args) {
3098   assert(args.size() == 2);
3099   return builder.create<mlir::arith::OrIOp>(loc, args[0], args[1]);
3100 }
3101 
3102 // ISHFT
3103 mlir::Value IntrinsicLibrary::genIshft(mlir::Type resultType,
3104                                        llvm::ArrayRef<mlir::Value> args) {
3105   // A conformant ISHFT(I,SHIFT) call satisfies:
3106   //     abs(SHIFT) <= BIT_SIZE(I)
3107   // Return:  abs(SHIFT) >= BIT_SIZE(I)
3108   //              ? 0
3109   //              : SHIFT < 0
3110   //                    ? I >> abs(SHIFT)
3111   //                    : I << abs(SHIFT)
3112   assert(args.size() == 2);
3113   mlir::Value bitSize = builder.createIntegerConstant(
3114       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
3115   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3116   mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
3117   mlir::Value absShift = genAbs(resultType, {shift});
3118   auto left = builder.create<mlir::arith::ShLIOp>(loc, args[0], absShift);
3119   auto right = builder.create<mlir::arith::ShRUIOp>(loc, args[0], absShift);
3120   auto shiftIsLarge = builder.create<mlir::arith::CmpIOp>(
3121       loc, mlir::arith::CmpIPredicate::sge, absShift, bitSize);
3122   auto shiftIsNegative = builder.create<mlir::arith::CmpIOp>(
3123       loc, mlir::arith::CmpIPredicate::slt, shift, zero);
3124   auto sel =
3125       builder.create<mlir::arith::SelectOp>(loc, shiftIsNegative, right, left);
3126   return builder.create<mlir::arith::SelectOp>(loc, shiftIsLarge, zero, sel);
3127 }
3128 
3129 // ISHFTC
3130 mlir::Value IntrinsicLibrary::genIshftc(mlir::Type resultType,
3131                                         llvm::ArrayRef<mlir::Value> args) {
3132   // A conformant ISHFTC(I,SHIFT,SIZE) call satisfies:
3133   //     SIZE > 0
3134   //     SIZE <= BIT_SIZE(I)
3135   //     abs(SHIFT) <= SIZE
3136   // if SHIFT > 0
3137   //     leftSize = abs(SHIFT)
3138   //     rightSize = SIZE - abs(SHIFT)
3139   // else [if SHIFT < 0]
3140   //     leftSize = SIZE - abs(SHIFT)
3141   //     rightSize = abs(SHIFT)
3142   // unchanged = SIZE == BIT_SIZE(I) ? 0 : (I >> SIZE) << SIZE
3143   // leftMaskShift = BIT_SIZE(I) - leftSize
3144   // rightMaskShift = BIT_SIZE(I) - rightSize
3145   // left = (I >> rightSize) & (-1 >> leftMaskShift)
3146   // right = (I & (-1 >> rightMaskShift)) << leftSize
3147   // Return:  SHIFT == 0 || SIZE == abs(SHIFT) ? I : (unchanged | left | right)
3148   assert(args.size() == 3);
3149   mlir::Value bitSize = builder.createIntegerConstant(
3150       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
3151   mlir::Value I = args[0];
3152   mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
3153   mlir::Value size =
3154       args[2] ? builder.createConvert(loc, resultType, args[2]) : bitSize;
3155   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3156   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
3157   mlir::Value absShift = genAbs(resultType, {shift});
3158   auto elseSize = builder.create<mlir::arith::SubIOp>(loc, size, absShift);
3159   auto shiftIsZero = builder.create<mlir::arith::CmpIOp>(
3160       loc, mlir::arith::CmpIPredicate::eq, shift, zero);
3161   auto shiftEqualsSize = builder.create<mlir::arith::CmpIOp>(
3162       loc, mlir::arith::CmpIPredicate::eq, absShift, size);
3163   auto shiftIsNop =
3164       builder.create<mlir::arith::OrIOp>(loc, shiftIsZero, shiftEqualsSize);
3165   auto shiftIsPositive = builder.create<mlir::arith::CmpIOp>(
3166       loc, mlir::arith::CmpIPredicate::sgt, shift, zero);
3167   auto leftSize = builder.create<mlir::arith::SelectOp>(loc, shiftIsPositive,
3168                                                         absShift, elseSize);
3169   auto rightSize = builder.create<mlir::arith::SelectOp>(loc, shiftIsPositive,
3170                                                          elseSize, absShift);
3171   auto hasUnchanged = builder.create<mlir::arith::CmpIOp>(
3172       loc, mlir::arith::CmpIPredicate::ne, size, bitSize);
3173   auto unchangedTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, I, size);
3174   auto unchangedTmp2 =
3175       builder.create<mlir::arith::ShLIOp>(loc, unchangedTmp1, size);
3176   auto unchanged = builder.create<mlir::arith::SelectOp>(loc, hasUnchanged,
3177                                                          unchangedTmp2, zero);
3178   auto leftMaskShift =
3179       builder.create<mlir::arith::SubIOp>(loc, bitSize, leftSize);
3180   auto leftMask =
3181       builder.create<mlir::arith::ShRUIOp>(loc, ones, leftMaskShift);
3182   auto leftTmp = builder.create<mlir::arith::ShRUIOp>(loc, I, rightSize);
3183   auto left = builder.create<mlir::arith::AndIOp>(loc, leftTmp, leftMask);
3184   auto rightMaskShift =
3185       builder.create<mlir::arith::SubIOp>(loc, bitSize, rightSize);
3186   auto rightMask =
3187       builder.create<mlir::arith::ShRUIOp>(loc, ones, rightMaskShift);
3188   auto rightTmp = builder.create<mlir::arith::AndIOp>(loc, I, rightMask);
3189   auto right = builder.create<mlir::arith::ShLIOp>(loc, rightTmp, leftSize);
3190   auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, left);
3191   auto res = builder.create<mlir::arith::OrIOp>(loc, resTmp, right);
3192   return builder.create<mlir::arith::SelectOp>(loc, shiftIsNop, I, res);
3193 }
3194 
3195 // LEADZ
3196 mlir::Value IntrinsicLibrary::genLeadz(mlir::Type resultType,
3197                                        llvm::ArrayRef<mlir::Value> args) {
3198   assert(args.size() == 1);
3199 
3200   mlir::Value result =
3201       builder.create<mlir::math::CountLeadingZerosOp>(loc, args);
3202 
3203   return builder.createConvert(loc, resultType, result);
3204 }
3205 
3206 // LEN
3207 // Note that this is only used for an unrestricted intrinsic LEN call.
3208 // Other uses of LEN are rewritten as descriptor inquiries by the front-end.
3209 fir::ExtendedValue
3210 IntrinsicLibrary::genLen(mlir::Type resultType,
3211                          llvm::ArrayRef<fir::ExtendedValue> args) {
3212   // Optional KIND argument reflected in result type and otherwise ignored.
3213   assert(args.size() == 1 || args.size() == 2);
3214   mlir::Value len = fir::factory::readCharLen(builder, loc, args[0]);
3215   return builder.createConvert(loc, resultType, len);
3216 }
3217 
3218 // LEN_TRIM
3219 fir::ExtendedValue
3220 IntrinsicLibrary::genLenTrim(mlir::Type resultType,
3221                              llvm::ArrayRef<fir::ExtendedValue> args) {
3222   // Optional KIND argument reflected in result type and otherwise ignored.
3223   assert(args.size() == 1 || args.size() == 2);
3224   const fir::CharBoxValue *charBox = args[0].getCharBox();
3225   if (!charBox)
3226     TODO(loc, "character array len_trim");
3227   auto len =
3228       fir::factory::CharacterExprHelper(builder, loc).createLenTrim(*charBox);
3229   return builder.createConvert(loc, resultType, len);
3230 }
3231 
3232 // LGE, LGT, LLE, LLT
3233 template <mlir::arith::CmpIPredicate pred>
3234 fir::ExtendedValue
3235 IntrinsicLibrary::genCharacterCompare(mlir::Type resultType,
3236                                       llvm::ArrayRef<fir::ExtendedValue> args) {
3237   assert(args.size() == 2);
3238   return fir::runtime::genCharCompare(
3239       builder, loc, pred, fir::getBase(args[0]), fir::getLen(args[0]),
3240       fir::getBase(args[1]), fir::getLen(args[1]));
3241 }
3242 
3243 // MASKL, MASKR
3244 template <typename Shift>
3245 mlir::Value IntrinsicLibrary::genMask(mlir::Type resultType,
3246                                       llvm::ArrayRef<mlir::Value> args) {
3247   assert(args.size() == 2);
3248 
3249   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
3250   mlir::Value bitSize = builder.createIntegerConstant(
3251       loc, resultType, resultType.getIntOrFloatBitWidth());
3252   mlir::Value bitsToSet = builder.createConvert(loc, resultType, args[0]);
3253 
3254   // The standard does not specify what to return if the number of bits to be
3255   // set, I < 0 or I >= BIT_SIZE(KIND). The shift instruction used below will
3256   // produce a poison value which may return a possibly platform-specific and/or
3257   // non-deterministic result. Other compilers don't produce a consistent result
3258   // in this case either, so we choose the most efficient implementation.
3259   mlir::Value shift =
3260       builder.create<mlir::arith::SubIOp>(loc, bitSize, bitsToSet);
3261   return builder.create<Shift>(loc, ones, shift);
3262 }
3263 
3264 // MATMUL
3265 fir::ExtendedValue
3266 IntrinsicLibrary::genMatmul(mlir::Type resultType,
3267                             llvm::ArrayRef<fir::ExtendedValue> args) {
3268   assert(args.size() == 2);
3269 
3270   // Handle required matmul arguments
3271   fir::BoxValue matrixTmpA = builder.createBox(loc, args[0]);
3272   mlir::Value matrixA = fir::getBase(matrixTmpA);
3273   fir::BoxValue matrixTmpB = builder.createBox(loc, args[1]);
3274   mlir::Value matrixB = fir::getBase(matrixTmpB);
3275   unsigned resultRank =
3276       (matrixTmpA.rank() == 1 || matrixTmpB.rank() == 1) ? 1 : 2;
3277 
3278   // Create mutable fir.box to be passed to the runtime for the result.
3279   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, resultRank);
3280   fir::MutableBoxValue resultMutableBox =
3281       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
3282   mlir::Value resultIrBox =
3283       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3284   // Call runtime. The runtime is allocating the result.
3285   fir::runtime::genMatmul(builder, loc, resultIrBox, matrixA, matrixB);
3286   // Read result from mutable fir.box and add it to the list of temps to be
3287   // finalized by the StatementContext.
3288   return readAndAddCleanUp(resultMutableBox, resultType,
3289                            "unexpected result for MATMUL");
3290 }
3291 
3292 // MERGE
3293 fir::ExtendedValue
3294 IntrinsicLibrary::genMerge(mlir::Type,
3295                            llvm::ArrayRef<fir::ExtendedValue> args) {
3296   assert(args.size() == 3);
3297   mlir::Value tsource = fir::getBase(args[0]);
3298   mlir::Value fsource = fir::getBase(args[1]);
3299   mlir::Value rawMask = fir::getBase(args[2]);
3300   mlir::Type type0 = fir::unwrapRefType(tsource.getType());
3301   bool isCharRslt = fir::isa_char(type0); // result is same as first argument
3302   mlir::Value mask = builder.createConvert(loc, builder.getI1Type(), rawMask);
3303   // FSOURCE has the same type as TSOURCE, but they may not have the same MLIR
3304   // types (one can have dynamic length while the other has constant lengths,
3305   // or one may be a fir.logical<> while the other is an i1). Insert a cast to
3306   // fulfill mlir::SelectOp constraint that the MLIR types must be the same.
3307   mlir::Value fsourceCast =
3308       builder.createConvert(loc, tsource.getType(), fsource);
3309   auto rslt =
3310       builder.create<mlir::arith::SelectOp>(loc, mask, tsource, fsourceCast);
3311   if (isCharRslt) {
3312     // Need a CharBoxValue for character results
3313     const fir::CharBoxValue *charBox = args[0].getCharBox();
3314     fir::CharBoxValue charRslt(rslt, charBox->getLen());
3315     return charRslt;
3316   }
3317   return rslt;
3318 }
3319 
3320 // MERGE_BITS
3321 mlir::Value IntrinsicLibrary::genMergeBits(mlir::Type resultType,
3322                                            llvm::ArrayRef<mlir::Value> args) {
3323   assert(args.size() == 3);
3324 
3325   mlir::Value i = builder.createConvert(loc, resultType, args[0]);
3326   mlir::Value j = builder.createConvert(loc, resultType, args[1]);
3327   mlir::Value mask = builder.createConvert(loc, resultType, args[2]);
3328   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
3329 
3330   // MERGE_BITS(I, J, MASK) = IOR(IAND(I, MASK), IAND(J, NOT(MASK)))
3331   mlir::Value notMask = builder.create<mlir::arith::XOrIOp>(loc, mask, ones);
3332   mlir::Value lft = builder.create<mlir::arith::AndIOp>(loc, i, mask);
3333   mlir::Value rgt = builder.create<mlir::arith::AndIOp>(loc, j, notMask);
3334 
3335   return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
3336 }
3337 
3338 // MOD
3339 mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType,
3340                                      llvm::ArrayRef<mlir::Value> args) {
3341   assert(args.size() == 2);
3342   if (resultType.isa<mlir::IntegerType>())
3343     return builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
3344 
3345   // Use runtime. Note that mlir::arith::RemFOp implements floating point
3346   // remainder, but it does not work with fir::Real type.
3347   // TODO: consider using mlir::arith::RemFOp when possible, that may help
3348   // folding and  optimizations.
3349   return genRuntimeCall("mod", resultType, args);
3350 }
3351 
3352 // MODULO
3353 mlir::Value IntrinsicLibrary::genModulo(mlir::Type resultType,
3354                                         llvm::ArrayRef<mlir::Value> args) {
3355   assert(args.size() == 2);
3356   // No floored modulo op in LLVM/MLIR yet. TODO: add one to MLIR.
3357   // In the meantime, use a simple inlined implementation based on truncated
3358   // modulo (MOD(A, P) implemented by RemIOp, RemFOp). This avoids making manual
3359   // division and multiplication from MODULO formula.
3360   //  - If A/P > 0 or MOD(A,P)=0, then INT(A/P) = FLOOR(A/P), and MODULO = MOD.
3361   //  - Otherwise, when A/P < 0 and MOD(A,P) !=0, then MODULO(A, P) =
3362   //    A-FLOOR(A/P)*P = A-(INT(A/P)-1)*P = A-INT(A/P)*P+P = MOD(A,P)+P
3363   // Note that A/P < 0 if and only if A and P signs are different.
3364   if (resultType.isa<mlir::IntegerType>()) {
3365     auto remainder =
3366         builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
3367     auto argXor = builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
3368     mlir::Value zero = builder.createIntegerConstant(loc, argXor.getType(), 0);
3369     auto argSignDifferent = builder.create<mlir::arith::CmpIOp>(
3370         loc, mlir::arith::CmpIPredicate::slt, argXor, zero);
3371     auto remainderIsNotZero = builder.create<mlir::arith::CmpIOp>(
3372         loc, mlir::arith::CmpIPredicate::ne, remainder, zero);
3373     auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero,
3374                                                         argSignDifferent);
3375     auto remPlusP =
3376         builder.create<mlir::arith::AddIOp>(loc, remainder, args[1]);
3377     return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP,
3378                                                  remainder);
3379   }
3380   // Real case
3381   auto remainder = builder.create<mlir::arith::RemFOp>(loc, args[0], args[1]);
3382   mlir::Value zero = builder.createRealZeroConstant(loc, remainder.getType());
3383   auto remainderIsNotZero = builder.create<mlir::arith::CmpFOp>(
3384       loc, mlir::arith::CmpFPredicate::UNE, remainder, zero);
3385   auto aLessThanZero = builder.create<mlir::arith::CmpFOp>(
3386       loc, mlir::arith::CmpFPredicate::OLT, args[0], zero);
3387   auto pLessThanZero = builder.create<mlir::arith::CmpFOp>(
3388       loc, mlir::arith::CmpFPredicate::OLT, args[1], zero);
3389   auto argSignDifferent =
3390       builder.create<mlir::arith::XOrIOp>(loc, aLessThanZero, pLessThanZero);
3391   auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero,
3392                                                       argSignDifferent);
3393   auto remPlusP = builder.create<mlir::arith::AddFOp>(loc, remainder, args[1]);
3394   return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP,
3395                                                remainder);
3396 }
3397 
3398 // MVBITS
3399 void IntrinsicLibrary::genMvbits(llvm::ArrayRef<fir::ExtendedValue> args) {
3400   // A conformant MVBITS(FROM,FROMPOS,LEN,TO,TOPOS) call satisfies:
3401   //     FROMPOS >= 0
3402   //     LEN >= 0
3403   //     TOPOS >= 0
3404   //     FROMPOS + LEN <= BIT_SIZE(FROM)
3405   //     TOPOS + LEN <= BIT_SIZE(TO)
3406   // MASK = -1 >> (BIT_SIZE(FROM) - LEN)
3407   // TO = LEN == 0 ? TO : ((!(MASK << TOPOS)) & TO) |
3408   //                      (((FROM >> FROMPOS) & MASK) << TOPOS)
3409   assert(args.size() == 5);
3410   auto unbox = [&](fir::ExtendedValue exv) {
3411     const mlir::Value *arg = exv.getUnboxed();
3412     assert(arg && "nonscalar mvbits argument");
3413     return *arg;
3414   };
3415   mlir::Value from = unbox(args[0]);
3416   mlir::Type resultType = from.getType();
3417   mlir::Value frompos = builder.createConvert(loc, resultType, unbox(args[1]));
3418   mlir::Value len = builder.createConvert(loc, resultType, unbox(args[2]));
3419   mlir::Value toAddr = unbox(args[3]);
3420   assert(fir::dyn_cast_ptrEleTy(toAddr.getType()) == resultType &&
3421          "mismatched mvbits types");
3422   auto to = builder.create<fir::LoadOp>(loc, resultType, toAddr);
3423   mlir::Value topos = builder.createConvert(loc, resultType, unbox(args[4]));
3424   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3425   mlir::Value ones = builder.createIntegerConstant(loc, resultType, -1);
3426   mlir::Value bitSize = builder.createIntegerConstant(
3427       loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
3428   auto shiftCount = builder.create<mlir::arith::SubIOp>(loc, bitSize, len);
3429   auto mask = builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount);
3430   auto unchangedTmp1 = builder.create<mlir::arith::ShLIOp>(loc, mask, topos);
3431   auto unchangedTmp2 =
3432       builder.create<mlir::arith::XOrIOp>(loc, unchangedTmp1, ones);
3433   auto unchanged = builder.create<mlir::arith::AndIOp>(loc, unchangedTmp2, to);
3434   auto frombitsTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, from, frompos);
3435   auto frombitsTmp2 =
3436       builder.create<mlir::arith::AndIOp>(loc, frombitsTmp1, mask);
3437   auto frombits = builder.create<mlir::arith::ShLIOp>(loc, frombitsTmp2, topos);
3438   auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, frombits);
3439   auto lenIsZero = builder.create<mlir::arith::CmpIOp>(
3440       loc, mlir::arith::CmpIPredicate::eq, len, zero);
3441   auto res = builder.create<mlir::arith::SelectOp>(loc, lenIsZero, to, resTmp);
3442   builder.create<fir::StoreOp>(loc, res, toAddr);
3443 }
3444 
3445 // NEAREST
3446 mlir::Value IntrinsicLibrary::genNearest(mlir::Type resultType,
3447                                          llvm::ArrayRef<mlir::Value> args) {
3448   assert(args.size() == 2);
3449 
3450   mlir::Value realX = fir::getBase(args[0]);
3451   mlir::Value realS = fir::getBase(args[1]);
3452 
3453   return builder.createConvert(
3454       loc, resultType, fir::runtime::genNearest(builder, loc, realX, realS));
3455 }
3456 
3457 // NINT
3458 mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType,
3459                                       llvm::ArrayRef<mlir::Value> args) {
3460   assert(args.size() >= 1);
3461   // Skip optional kind argument to search the runtime; it is already reflected
3462   // in result type.
3463   return genRuntimeCall("nint", resultType, {args[0]});
3464 }
3465 
3466 // NOT
3467 mlir::Value IntrinsicLibrary::genNot(mlir::Type resultType,
3468                                      llvm::ArrayRef<mlir::Value> args) {
3469   assert(args.size() == 1);
3470   mlir::Value allOnes = builder.createIntegerConstant(loc, resultType, -1);
3471   return builder.create<mlir::arith::XOrIOp>(loc, args[0], allOnes);
3472 }
3473 
3474 // NULL
3475 fir::ExtendedValue
3476 IntrinsicLibrary::genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue> args) {
3477   // NULL() without MOLD must be handled in the contexts where it can appear
3478   // (see table 16.5 of Fortran 2018 standard).
3479   assert(args.size() == 1 && isStaticallyPresent(args[0]) &&
3480          "MOLD argument required to lower NULL outside of any context");
3481   const auto *mold = args[0].getBoxOf<fir::MutableBoxValue>();
3482   assert(mold && "MOLD must be a pointer or allocatable");
3483   fir::BoxType boxType = mold->getBoxTy();
3484   mlir::Value boxStorage = builder.createTemporary(loc, boxType);
3485   mlir::Value box = fir::factory::createUnallocatedBox(
3486       builder, loc, boxType, mold->nonDeferredLenParams());
3487   builder.create<fir::StoreOp>(loc, box, boxStorage);
3488   return fir::MutableBoxValue(boxStorage, mold->nonDeferredLenParams(), {});
3489 }
3490 
3491 // PACK
3492 fir::ExtendedValue
3493 IntrinsicLibrary::genPack(mlir::Type resultType,
3494                           llvm::ArrayRef<fir::ExtendedValue> args) {
3495   [[maybe_unused]] auto numArgs = args.size();
3496   assert(numArgs == 2 || numArgs == 3);
3497 
3498   // Handle required array argument
3499   mlir::Value array = builder.createBox(loc, args[0]);
3500 
3501   // Handle required mask argument
3502   mlir::Value mask = builder.createBox(loc, args[1]);
3503 
3504   // Handle optional vector argument
3505   mlir::Value vector = isStaticallyAbsent(args, 2)
3506                            ? builder.create<fir::AbsentOp>(
3507                                  loc, fir::BoxType::get(builder.getI1Type()))
3508                            : builder.createBox(loc, args[2]);
3509 
3510   // Create mutable fir.box to be passed to the runtime for the result.
3511   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1);
3512   fir::MutableBoxValue resultMutableBox =
3513       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
3514   mlir::Value resultIrBox =
3515       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3516 
3517   fir::runtime::genPack(builder, loc, resultIrBox, array, mask, vector);
3518 
3519   return readAndAddCleanUp(resultMutableBox, resultType,
3520                            "unexpected result for PACK");
3521 }
3522 
3523 // POPCNT
3524 mlir::Value IntrinsicLibrary::genPopcnt(mlir::Type resultType,
3525                                         llvm::ArrayRef<mlir::Value> args) {
3526   assert(args.size() == 1);
3527 
3528   mlir::Value count = builder.create<mlir::math::CtPopOp>(loc, args);
3529 
3530   return builder.createConvert(loc, resultType, count);
3531 }
3532 
3533 // POPPAR
3534 mlir::Value IntrinsicLibrary::genPoppar(mlir::Type resultType,
3535                                         llvm::ArrayRef<mlir::Value> args) {
3536   assert(args.size() == 1);
3537 
3538   mlir::Value count = genPopcnt(resultType, args);
3539   mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
3540 
3541   return builder.create<mlir::arith::AndIOp>(loc, count, one);
3542 }
3543 
3544 // PRESENT
3545 fir::ExtendedValue
3546 IntrinsicLibrary::genPresent(mlir::Type,
3547                              llvm::ArrayRef<fir::ExtendedValue> args) {
3548   assert(args.size() == 1);
3549   return builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
3550                                           fir::getBase(args[0]));
3551 }
3552 
3553 // PRODUCT
3554 fir::ExtendedValue
3555 IntrinsicLibrary::genProduct(mlir::Type resultType,
3556                              llvm::ArrayRef<fir::ExtendedValue> args) {
3557   return genProdOrSum(fir::runtime::genProduct, fir::runtime::genProductDim,
3558                       resultType, builder, loc, stmtCtx,
3559                       "unexpected result for Product", args);
3560 }
3561 
3562 // RANDOM_INIT
3563 void IntrinsicLibrary::genRandomInit(llvm::ArrayRef<fir::ExtendedValue> args) {
3564   assert(args.size() == 2);
3565   Fortran::lower::genRandomInit(builder, loc, fir::getBase(args[0]),
3566                                 fir::getBase(args[1]));
3567 }
3568 
3569 // RANDOM_NUMBER
3570 void IntrinsicLibrary::genRandomNumber(
3571     llvm::ArrayRef<fir::ExtendedValue> args) {
3572   assert(args.size() == 1);
3573   Fortran::lower::genRandomNumber(builder, loc, fir::getBase(args[0]));
3574 }
3575 
3576 // RANDOM_SEED
3577 void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef<fir::ExtendedValue> args) {
3578   assert(args.size() == 3);
3579   for (int i = 0; i < 3; ++i)
3580     if (isStaticallyPresent(args[i])) {
3581       Fortran::lower::genRandomSeed(builder, loc, i, fir::getBase(args[i]));
3582       return;
3583     }
3584   Fortran::lower::genRandomSeed(builder, loc, -1, mlir::Value{});
3585 }
3586 
3587 // REPEAT
3588 fir::ExtendedValue
3589 IntrinsicLibrary::genRepeat(mlir::Type resultType,
3590                             llvm::ArrayRef<fir::ExtendedValue> args) {
3591   assert(args.size() == 2);
3592   mlir::Value string = builder.createBox(loc, args[0]);
3593   mlir::Value ncopies = fir::getBase(args[1]);
3594   // Create mutable fir.box to be passed to the runtime for the result.
3595   fir::MutableBoxValue resultMutableBox =
3596       fir::factory::createTempMutableBox(builder, loc, resultType);
3597   mlir::Value resultIrBox =
3598       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3599   // Call runtime. The runtime is allocating the result.
3600   fir::runtime::genRepeat(builder, loc, resultIrBox, string, ncopies);
3601   // Read result from mutable fir.box and add it to the list of temps to be
3602   // finalized by the StatementContext.
3603   return readAndAddCleanUp(resultMutableBox, resultType, "REPEAT");
3604 }
3605 
3606 // RESHAPE
3607 fir::ExtendedValue
3608 IntrinsicLibrary::genReshape(mlir::Type resultType,
3609                              llvm::ArrayRef<fir::ExtendedValue> args) {
3610   assert(args.size() == 4);
3611 
3612   // Handle source argument
3613   mlir::Value source = builder.createBox(loc, args[0]);
3614 
3615   // Handle shape argument
3616   mlir::Value shape = builder.createBox(loc, args[1]);
3617   assert(fir::BoxValue(shape).rank() == 1);
3618   mlir::Type shapeTy = shape.getType();
3619   mlir::Type shapeArrTy = fir::dyn_cast_ptrOrBoxEleTy(shapeTy);
3620   auto resultRank = shapeArrTy.cast<fir::SequenceType>().getShape()[0];
3621 
3622   if (resultRank == fir::SequenceType::getUnknownExtent())
3623     TODO(loc, "RESHAPE intrinsic requires computing rank of result");
3624 
3625   // Handle optional pad argument
3626   mlir::Value pad = isStaticallyAbsent(args[2])
3627                         ? builder.create<fir::AbsentOp>(
3628                               loc, fir::BoxType::get(builder.getI1Type()))
3629                         : builder.createBox(loc, args[2]);
3630 
3631   // Handle optional order argument
3632   mlir::Value order = isStaticallyAbsent(args[3])
3633                           ? builder.create<fir::AbsentOp>(
3634                                 loc, fir::BoxType::get(builder.getI1Type()))
3635                           : builder.createBox(loc, args[3]);
3636 
3637   // Create mutable fir.box to be passed to the runtime for the result.
3638   mlir::Type type = builder.getVarLenSeqTy(resultType, resultRank);
3639   fir::MutableBoxValue resultMutableBox =
3640       fir::factory::createTempMutableBox(builder, loc, type);
3641 
3642   mlir::Value resultIrBox =
3643       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3644 
3645   fir::runtime::genReshape(builder, loc, resultIrBox, source, shape, pad,
3646                            order);
3647 
3648   return readAndAddCleanUp(resultMutableBox, resultType,
3649                            "unexpected result for RESHAPE");
3650 }
3651 
3652 // RRSPACING
3653 mlir::Value IntrinsicLibrary::genRRSpacing(mlir::Type resultType,
3654                                            llvm::ArrayRef<mlir::Value> args) {
3655   assert(args.size() == 1);
3656 
3657   return builder.createConvert(
3658       loc, resultType,
3659       fir::runtime::genRRSpacing(builder, loc, fir::getBase(args[0])));
3660 }
3661 
3662 // SCALE
3663 mlir::Value IntrinsicLibrary::genScale(mlir::Type resultType,
3664                                        llvm::ArrayRef<mlir::Value> args) {
3665   assert(args.size() == 2);
3666 
3667   mlir::Value realX = fir::getBase(args[0]);
3668   mlir::Value intI = fir::getBase(args[1]);
3669 
3670   return builder.createConvert(
3671       loc, resultType, fir::runtime::genScale(builder, loc, realX, intI));
3672 }
3673 
3674 // SCAN
3675 fir::ExtendedValue
3676 IntrinsicLibrary::genScan(mlir::Type resultType,
3677                           llvm::ArrayRef<fir::ExtendedValue> args) {
3678 
3679   assert(args.size() == 4);
3680 
3681   if (isStaticallyAbsent(args[3])) {
3682     // Kind not specified, so call scan/verify runtime routine that is
3683     // specialized on the kind of characters in string.
3684 
3685     // Handle required string base arg
3686     mlir::Value stringBase = fir::getBase(args[0]);
3687 
3688     // Handle required set string base arg
3689     mlir::Value setBase = fir::getBase(args[1]);
3690 
3691     // Handle kind argument; it is the kind of character in this case
3692     fir::KindTy kind =
3693         fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
3694             stringBase.getType());
3695 
3696     // Get string length argument
3697     mlir::Value stringLen = fir::getLen(args[0]);
3698 
3699     // Get set string length argument
3700     mlir::Value setLen = fir::getLen(args[1]);
3701 
3702     // Handle optional back argument
3703     mlir::Value back =
3704         isStaticallyAbsent(args[2])
3705             ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
3706             : fir::getBase(args[2]);
3707 
3708     return builder.createConvert(loc, resultType,
3709                                  fir::runtime::genScan(builder, loc, kind,
3710                                                        stringBase, stringLen,
3711                                                        setBase, setLen, back));
3712   }
3713   // else use the runtime descriptor version of scan/verify
3714 
3715   // Handle optional argument, back
3716   auto makeRefThenEmbox = [&](mlir::Value b) {
3717     fir::LogicalType logTy = fir::LogicalType::get(
3718         builder.getContext(), builder.getKindMap().defaultLogicalKind());
3719     mlir::Value temp = builder.createTemporary(loc, logTy);
3720     mlir::Value castb = builder.createConvert(loc, logTy, b);
3721     builder.create<fir::StoreOp>(loc, castb, temp);
3722     return builder.createBox(loc, temp);
3723   };
3724   mlir::Value back = fir::isUnboxedValue(args[2])
3725                          ? makeRefThenEmbox(*args[2].getUnboxed())
3726                          : builder.create<fir::AbsentOp>(
3727                                loc, fir::BoxType::get(builder.getI1Type()));
3728 
3729   // Handle required string argument
3730   mlir::Value string = builder.createBox(loc, args[0]);
3731 
3732   // Handle required set argument
3733   mlir::Value set = builder.createBox(loc, args[1]);
3734 
3735   // Handle kind argument
3736   mlir::Value kind = fir::getBase(args[3]);
3737 
3738   // Create result descriptor
3739   fir::MutableBoxValue resultMutableBox =
3740       fir::factory::createTempMutableBox(builder, loc, resultType);
3741   mlir::Value resultIrBox =
3742       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3743 
3744   fir::runtime::genScanDescriptor(builder, loc, resultIrBox, string, set, back,
3745                                   kind);
3746 
3747   // Handle cleanup of allocatable result descriptor and return
3748   return readAndAddCleanUp(resultMutableBox, resultType, "SCAN");
3749 }
3750 
3751 // SET_EXPONENT
3752 mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType,
3753                                              llvm::ArrayRef<mlir::Value> args) {
3754   assert(args.size() == 2);
3755 
3756   return builder.createConvert(
3757       loc, resultType,
3758       fir::runtime::genSetExponent(builder, loc, fir::getBase(args[0]),
3759                                    fir::getBase(args[1])));
3760 }
3761 
3762 // SHIFTA, SHIFTL, SHIFTR
3763 template <typename Shift>
3764 mlir::Value IntrinsicLibrary::genShift(mlir::Type resultType,
3765                                        llvm::ArrayRef<mlir::Value> args) {
3766   assert(args.size() == 2);
3767 
3768   // If SHIFT < 0 or SHIFT >= BIT_SIZE(I), return 0. This is not required by
3769   // the standard. However, several other compilers behave this way, so try and
3770   // maintain compatibility with them to an extent.
3771 
3772   unsigned bits = resultType.getIntOrFloatBitWidth();
3773   mlir::Value bitSize = builder.createIntegerConstant(loc, resultType, bits);
3774   mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3775   mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
3776 
3777   mlir::Value tooSmall = builder.create<mlir::arith::CmpIOp>(
3778       loc, mlir::arith::CmpIPredicate::slt, shift, zero);
3779   mlir::Value tooLarge = builder.create<mlir::arith::CmpIOp>(
3780       loc, mlir::arith::CmpIPredicate::sge, shift, bitSize);
3781   mlir::Value outOfBounds =
3782       builder.create<mlir::arith::OrIOp>(loc, tooSmall, tooLarge);
3783 
3784   mlir::Value shifted = builder.create<Shift>(loc, args[0], shift);
3785   return builder.create<mlir::arith::SelectOp>(loc, outOfBounds, zero, shifted);
3786 }
3787 
3788 // SIGN
3789 mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType,
3790                                       llvm::ArrayRef<mlir::Value> args) {
3791   assert(args.size() == 2);
3792   if (resultType.isa<mlir::IntegerType>()) {
3793     mlir::Value abs = genAbs(resultType, {args[0]});
3794     mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3795     auto neg = builder.create<mlir::arith::SubIOp>(loc, zero, abs);
3796     auto cmp = builder.create<mlir::arith::CmpIOp>(
3797         loc, mlir::arith::CmpIPredicate::slt, args[1], zero);
3798     return builder.create<mlir::arith::SelectOp>(loc, cmp, neg, abs);
3799   }
3800   return genRuntimeCall("sign", resultType, args);
3801 }
3802 
3803 // SIZE
3804 fir::ExtendedValue
3805 IntrinsicLibrary::genSize(mlir::Type resultType,
3806                           llvm::ArrayRef<fir::ExtendedValue> args) {
3807   // Note that the value of the KIND argument is already reflected in the
3808   // resultType
3809   assert(args.size() == 3);
3810   if (const auto *boxValue = args[0].getBoxOf<fir::BoxValue>())
3811     if (boxValue->hasAssumedRank())
3812       TODO(loc, "SIZE intrinsic with assumed rank argument");
3813 
3814   // Get the ARRAY argument
3815   mlir::Value array = builder.createBox(loc, args[0]);
3816 
3817   // The front-end rewrites SIZE without the DIM argument to
3818   // an array of SIZE with DIM in most cases, but it may not be
3819   // possible in some cases like when in SIZE(function_call()).
3820   if (isStaticallyAbsent(args, 1))
3821     return builder.createConvert(loc, resultType,
3822                                  fir::runtime::genSize(builder, loc, array));
3823 
3824   // Get the DIM argument.
3825   mlir::Value dim = fir::getBase(args[1]);
3826   if (!fir::isa_ref_type(dim.getType()))
3827     return builder.createConvert(
3828         loc, resultType, fir::runtime::genSizeDim(builder, loc, array, dim));
3829 
3830   mlir::Value isDynamicallyAbsent = builder.genIsNullAddr(loc, dim);
3831   return builder
3832       .genIfOp(loc, {resultType}, isDynamicallyAbsent,
3833                /*withElseRegion=*/true)
3834       .genThen([&]() {
3835         mlir::Value size = builder.createConvert(
3836             loc, resultType, fir::runtime::genSize(builder, loc, array));
3837         builder.create<fir::ResultOp>(loc, size);
3838       })
3839       .genElse([&]() {
3840         mlir::Value dimValue = builder.create<fir::LoadOp>(loc, dim);
3841         mlir::Value size = builder.createConvert(
3842             loc, resultType,
3843             fir::runtime::genSizeDim(builder, loc, array, dimValue));
3844         builder.create<fir::ResultOp>(loc, size);
3845       })
3846       .getResults()[0];
3847 }
3848 
3849 // TRAILZ
3850 mlir::Value IntrinsicLibrary::genTrailz(mlir::Type resultType,
3851                                         llvm::ArrayRef<mlir::Value> args) {
3852   assert(args.size() == 1);
3853 
3854   mlir::Value result =
3855       builder.create<mlir::math::CountTrailingZerosOp>(loc, args);
3856 
3857   return builder.createConvert(loc, resultType, result);
3858 }
3859 
3860 static bool hasDefaultLowerBound(const fir::ExtendedValue &exv) {
3861   return exv.match(
3862       [](const fir::ArrayBoxValue &arr) { return arr.getLBounds().empty(); },
3863       [](const fir::CharArrayBoxValue &arr) {
3864         return arr.getLBounds().empty();
3865       },
3866       [](const fir::BoxValue &arr) { return arr.getLBounds().empty(); },
3867       [](const auto &) { return false; });
3868 }
3869 
3870 /// Compute the lower bound in dimension \p dim (zero based) of \p array
3871 /// taking care of returning one when the related extent is zero.
3872 static mlir::Value computeLBOUND(fir::FirOpBuilder &builder, mlir::Location loc,
3873                                  const fir::ExtendedValue &array, unsigned dim,
3874                                  mlir::Value zero, mlir::Value one) {
3875   assert(dim < array.rank() && "invalid dimension");
3876   if (hasDefaultLowerBound(array))
3877     return one;
3878   mlir::Value lb = fir::factory::readLowerBound(builder, loc, array, dim, one);
3879   if (dim + 1 == array.rank() && array.isAssumedSize())
3880     return lb;
3881   mlir::Value extent = fir::factory::readExtent(builder, loc, array, dim);
3882   zero = builder.createConvert(loc, extent.getType(), zero);
3883   auto dimIsEmpty = builder.create<mlir::arith::CmpIOp>(
3884       loc, mlir::arith::CmpIPredicate::eq, extent, zero);
3885   one = builder.createConvert(loc, lb.getType(), one);
3886   return builder.create<mlir::arith::SelectOp>(loc, dimIsEmpty, one, lb);
3887 }
3888 
3889 /// Create a fir.box to be passed to the LBOUND runtime.
3890 /// This ensure that local lower bounds of assumed shape are propagated and that
3891 /// a fir.box with equivalent LBOUNDs but an explicit shape is created for
3892 /// assumed size arrays to avoid undefined behaviors in codegen or the runtime.
3893 static mlir::Value createBoxForLBOUND(mlir::Location loc,
3894                                       fir::FirOpBuilder &builder,
3895                                       const fir::ExtendedValue &array) {
3896   if (!array.isAssumedSize())
3897     return array.match(
3898         [&](const fir::BoxValue &boxValue) -> mlir::Value {
3899           // This entity is mapped to a fir.box that may not contain the local
3900           // lower bound information if it is a dummy. Rebox it with the local
3901           // shape information.
3902           mlir::Value localShape = builder.createShape(loc, array);
3903           mlir::Value oldBox = boxValue.getAddr();
3904           return builder.create<fir::ReboxOp>(loc, oldBox.getType(), oldBox,
3905                                               localShape,
3906                                               /*slice=*/mlir::Value{});
3907         },
3908         [&](const auto &) -> mlir::Value {
3909           // This a pointer/allocatable, or an entity not yet tracked with a
3910           // fir.box. For pointer/allocatable, createBox will forward the
3911           // descriptor that contains the correct lower bound information. For
3912           // other entities, a new fir.box will be made with the local lower
3913           // bounds.
3914           return builder.createBox(loc, array);
3915         });
3916   // Assumed sized are not meant to be emboxed. This could cause the undefined
3917   // extent cannot safely be understood by the runtime/codegen that will
3918   // consider that the dimension is empty and that the related LBOUND value must
3919   // be one. Pretend that the related extent is one to get the correct LBOUND
3920   // value.
3921   llvm::SmallVector<mlir::Value> shape =
3922       fir::factory::getExtents(loc, builder, array);
3923   assert(!shape.empty() && "assumed size must have at least one dimension");
3924   shape.back() = builder.createIntegerConstant(loc, builder.getIndexType(), 1);
3925   auto safeToEmbox = array.match(
3926       [&](const fir::CharArrayBoxValue &x) -> fir::ExtendedValue {
3927         return fir::CharArrayBoxValue{x.getAddr(), x.getLen(), shape,
3928                                       x.getLBounds()};
3929       },
3930       [&](const fir::ArrayBoxValue &x) -> fir::ExtendedValue {
3931         return fir::ArrayBoxValue{x.getAddr(), shape, x.getLBounds()};
3932       },
3933       [&](const auto &) -> fir::ExtendedValue {
3934         fir::emitFatalError(loc, "not an assumed size array");
3935       });
3936   return builder.createBox(loc, safeToEmbox);
3937 }
3938 
3939 // LBOUND
3940 fir::ExtendedValue
3941 IntrinsicLibrary::genLbound(mlir::Type resultType,
3942                             llvm::ArrayRef<fir::ExtendedValue> args) {
3943   assert(args.size() == 2 || args.size() == 3);
3944   const fir::ExtendedValue &array = args[0];
3945   if (const auto *boxValue = array.getBoxOf<fir::BoxValue>())
3946     if (boxValue->hasAssumedRank())
3947       TODO(loc, "LBOUND intrinsic with assumed rank argument");
3948 
3949   //===----------------------------------------------------------------------===//
3950   mlir::Type indexType = builder.getIndexType();
3951 
3952   // Semantics builds signatures for LBOUND calls as either
3953   // LBOUND(array, dim, [kind]) or LBOUND(array, [kind]).
3954   if (args.size() == 2 || isStaticallyAbsent(args, 1)) {
3955     // DIM is absent.
3956     mlir::Type lbType = fir::unwrapSequenceType(resultType);
3957     unsigned rank = array.rank();
3958     mlir::Type lbArrayType = fir::SequenceType::get(
3959         {static_cast<fir::SequenceType::Extent>(array.rank())}, lbType);
3960     mlir::Value lbArray = builder.createTemporary(loc, lbArrayType);
3961     mlir::Type lbAddrType = builder.getRefType(lbType);
3962     mlir::Value one = builder.createIntegerConstant(loc, lbType, 1);
3963     mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
3964     for (unsigned dim = 0; dim < rank; ++dim) {
3965       mlir::Value lb = computeLBOUND(builder, loc, array, dim, zero, one);
3966       lb = builder.createConvert(loc, lbType, lb);
3967       auto index = builder.createIntegerConstant(loc, indexType, dim);
3968       auto lbAddr =
3969           builder.create<fir::CoordinateOp>(loc, lbAddrType, lbArray, index);
3970       builder.create<fir::StoreOp>(loc, lb, lbAddr);
3971     }
3972     mlir::Value lbArrayExtent =
3973         builder.createIntegerConstant(loc, indexType, rank);
3974     llvm::SmallVector<mlir::Value> extents{lbArrayExtent};
3975     return fir::ArrayBoxValue{lbArray, extents};
3976   }
3977   // DIM is present.
3978   mlir::Value dim = fir::getBase(args[1]);
3979 
3980   // If it is a compile time constant, skip the runtime call.
3981   if (llvm::Optional<std::int64_t> cstDim =
3982           fir::factory::getIntIfConstant(dim)) {
3983     mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
3984     mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
3985     mlir::Value lb = computeLBOUND(builder, loc, array, *cstDim - 1, zero, one);
3986     return builder.createConvert(loc, resultType, lb);
3987   }
3988 
3989   fir::ExtendedValue box = createBoxForLBOUND(loc, builder, array);
3990   return builder.createConvert(
3991       loc, resultType,
3992       fir::runtime::genLboundDim(builder, loc, fir::getBase(box), dim));
3993 }
3994 
3995 // UBOUND
3996 fir::ExtendedValue
3997 IntrinsicLibrary::genUbound(mlir::Type resultType,
3998                             llvm::ArrayRef<fir::ExtendedValue> args) {
3999   assert(args.size() == 3 || args.size() == 2);
4000   if (args.size() == 3) {
4001     // Handle calls to UBOUND with the DIM argument, which return a scalar
4002     mlir::Value extent = fir::getBase(genSize(resultType, args));
4003     mlir::Value lbound = fir::getBase(genLbound(resultType, args));
4004 
4005     mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
4006     mlir::Value ubound = builder.create<mlir::arith::SubIOp>(loc, lbound, one);
4007     return builder.create<mlir::arith::AddIOp>(loc, ubound, extent);
4008   } else {
4009     // Handle calls to UBOUND without the DIM argument, which return an array
4010     mlir::Value kind = isStaticallyAbsent(args[1])
4011                            ? builder.createIntegerConstant(
4012                                  loc, builder.getIndexType(),
4013                                  builder.getKindMap().defaultIntegerKind())
4014                            : fir::getBase(args[1]);
4015 
4016     // Create mutable fir.box to be passed to the runtime for the result.
4017     mlir::Type type = builder.getVarLenSeqTy(resultType, /*rank=*/1);
4018     fir::MutableBoxValue resultMutableBox =
4019         fir::factory::createTempMutableBox(builder, loc, type);
4020     mlir::Value resultIrBox =
4021         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4022 
4023     fir::runtime::genUbound(builder, loc, resultIrBox, fir::getBase(args[0]),
4024                             kind);
4025 
4026     return readAndAddCleanUp(resultMutableBox, resultType, "UBOUND");
4027   }
4028   return mlir::Value();
4029 }
4030 
4031 // SPACING
4032 mlir::Value IntrinsicLibrary::genSpacing(mlir::Type resultType,
4033                                          llvm::ArrayRef<mlir::Value> args) {
4034   assert(args.size() == 1);
4035 
4036   return builder.createConvert(
4037       loc, resultType,
4038       fir::runtime::genSpacing(builder, loc, fir::getBase(args[0])));
4039 }
4040 
4041 // SPREAD
4042 fir::ExtendedValue
4043 IntrinsicLibrary::genSpread(mlir::Type resultType,
4044                             llvm::ArrayRef<fir::ExtendedValue> args) {
4045 
4046   assert(args.size() == 3);
4047 
4048   // Handle source argument
4049   mlir::Value source = builder.createBox(loc, args[0]);
4050   fir::BoxValue sourceTmp = source;
4051   unsigned sourceRank = sourceTmp.rank();
4052 
4053   // Handle Dim argument
4054   mlir::Value dim = fir::getBase(args[1]);
4055 
4056   // Handle ncopies argument
4057   mlir::Value ncopies = fir::getBase(args[2]);
4058 
4059   // Generate result descriptor
4060   mlir::Type resultArrayType =
4061       builder.getVarLenSeqTy(resultType, sourceRank + 1);
4062   fir::MutableBoxValue resultMutableBox =
4063       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
4064   mlir::Value resultIrBox =
4065       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4066 
4067   fir::runtime::genSpread(builder, loc, resultIrBox, source, dim, ncopies);
4068 
4069   return readAndAddCleanUp(resultMutableBox, resultType,
4070                            "unexpected result for SPREAD");
4071 }
4072 
4073 // SUM
4074 fir::ExtendedValue
4075 IntrinsicLibrary::genSum(mlir::Type resultType,
4076                          llvm::ArrayRef<fir::ExtendedValue> args) {
4077   return genProdOrSum(fir::runtime::genSum, fir::runtime::genSumDim, resultType,
4078                       builder, loc, stmtCtx, "unexpected result for Sum", args);
4079 }
4080 
4081 // SYSTEM_CLOCK
4082 void IntrinsicLibrary::genSystemClock(llvm::ArrayRef<fir::ExtendedValue> args) {
4083   assert(args.size() == 3);
4084   Fortran::lower::genSystemClock(builder, loc, fir::getBase(args[0]),
4085                                  fir::getBase(args[1]), fir::getBase(args[2]));
4086 }
4087 
4088 // TRANSFER
4089 fir::ExtendedValue
4090 IntrinsicLibrary::genTransfer(mlir::Type resultType,
4091                               llvm::ArrayRef<fir::ExtendedValue> args) {
4092 
4093   assert(args.size() >= 2); // args.size() == 2 when size argument is omitted.
4094 
4095   // Handle source argument
4096   mlir::Value source = builder.createBox(loc, args[0]);
4097 
4098   // Handle mold argument
4099   mlir::Value mold = builder.createBox(loc, args[1]);
4100   fir::BoxValue moldTmp = mold;
4101   unsigned moldRank = moldTmp.rank();
4102 
4103   bool absentSize = (args.size() == 2);
4104 
4105   // Create mutable fir.box to be passed to the runtime for the result.
4106   mlir::Type type = (moldRank == 0 && absentSize)
4107                         ? resultType
4108                         : builder.getVarLenSeqTy(resultType, 1);
4109   fir::MutableBoxValue resultMutableBox =
4110       fir::factory::createTempMutableBox(builder, loc, type);
4111 
4112   if (moldRank == 0 && absentSize) {
4113     // This result is a scalar in this case.
4114     mlir::Value resultIrBox =
4115         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4116 
4117     Fortran::lower::genTransfer(builder, loc, resultIrBox, source, mold);
4118   } else {
4119     // The result is a rank one array in this case.
4120     mlir::Value resultIrBox =
4121         fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4122 
4123     if (absentSize) {
4124       Fortran::lower::genTransfer(builder, loc, resultIrBox, source, mold);
4125     } else {
4126       mlir::Value sizeArg = fir::getBase(args[2]);
4127       Fortran::lower::genTransferSize(builder, loc, resultIrBox, source, mold,
4128                                       sizeArg);
4129     }
4130   }
4131   return readAndAddCleanUp(resultMutableBox, resultType,
4132                            "unexpected result for TRANSFER");
4133 }
4134 
4135 // TRANSPOSE
4136 fir::ExtendedValue
4137 IntrinsicLibrary::genTranspose(mlir::Type resultType,
4138                                llvm::ArrayRef<fir::ExtendedValue> args) {
4139 
4140   assert(args.size() == 1);
4141 
4142   // Handle source argument
4143   mlir::Value source = builder.createBox(loc, args[0]);
4144 
4145   // Create mutable fir.box to be passed to the runtime for the result.
4146   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 2);
4147   fir::MutableBoxValue resultMutableBox =
4148       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
4149   mlir::Value resultIrBox =
4150       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4151   // Call runtime. The runtime is allocating the result.
4152   fir::runtime::genTranspose(builder, loc, resultIrBox, source);
4153   // Read result from mutable fir.box and add it to the list of temps to be
4154   // finalized by the StatementContext.
4155   return readAndAddCleanUp(resultMutableBox, resultType,
4156                            "unexpected result for TRANSPOSE");
4157 }
4158 
4159 // TRIM
4160 fir::ExtendedValue
4161 IntrinsicLibrary::genTrim(mlir::Type resultType,
4162                           llvm::ArrayRef<fir::ExtendedValue> args) {
4163   assert(args.size() == 1);
4164   mlir::Value string = builder.createBox(loc, args[0]);
4165   // Create mutable fir.box to be passed to the runtime for the result.
4166   fir::MutableBoxValue resultMutableBox =
4167       fir::factory::createTempMutableBox(builder, loc, resultType);
4168   mlir::Value resultIrBox =
4169       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4170   // Call runtime. The runtime is allocating the result.
4171   fir::runtime::genTrim(builder, loc, resultIrBox, string);
4172   // Read result from mutable fir.box and add it to the list of temps to be
4173   // finalized by the StatementContext.
4174   return readAndAddCleanUp(resultMutableBox, resultType, "TRIM");
4175 }
4176 
4177 // Compare two FIR values and return boolean result as i1.
4178 template <Extremum extremum, ExtremumBehavior behavior>
4179 static mlir::Value createExtremumCompare(mlir::Location loc,
4180                                          fir::FirOpBuilder &builder,
4181                                          mlir::Value left, mlir::Value right) {
4182   static constexpr mlir::arith::CmpIPredicate integerPredicate =
4183       extremum == Extremum::Max ? mlir::arith::CmpIPredicate::sgt
4184                                 : mlir::arith::CmpIPredicate::slt;
4185   static constexpr mlir::arith::CmpFPredicate orderedCmp =
4186       extremum == Extremum::Max ? mlir::arith::CmpFPredicate::OGT
4187                                 : mlir::arith::CmpFPredicate::OLT;
4188   mlir::Type type = left.getType();
4189   mlir::Value result;
4190   if (fir::isa_real(type)) {
4191     // Note: the signaling/quit aspect of the result required by IEEE
4192     // cannot currently be obtained with LLVM without ad-hoc runtime.
4193     if constexpr (behavior == ExtremumBehavior::IeeeMinMaximumNumber) {
4194       // Return the number if one of the inputs is NaN and the other is
4195       // a number.
4196       auto leftIsResult =
4197           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
4198       auto rightIsNan = builder.create<mlir::arith::CmpFOp>(
4199           loc, mlir::arith::CmpFPredicate::UNE, right, right);
4200       result =
4201           builder.create<mlir::arith::OrIOp>(loc, leftIsResult, rightIsNan);
4202     } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) {
4203       // Always return NaNs if one the input is NaNs
4204       auto leftIsResult =
4205           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
4206       auto leftIsNan = builder.create<mlir::arith::CmpFOp>(
4207           loc, mlir::arith::CmpFPredicate::UNE, left, left);
4208       result = builder.create<mlir::arith::OrIOp>(loc, leftIsResult, leftIsNan);
4209     } else if constexpr (behavior == ExtremumBehavior::MinMaxss) {
4210       // If the left is a NaN, return the right whatever it is.
4211       result =
4212           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
4213     } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) {
4214       // If one of the operand is a NaN, return left whatever it is.
4215       static constexpr auto unorderedCmp =
4216           extremum == Extremum::Max ? mlir::arith::CmpFPredicate::UGT
4217                                     : mlir::arith::CmpFPredicate::ULT;
4218       result =
4219           builder.create<mlir::arith::CmpFOp>(loc, unorderedCmp, left, right);
4220     } else {
4221       // TODO: ieeeMinNum/ieeeMaxNum
4222       static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum,
4223                     "ieeeMinNum/ieeeMaxNum behavior not implemented");
4224     }
4225   } else if (fir::isa_integer(type)) {
4226     result =
4227         builder.create<mlir::arith::CmpIOp>(loc, integerPredicate, left, right);
4228   } else if (fir::isa_char(type) || fir::isa_char(fir::unwrapRefType(type))) {
4229     // TODO: ! character min and max is tricky because the result
4230     // length is the length of the longest argument!
4231     // So we may need a temp.
4232     TODO(loc, "CHARACTER min and max");
4233   }
4234   assert(result && "result must be defined");
4235   return result;
4236 }
4237 
4238 // UNPACK
4239 fir::ExtendedValue
4240 IntrinsicLibrary::genUnpack(mlir::Type resultType,
4241                             llvm::ArrayRef<fir::ExtendedValue> args) {
4242   assert(args.size() == 3);
4243 
4244   // Handle required vector argument
4245   mlir::Value vector = builder.createBox(loc, args[0]);
4246 
4247   // Handle required mask argument
4248   fir::BoxValue maskBox = builder.createBox(loc, args[1]);
4249   mlir::Value mask = fir::getBase(maskBox);
4250   unsigned maskRank = maskBox.rank();
4251 
4252   // Handle required field argument
4253   mlir::Value field = builder.createBox(loc, args[2]);
4254 
4255   // Create mutable fir.box to be passed to the runtime for the result.
4256   mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, maskRank);
4257   fir::MutableBoxValue resultMutableBox =
4258       fir::factory::createTempMutableBox(builder, loc, resultArrayType);
4259   mlir::Value resultIrBox =
4260       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4261 
4262   fir::runtime::genUnpack(builder, loc, resultIrBox, vector, mask, field);
4263 
4264   return readAndAddCleanUp(resultMutableBox, resultType,
4265                            "unexpected result for UNPACK");
4266 }
4267 
4268 // VERIFY
4269 fir::ExtendedValue
4270 IntrinsicLibrary::genVerify(mlir::Type resultType,
4271                             llvm::ArrayRef<fir::ExtendedValue> args) {
4272 
4273   assert(args.size() == 4);
4274 
4275   if (isStaticallyAbsent(args[3])) {
4276     // Kind not specified, so call scan/verify runtime routine that is
4277     // specialized on the kind of characters in string.
4278 
4279     // Handle required string base arg
4280     mlir::Value stringBase = fir::getBase(args[0]);
4281 
4282     // Handle required set string base arg
4283     mlir::Value setBase = fir::getBase(args[1]);
4284 
4285     // Handle kind argument; it is the kind of character in this case
4286     fir::KindTy kind =
4287         fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
4288             stringBase.getType());
4289 
4290     // Get string length argument
4291     mlir::Value stringLen = fir::getLen(args[0]);
4292 
4293     // Get set string length argument
4294     mlir::Value setLen = fir::getLen(args[1]);
4295 
4296     // Handle optional back argument
4297     mlir::Value back =
4298         isStaticallyAbsent(args[2])
4299             ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
4300             : fir::getBase(args[2]);
4301 
4302     return builder.createConvert(
4303         loc, resultType,
4304         fir::runtime::genVerify(builder, loc, kind, stringBase, stringLen,
4305                                 setBase, setLen, back));
4306   }
4307   // else use the runtime descriptor version of scan/verify
4308 
4309   // Handle optional argument, back
4310   auto makeRefThenEmbox = [&](mlir::Value b) {
4311     fir::LogicalType logTy = fir::LogicalType::get(
4312         builder.getContext(), builder.getKindMap().defaultLogicalKind());
4313     mlir::Value temp = builder.createTemporary(loc, logTy);
4314     mlir::Value castb = builder.createConvert(loc, logTy, b);
4315     builder.create<fir::StoreOp>(loc, castb, temp);
4316     return builder.createBox(loc, temp);
4317   };
4318   mlir::Value back = fir::isUnboxedValue(args[2])
4319                          ? makeRefThenEmbox(*args[2].getUnboxed())
4320                          : builder.create<fir::AbsentOp>(
4321                                loc, fir::BoxType::get(builder.getI1Type()));
4322 
4323   // Handle required string argument
4324   mlir::Value string = builder.createBox(loc, args[0]);
4325 
4326   // Handle required set argument
4327   mlir::Value set = builder.createBox(loc, args[1]);
4328 
4329   // Handle kind argument
4330   mlir::Value kind = fir::getBase(args[3]);
4331 
4332   // Create result descriptor
4333   fir::MutableBoxValue resultMutableBox =
4334       fir::factory::createTempMutableBox(builder, loc, resultType);
4335   mlir::Value resultIrBox =
4336       fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4337 
4338   fir::runtime::genVerifyDescriptor(builder, loc, resultIrBox, string, set,
4339                                     back, kind);
4340 
4341   // Handle cleanup of allocatable result descriptor and return
4342   return readAndAddCleanUp(resultMutableBox, resultType, "VERIFY");
4343 }
4344 
4345 // MAXLOC
4346 fir::ExtendedValue
4347 IntrinsicLibrary::genMaxloc(mlir::Type resultType,
4348                             llvm::ArrayRef<fir::ExtendedValue> args) {
4349   return genExtremumloc(fir::runtime::genMaxloc, fir::runtime::genMaxlocDim,
4350                         resultType, builder, loc, stmtCtx,
4351                         "unexpected result for Maxloc", args);
4352 }
4353 
4354 // MAXVAL
4355 fir::ExtendedValue
4356 IntrinsicLibrary::genMaxval(mlir::Type resultType,
4357                             llvm::ArrayRef<fir::ExtendedValue> args) {
4358   return genExtremumVal(fir::runtime::genMaxval, fir::runtime::genMaxvalDim,
4359                         fir::runtime::genMaxvalChar, resultType, builder, loc,
4360                         stmtCtx, "unexpected result for Maxval", args);
4361 }
4362 
4363 // MINLOC
4364 fir::ExtendedValue
4365 IntrinsicLibrary::genMinloc(mlir::Type resultType,
4366                             llvm::ArrayRef<fir::ExtendedValue> args) {
4367   return genExtremumloc(fir::runtime::genMinloc, fir::runtime::genMinlocDim,
4368                         resultType, builder, loc, stmtCtx,
4369                         "unexpected result for Minloc", args);
4370 }
4371 
4372 // MINVAL
4373 fir::ExtendedValue
4374 IntrinsicLibrary::genMinval(mlir::Type resultType,
4375                             llvm::ArrayRef<fir::ExtendedValue> args) {
4376   return genExtremumVal(fir::runtime::genMinval, fir::runtime::genMinvalDim,
4377                         fir::runtime::genMinvalChar, resultType, builder, loc,
4378                         stmtCtx, "unexpected result for Minval", args);
4379 }
4380 
4381 // MIN and MAX
4382 template <Extremum extremum, ExtremumBehavior behavior>
4383 mlir::Value IntrinsicLibrary::genExtremum(mlir::Type,
4384                                           llvm::ArrayRef<mlir::Value> args) {
4385   assert(args.size() >= 1);
4386   mlir::Value result = args[0];
4387   for (auto arg : args.drop_front()) {
4388     mlir::Value mask =
4389         createExtremumCompare<extremum, behavior>(loc, builder, result, arg);
4390     result = builder.create<mlir::arith::SelectOp>(loc, mask, result, arg);
4391   }
4392   return result;
4393 }
4394 
4395 //===----------------------------------------------------------------------===//
4396 // Argument lowering rules interface
4397 //===----------------------------------------------------------------------===//
4398 
4399 const Fortran::lower::IntrinsicArgumentLoweringRules *
4400 Fortran::lower::getIntrinsicArgumentLowering(llvm::StringRef intrinsicName) {
4401   if (const IntrinsicHandler *handler = findIntrinsicHandler(intrinsicName))
4402     if (!handler->argLoweringRules.hasDefaultRules())
4403       return &handler->argLoweringRules;
4404   return nullptr;
4405 }
4406 
4407 /// Return how argument \p argName should be lowered given the rules for the
4408 /// intrinsic function.
4409 Fortran::lower::ArgLoweringRule Fortran::lower::lowerIntrinsicArgumentAs(
4410     const IntrinsicArgumentLoweringRules &rules, unsigned position) {
4411   assert(position < sizeof(rules.args) / sizeof(decltype(*rules.args)) &&
4412          "invalid argument");
4413   return {rules.args[position].lowerAs,
4414           rules.args[position].handleDynamicOptional};
4415 }
4416 
4417 //===----------------------------------------------------------------------===//
4418 // Public intrinsic call helpers
4419 //===----------------------------------------------------------------------===//
4420 
4421 fir::ExtendedValue
4422 Fortran::lower::genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
4423                                  llvm::StringRef name,
4424                                  llvm::Optional<mlir::Type> resultType,
4425                                  llvm::ArrayRef<fir::ExtendedValue> args,
4426                                  Fortran::lower::StatementContext &stmtCtx) {
4427   return IntrinsicLibrary{builder, loc, &stmtCtx}.genIntrinsicCall(
4428       name, resultType, args);
4429 }
4430 
4431 mlir::Value Fortran::lower::genMax(fir::FirOpBuilder &builder,
4432                                    mlir::Location loc,
4433                                    llvm::ArrayRef<mlir::Value> args) {
4434   assert(args.size() > 0 && "max requires at least one argument");
4435   return IntrinsicLibrary{builder, loc}
4436       .genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>(args[0].getType(),
4437                                                               args);
4438 }
4439 
4440 mlir::Value Fortran::lower::genMin(fir::FirOpBuilder &builder,
4441                                    mlir::Location loc,
4442                                    llvm::ArrayRef<mlir::Value> args) {
4443   assert(args.size() > 0 && "min requires at least one argument");
4444   return IntrinsicLibrary{builder, loc}
4445       .genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>(args[0].getType(),
4446                                                               args);
4447 }
4448 
4449 mlir::Value Fortran::lower::genPow(fir::FirOpBuilder &builder,
4450                                    mlir::Location loc, mlir::Type type,
4451                                    mlir::Value x, mlir::Value y) {
4452   // TODO: since there is no libm version of pow with integer exponent,
4453   //       we have to provide an alternative implementation for
4454   //       "precise/strict" FP mode.
4455   //       One option is to generate internal function with inlined
4456   //       implementation and mark it 'strictfp'.
4457   //       Another option is to implement it in Fortran runtime library
4458   //       (just like matmul).
4459   return IntrinsicLibrary{builder, loc}.genRuntimeCall("pow", type, {x, y});
4460 }
4461 
4462 mlir::SymbolRefAttr Fortran::lower::getUnrestrictedIntrinsicSymbolRefAttr(
4463     fir::FirOpBuilder &builder, mlir::Location loc, llvm::StringRef name,
4464     mlir::FunctionType signature) {
4465   return IntrinsicLibrary{builder, loc}.getUnrestrictedIntrinsicSymbolRefAttr(
4466       name, signature);
4467 }
4468