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