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