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 "RTBuilder.h"
18 #include "flang/Common/static-multimap-view.h"
19 #include "flang/Lower/CharacterExpr.h"
20 #include "flang/Lower/ComplexExpr.h"
21 #include "flang/Lower/ConvertType.h"
22 #include "flang/Lower/Mangler.h"
23 #include "flang/Lower/Runtime.h"
24 #include "flang/Optimizer/Builder/FIRBuilder.h"
25 #include "llvm/Support/CommandLine.h"
26 #include "llvm/Support/ErrorHandling.h"
27 #include <algorithm>
28 #include <string_view>
29 #include <utility>
30 
31 #define PGMATH_DECLARE
32 #include "flang/Evaluate/pgmath.h.inc"
33 
34 /// This file implements lowering of Fortran intrinsic procedures.
35 /// Intrinsics are lowered to a mix of FIR and MLIR operations as
36 /// well as call to runtime functions or LLVM intrinsics.
37 
38 /// Lowering of intrinsic procedure calls is based on a map that associates
39 /// Fortran intrinsic generic names to FIR generator functions.
40 /// All generator functions are member functions of the IntrinsicLibrary class
41 /// and have the same interface.
42 /// If no generator is given for an intrinsic name, a math runtime library
43 /// is searched for an implementation and, if a runtime function is found,
44 /// a call is generated for it. LLVM intrinsics are handled as a math
45 /// runtime library here.
46 
47 /// Enums used to templatize and share lowering of MIN and MAX.
48 enum class Extremum { Min, Max };
49 
50 // There are different ways to deal with NaNs in MIN and MAX.
51 // Known existing behaviors are listed below and can be selected for
52 // f18 MIN/MAX implementation.
53 enum class ExtremumBehavior {
54   // Note: the Signaling/quiet aspect of NaNs in the behaviors below are
55   // not described because there is no way to control/observe such aspect in
56   // MLIR/LLVM yet. The IEEE behaviors come with requirements regarding this
57   // aspect that are therefore currently not enforced. In the descriptions
58   // below, NaNs can be signaling or quite. Returned NaNs may be signaling
59   // if one of the input NaN was signaling but it cannot be guaranteed either.
60   // Existing compilers using an IEEE behavior (gfortran) also do not fulfill
61   // signaling/quiet requirements.
62   IeeeMinMaximumNumber,
63   // IEEE minimumNumber/maximumNumber behavior (754-2019, section 9.6):
64   // If one of the argument is and number and the other is NaN, return the
65   // number. If both arguements are NaN, return NaN.
66   // Compilers: gfortran.
67   IeeeMinMaximum,
68   // IEEE minimum/maximum behavior (754-2019, section 9.6):
69   // If one of the argument is NaN, return NaN.
70   MinMaxss,
71   // x86 minss/maxss behavior:
72   // If the second argument is a number and the other is NaN, return the number.
73   // In all other cases where at least one operand is NaN, return NaN.
74   // Compilers: xlf (only for MAX), ifort, pgfortran -nollvm, and nagfor.
75   PgfortranLlvm,
76   // "Opposite of" x86 minss/maxss behavior:
77   // If the first argument is a number and the other is NaN, return the
78   // number.
79   // In all other cases where at least one operand is NaN, return NaN.
80   // Compilers: xlf (only for MIN), and pgfortran (with llvm).
81   IeeeMinMaxNum
82   // IEEE minNum/maxNum behavior (754-2008, section 5.3.1):
83   // TODO: Not implemented.
84   // It is the only behavior where the signaling/quiet aspect of a NaN argument
85   // impacts if the result should be NaN or the argument that is a number.
86   // LLVM/MLIR do not provide ways to observe this aspect, so it is not
87   // possible to implement it without some target dependent runtime.
88 };
89 
90 // TODO error handling -> return a code or directly emit messages ?
91 struct IntrinsicLibrary {
92 
93   // Constructors.
94   explicit IntrinsicLibrary(fir::FirOpBuilder &builder, mlir::Location loc)
95       : builder{builder}, loc{loc} {}
96   IntrinsicLibrary() = delete;
97   IntrinsicLibrary(const IntrinsicLibrary &) = delete;
98 
99   /// Generate FIR for call to Fortran intrinsic \p name with arguments \p arg
100   /// and expected result type \p resultType.
101   fir::ExtendedValue genIntrinsicCall(llvm::StringRef name,
102                                       mlir::Type resultType,
103                                       llvm::ArrayRef<fir::ExtendedValue> arg);
104 
105   /// Search a runtime function that is associated to the generic intrinsic name
106   /// and whose signature matches the intrinsic arguments and result types.
107   /// If no such runtime function is found but a runtime function associated
108   /// with the Fortran generic exists and has the same number of arguments,
109   /// conversions will be inserted before and/or after the call. This is to
110   /// mainly to allow 16 bits float support even-though little or no math
111   /// runtime is currently available for it.
112   mlir::Value genRuntimeCall(llvm::StringRef name, mlir::Type,
113                              llvm::ArrayRef<mlir::Value>);
114 
115   using RuntimeCallGenerator = std::function<mlir::Value(
116       fir::FirOpBuilder &, mlir::Location, llvm::ArrayRef<mlir::Value>)>;
117   RuntimeCallGenerator
118   getRuntimeCallGenerator(llvm::StringRef name,
119                           mlir::FunctionType soughtFuncType);
120 
121   mlir::Value genAbs(mlir::Type, llvm::ArrayRef<mlir::Value>);
122   mlir::Value genAimag(mlir::Type, llvm::ArrayRef<mlir::Value>);
123   mlir::Value genAint(mlir::Type, llvm::ArrayRef<mlir::Value>);
124   mlir::Value genAnint(mlir::Type, llvm::ArrayRef<mlir::Value>);
125   mlir::Value genCeiling(mlir::Type, llvm::ArrayRef<mlir::Value>);
126   mlir::Value genConjg(mlir::Type, llvm::ArrayRef<mlir::Value>);
127   mlir::Value genDim(mlir::Type, llvm::ArrayRef<mlir::Value>);
128   mlir::Value genDprod(mlir::Type, llvm::ArrayRef<mlir::Value>);
129   template <Extremum, ExtremumBehavior>
130   mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
131   mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
132   mlir::Value genIAnd(mlir::Type, llvm::ArrayRef<mlir::Value>);
133   mlir::Value genIchar(mlir::Type, llvm::ArrayRef<mlir::Value>);
134   mlir::Value genIEOr(mlir::Type, llvm::ArrayRef<mlir::Value>);
135   mlir::Value genIOr(mlir::Type, llvm::ArrayRef<mlir::Value>);
136   fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
137   fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
138   mlir::Value genMerge(mlir::Type, llvm::ArrayRef<mlir::Value>);
139   mlir::Value genMod(mlir::Type, llvm::ArrayRef<mlir::Value>);
140   mlir::Value genNint(mlir::Type, llvm::ArrayRef<mlir::Value>);
141   mlir::Value genSign(mlir::Type, llvm::ArrayRef<mlir::Value>);
142   /// Implement all conversion functions like DBLE, the first argument is
143   /// the value to convert. There may be an additional KIND arguments that
144   /// is ignored because this is already reflected in the result type.
145   mlir::Value genConversion(mlir::Type, llvm::ArrayRef<mlir::Value>);
146 
147   /// Define the different FIR generators that can be mapped to intrinsic to
148   /// generate the related code.
149   using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs);
150   using ExtendedGenerator = decltype(&IntrinsicLibrary::genLenTrim);
151   using Generator = std::variant<ElementalGenerator, ExtendedGenerator>;
152 
153   /// All generators can be outlined. This will build a function named
154   /// "fir."+ <generic name> + "." + <result type code> and generate the
155   /// intrinsic implementation inside instead of at the intrinsic call sites.
156   /// This can be used to keep the FIR more readable. Only one function will
157   /// be generated for all the similar calls in a program.
158   /// If the Generator is nullptr, the wrapper uses genRuntimeCall.
159   template <typename GeneratorType>
160   mlir::Value outlineInWrapper(GeneratorType, llvm::StringRef name,
161                                mlir::Type resultType,
162                                llvm::ArrayRef<mlir::Value> args);
163   fir::ExtendedValue outlineInWrapper(ExtendedGenerator, llvm::StringRef name,
164                                       mlir::Type resultType,
165                                       llvm::ArrayRef<fir::ExtendedValue> args);
166 
167   template <typename GeneratorType>
168   mlir::FuncOp getWrapper(GeneratorType, llvm::StringRef name,
169                           mlir::FunctionType, bool loadRefArguments = false);
170 
171   /// Generate calls to ElementalGenerator, handling the elemental aspects
172   template <typename GeneratorType>
173   fir::ExtendedValue
174   genElementalCall(GeneratorType, llvm::StringRef name, mlir::Type resultType,
175                    llvm::ArrayRef<fir::ExtendedValue> args, bool outline);
176 
177   /// Helper to invoke code generator for the intrinsics given arguments.
178   mlir::Value invokeGenerator(ElementalGenerator generator,
179                               mlir::Type resultType,
180                               llvm::ArrayRef<mlir::Value> args);
181   mlir::Value invokeGenerator(RuntimeCallGenerator generator,
182                               mlir::Type resultType,
183                               llvm::ArrayRef<mlir::Value> args);
184   mlir::Value invokeGenerator(ExtendedGenerator generator,
185                               mlir::Type resultType,
186                               llvm::ArrayRef<mlir::Value> args);
187 
188   /// Get pointer to unrestricted intrinsic. Generate the related unrestricted
189   /// intrinsic if it is not defined yet.
190   mlir::SymbolRefAttr
191   getUnrestrictedIntrinsicSymbolRefAttr(llvm::StringRef name,
192                                         mlir::FunctionType signature);
193 
194   fir::FirOpBuilder &builder;
195   mlir::Location loc;
196 };
197 
198 /// Table that drives the fir generation depending on the intrinsic.
199 /// one to one mapping with Fortran arguments. If no mapping is
200 /// defined here for a generic intrinsic, genRuntimeCall will be called
201 /// to look for a match in the runtime a emit a call.
202 struct IntrinsicHandler {
203   const char *name;
204   IntrinsicLibrary::Generator generator;
205   bool isElemental = true;
206   /// Code heavy intrinsic can be outlined to make FIR
207   /// more readable.
208   bool outline = false;
209 };
210 using I = IntrinsicLibrary;
211 static constexpr IntrinsicHandler handlers[]{
212     {"abs", &I::genAbs},
213     {"achar", &I::genConversion},
214     {"aimag", &I::genAimag},
215     {"aint", &I::genAint},
216     {"anint", &I::genAnint},
217     {"ceiling", &I::genCeiling},
218     {"char", &I::genConversion},
219     {"conjg", &I::genConjg},
220     {"dim", &I::genDim},
221     {"dble", &I::genConversion},
222     {"dprod", &I::genDprod},
223     {"floor", &I::genFloor},
224     {"iand", &I::genIAnd},
225     {"ichar", &I::genIchar},
226     {"ieor", &I::genIEOr},
227     {"ior", &I::genIOr},
228     {"len", &I::genLen},
229     {"len_trim", &I::genLenTrim},
230     {"max", &I::genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>},
231     {"min", &I::genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>},
232     {"merge", &I::genMerge},
233     {"mod", &I::genMod},
234     {"nint", &I::genNint},
235     {"sign", &I::genSign},
236 };
237 
238 /// To make fir output more readable for debug, one can outline all intrinsic
239 /// implementation in wrappers (overrides the IntrinsicHandler::outline flag).
240 static llvm::cl::opt<bool> outlineAllIntrinsics(
241     "outline-intrinsics",
242     llvm::cl::desc(
243         "Lower all intrinsic procedure implementation in their own functions"),
244     llvm::cl::init(false));
245 
246 //===----------------------------------------------------------------------===//
247 // Math runtime description and matching utility
248 //===----------------------------------------------------------------------===//
249 
250 /// Command line option to modify math runtime version used to implement
251 /// intrinsics.
252 enum MathRuntimeVersion {
253   fastVersion,
254   relaxedVersion,
255   preciseVersion,
256   llvmOnly
257 };
258 llvm::cl::opt<MathRuntimeVersion> mathRuntimeVersion(
259     "math-runtime", llvm::cl::desc("Select math runtime version:"),
260     llvm::cl::values(
261         clEnumValN(fastVersion, "fast", "use pgmath fast runtime"),
262         clEnumValN(relaxedVersion, "relaxed", "use pgmath relaxed runtime"),
263         clEnumValN(preciseVersion, "precise", "use pgmath precise runtime"),
264         clEnumValN(llvmOnly, "llvm",
265                    "only use LLVM intrinsics (may be incomplete)")),
266     llvm::cl::init(fastVersion));
267 
268 struct RuntimeFunction {
269   // llvm::StringRef comparison operator are not constexpr, so use string_view.
270   using Key = std::string_view;
271   // Needed for implicit compare with keys.
272   constexpr operator Key() const { return key; }
273   Key key; // intrinsic name
274   llvm::StringRef symbol;
275   Fortran::lower::FuncTypeBuilderFunc typeGenerator;
276 };
277 
278 #define RUNTIME_STATIC_DESCRIPTION(name, func)                                 \
279   {#name, #func,                                                               \
280    Fortran::lower::RuntimeTableKey<decltype(func)>::getTypeModel()},
281 static constexpr RuntimeFunction pgmathFast[] = {
282 #define PGMATH_FAST
283 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
284 #include "flang/Evaluate/pgmath.h.inc"
285 };
286 static constexpr RuntimeFunction pgmathRelaxed[] = {
287 #define PGMATH_RELAXED
288 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
289 #include "flang/Evaluate/pgmath.h.inc"
290 };
291 static constexpr RuntimeFunction pgmathPrecise[] = {
292 #define PGMATH_PRECISE
293 #define PGMATH_USE_ALL_TYPES(name, func) RUNTIME_STATIC_DESCRIPTION(name, func)
294 #include "flang/Evaluate/pgmath.h.inc"
295 };
296 
297 static mlir::FunctionType genF32F32FuncType(mlir::MLIRContext *context) {
298   auto t = mlir::FloatType::getF32(context);
299   return mlir::FunctionType::get(context, {t}, {t});
300 }
301 
302 static mlir::FunctionType genF64F64FuncType(mlir::MLIRContext *context) {
303   auto t = mlir::FloatType::getF64(context);
304   return mlir::FunctionType::get(context, {t}, {t});
305 }
306 
307 template <int Bits>
308 static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) {
309   auto t = mlir::FloatType::getF64(context);
310   auto r = mlir::IntegerType::get(context, Bits);
311   return mlir::FunctionType::get(context, {t}, {r});
312 }
313 
314 template <int Bits>
315 static mlir::FunctionType genIntF32FuncType(mlir::MLIRContext *context) {
316   auto t = mlir::FloatType::getF32(context);
317   auto r = mlir::IntegerType::get(context, Bits);
318   return mlir::FunctionType::get(context, {t}, {r});
319 }
320 
321 // TODO : Fill-up this table with more intrinsic.
322 // Note: These are also defined as operations in LLVM dialect. See if this
323 // can be use and has advantages.
324 static constexpr RuntimeFunction llvmIntrinsics[] = {
325     {"abs", "llvm.fabs.f32", genF32F32FuncType},
326     {"abs", "llvm.fabs.f64", genF64F64FuncType},
327     {"aint", "llvm.trunc.f32", genF32F32FuncType},
328     {"aint", "llvm.trunc.f64", genF64F64FuncType},
329     {"anint", "llvm.round.f32", genF32F32FuncType},
330     {"anint", "llvm.round.f64", genF64F64FuncType},
331     // ceil is used for CEILING but is different, it returns a real.
332     {"ceil", "llvm.ceil.f32", genF32F32FuncType},
333     {"ceil", "llvm.ceil.f64", genF64F64FuncType},
334     {"cos", "llvm.cos.f32", genF32F32FuncType},
335     {"cos", "llvm.cos.f64", genF64F64FuncType},
336     // llvm.floor is used for FLOOR, but returns real.
337     {"floor", "llvm.floor.f32", genF32F32FuncType},
338     {"floor", "llvm.floor.f64", genF64F64FuncType},
339     {"log", "llvm.log.f32", genF32F32FuncType},
340     {"log", "llvm.log.f64", genF64F64FuncType},
341     {"log10", "llvm.log10.f32", genF32F32FuncType},
342     {"log10", "llvm.log10.f64", genF64F64FuncType},
343     {"nint", "llvm.lround.i64.f64", genIntF64FuncType<64>},
344     {"nint", "llvm.lround.i64.f32", genIntF32FuncType<64>},
345     {"nint", "llvm.lround.i32.f64", genIntF64FuncType<32>},
346     {"nint", "llvm.lround.i32.f32", genIntF32FuncType<32>},
347     {"sin", "llvm.sin.f32", genF32F32FuncType},
348     {"sin", "llvm.sin.f64", genF64F64FuncType},
349     {"sqrt", "llvm.sqrt.f32", genF32F32FuncType},
350     {"sqrt", "llvm.sqrt.f64", genF64F64FuncType},
351 };
352 
353 // This helper class computes a "distance" between two function types.
354 // The distance measures how many narrowing conversions of actual arguments
355 // and result of "from" must be made in order to use "to" instead of "from".
356 // For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is
357 // greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means
358 // if no implementation of ACOS(REAL(10)) is available, it is better to use
359 // ACOS(REAL(16)) with casts rather than ACOS(REAL(8)).
360 // Note that this is not a symmetric distance and the order of "from" and "to"
361 // arguments matters, d(foo, bar) may not be the same as d(bar, foo) because it
362 // may be safe to replace foo by bar, but not the opposite.
363 class FunctionDistance {
364 public:
365   FunctionDistance() : infinite{true} {}
366 
367   FunctionDistance(mlir::FunctionType from, mlir::FunctionType to) {
368     auto nInputs = from.getNumInputs();
369     auto nResults = from.getNumResults();
370     if (nResults != to.getNumResults() || nInputs != to.getNumInputs()) {
371       infinite = true;
372     } else {
373       for (decltype(nInputs) i{0}; i < nInputs && !infinite; ++i)
374         addArgumentDistance(from.getInput(i), to.getInput(i));
375       for (decltype(nResults) i{0}; i < nResults && !infinite; ++i)
376         addResultDistance(to.getResult(i), from.getResult(i));
377     }
378   }
379 
380   /// Beware both d1.isSmallerThan(d2) *and* d2.isSmallerThan(d1) may be
381   /// false if both d1 and d2 are infinite. This implies that
382   ///  d1.isSmallerThan(d2) is not equivalent to !d2.isSmallerThan(d1)
383   bool isSmallerThan(const FunctionDistance &d) const {
384     return !infinite &&
385            (d.infinite || std::lexicographical_compare(
386                               conversions.begin(), conversions.end(),
387                               d.conversions.begin(), d.conversions.end()));
388   }
389 
390   bool isLosingPrecision() const {
391     return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0;
392   }
393 
394   bool isInfinite() const { return infinite; }
395 
396 private:
397   enum class Conversion { Forbidden, None, Narrow, Extend };
398 
399   void addArgumentDistance(mlir::Type from, mlir::Type to) {
400     switch (conversionBetweenTypes(from, to)) {
401     case Conversion::Forbidden:
402       infinite = true;
403       break;
404     case Conversion::None:
405       break;
406     case Conversion::Narrow:
407       conversions[narrowingArg]++;
408       break;
409     case Conversion::Extend:
410       conversions[nonNarrowingArg]++;
411       break;
412     }
413   }
414 
415   void addResultDistance(mlir::Type from, mlir::Type to) {
416     switch (conversionBetweenTypes(from, to)) {
417     case Conversion::Forbidden:
418       infinite = true;
419       break;
420     case Conversion::None:
421       break;
422     case Conversion::Narrow:
423       conversions[nonExtendingResult]++;
424       break;
425     case Conversion::Extend:
426       conversions[extendingResult]++;
427       break;
428     }
429   }
430 
431   // Floating point can be mlir::FloatType or fir::real
432   static unsigned getFloatingPointWidth(mlir::Type t) {
433     if (auto f{t.dyn_cast<mlir::FloatType>()})
434       return f.getWidth();
435     // FIXME: Get width another way for fir.real/complex
436     // - use fir/KindMapping.h and llvm::Type
437     // - or use evaluate/type.h
438     if (auto r{t.dyn_cast<fir::RealType>()})
439       return r.getFKind() * 4;
440     if (auto cplx{t.dyn_cast<fir::ComplexType>()})
441       return cplx.getFKind() * 4;
442     llvm_unreachable("not a floating-point type");
443   }
444 
445   static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) {
446     if (from == to) {
447       return Conversion::None;
448     }
449     if (auto fromIntTy{from.dyn_cast<mlir::IntegerType>()}) {
450       if (auto toIntTy{to.dyn_cast<mlir::IntegerType>()}) {
451         return fromIntTy.getWidth() > toIntTy.getWidth() ? Conversion::Narrow
452                                                          : Conversion::Extend;
453       }
454     }
455     if (fir::isa_real(from) && fir::isa_real(to)) {
456       return getFloatingPointWidth(from) > getFloatingPointWidth(to)
457                  ? Conversion::Narrow
458                  : Conversion::Extend;
459     }
460     if (auto fromCplxTy{from.dyn_cast<fir::ComplexType>()}) {
461       if (auto toCplxTy{to.dyn_cast<fir::ComplexType>()}) {
462         return getFloatingPointWidth(fromCplxTy) >
463                        getFloatingPointWidth(toCplxTy)
464                    ? Conversion::Narrow
465                    : Conversion::Extend;
466       }
467     }
468     // Notes:
469     // - No conversion between character types, specialization of runtime
470     // functions should be made instead.
471     // - It is not clear there is a use case for automatic conversions
472     // around Logical and it may damage hidden information in the physical
473     // storage so do not do it.
474     return Conversion::Forbidden;
475   }
476 
477   // Below are indexes to access data in conversions.
478   // The order in data does matter for lexicographical_compare
479   enum {
480     narrowingArg = 0,   // usually bad
481     extendingResult,    // usually bad
482     nonExtendingResult, // usually ok
483     nonNarrowingArg,    // usually ok
484     dataSize
485   };
486 
487   std::array<int, dataSize> conversions{/* zero init*/};
488   bool infinite{false}; // When forbidden conversion or wrong argument number
489 };
490 
491 /// Build mlir::FuncOp from runtime symbol description and add
492 /// fir.runtime attribute.
493 static mlir::FuncOp getFuncOp(mlir::Location loc, fir::FirOpBuilder &builder,
494                               const RuntimeFunction &runtime) {
495   auto function = builder.addNamedFunction(
496       loc, runtime.symbol, runtime.typeGenerator(builder.getContext()));
497   function->setAttr("fir.runtime", builder.getUnitAttr());
498   return function;
499 }
500 
501 /// Select runtime function that has the smallest distance to the intrinsic
502 /// function type and that will not imply narrowing arguments or extending the
503 /// result.
504 /// If nothing is found, the mlir::FuncOp will contain a nullptr.
505 mlir::FuncOp searchFunctionInLibrary(
506     mlir::Location loc, fir::FirOpBuilder &builder,
507     const Fortran::common::StaticMultimapView<RuntimeFunction> &lib,
508     llvm::StringRef name, mlir::FunctionType funcType,
509     const RuntimeFunction **bestNearMatch,
510     FunctionDistance &bestMatchDistance) {
511   auto range = lib.equal_range(name);
512   for (auto iter{range.first}; iter != range.second && iter; ++iter) {
513     const auto &impl = *iter;
514     auto implType = impl.typeGenerator(builder.getContext());
515     if (funcType == implType) {
516       return getFuncOp(loc, builder, impl); // exact match
517     } else {
518       FunctionDistance distance(funcType, implType);
519       if (distance.isSmallerThan(bestMatchDistance)) {
520         *bestNearMatch = &impl;
521         bestMatchDistance = std::move(distance);
522       }
523     }
524   }
525   return {};
526 }
527 
528 /// Search runtime for the best runtime function given an intrinsic name
529 /// and interface. The interface may not be a perfect match in which case
530 /// the caller is responsible to insert argument and return value conversions.
531 /// If nothing is found, the mlir::FuncOp will contain a nullptr.
532 static mlir::FuncOp getRuntimeFunction(mlir::Location loc,
533                                        fir::FirOpBuilder &builder,
534                                        llvm::StringRef name,
535                                        mlir::FunctionType funcType) {
536   const RuntimeFunction *bestNearMatch = nullptr;
537   FunctionDistance bestMatchDistance{};
538   mlir::FuncOp match;
539   using RtMap = Fortran::common::StaticMultimapView<RuntimeFunction>;
540   static constexpr RtMap pgmathF(pgmathFast);
541   static_assert(pgmathF.Verify() && "map must be sorted");
542   static constexpr RtMap pgmathR(pgmathRelaxed);
543   static_assert(pgmathR.Verify() && "map must be sorted");
544   static constexpr RtMap pgmathP(pgmathPrecise);
545   static_assert(pgmathP.Verify() && "map must be sorted");
546   if (mathRuntimeVersion == fastVersion) {
547     match = searchFunctionInLibrary(loc, builder, pgmathF, name, funcType,
548                                     &bestNearMatch, bestMatchDistance);
549   } else if (mathRuntimeVersion == relaxedVersion) {
550     match = searchFunctionInLibrary(loc, builder, pgmathR, name, funcType,
551                                     &bestNearMatch, bestMatchDistance);
552   } else if (mathRuntimeVersion == preciseVersion) {
553     match = searchFunctionInLibrary(loc, builder, pgmathP, name, funcType,
554                                     &bestNearMatch, bestMatchDistance);
555   } else {
556     assert(mathRuntimeVersion == llvmOnly && "unknown math runtime");
557   }
558   if (match)
559     return match;
560 
561   // Go through llvm intrinsics if not exact match in libpgmath or if
562   // mathRuntimeVersion == llvmOnly
563   static constexpr RtMap llvmIntr(llvmIntrinsics);
564   static_assert(llvmIntr.Verify() && "map must be sorted");
565   if (auto exactMatch =
566           searchFunctionInLibrary(loc, builder, llvmIntr, name, funcType,
567                                   &bestNearMatch, bestMatchDistance))
568     return exactMatch;
569 
570   if (bestNearMatch != nullptr) {
571     assert(!bestMatchDistance.isLosingPrecision() &&
572            "runtime selection loses precision");
573     return getFuncOp(loc, builder, *bestNearMatch);
574   }
575   return {};
576 }
577 
578 /// Helpers to get function type from arguments and result type.
579 static mlir::FunctionType getFunctionType(mlir::Type resultType,
580                                           llvm::ArrayRef<mlir::Value> arguments,
581                                           fir::FirOpBuilder &builder) {
582   llvm::SmallVector<mlir::Type, 2> argumentTypes;
583   for (auto &arg : arguments)
584     argumentTypes.push_back(arg.getType());
585   return mlir::FunctionType::get(builder.getModule().getContext(),
586                                  argumentTypes, resultType);
587 }
588 
589 /// fir::ExtendedValue to mlir::Value translation layer
590 
591 fir::ExtendedValue toExtendedValue(mlir::Value val, fir::FirOpBuilder &builder,
592                                    mlir::Location loc) {
593   assert(val && "optional unhandled here");
594   auto type = val.getType();
595   auto base = val;
596   auto indexType = builder.getIndexType();
597   llvm::SmallVector<mlir::Value, 2> extents;
598 
599   Fortran::lower::CharacterExprHelper charHelper{builder, loc};
600   if (charHelper.isCharacter(type))
601     return charHelper.toExtendedValue(val);
602 
603   if (auto refType = type.dyn_cast<fir::ReferenceType>())
604     type = refType.getEleTy();
605 
606   if (auto arrayType = type.dyn_cast<fir::SequenceType>()) {
607     type = arrayType.getEleTy();
608     for (auto extent : arrayType.getShape()) {
609       if (extent == fir::SequenceType::getUnknownExtent())
610         break;
611       extents.emplace_back(
612           builder.createIntegerConstant(loc, indexType, extent));
613     }
614     // Last extent might be missing in case of assumed-size. If more extents
615     // could not be deduced from type, that's an error (a fir.box should
616     // have been used in the interface).
617     if (extents.size() + 1 < arrayType.getShape().size())
618       mlir::emitError(loc, "cannot retrieve array extents from type");
619   } else if (type.isa<fir::BoxType>() || type.isa<fir::RecordType>()) {
620     mlir::emitError(loc, "descriptor or derived type not yet handled");
621   }
622 
623   if (!extents.empty())
624     return fir::ArrayBoxValue{base, extents};
625   return base;
626 }
627 
628 mlir::Value toValue(const fir::ExtendedValue &val, fir::FirOpBuilder &builder,
629                     mlir::Location loc) {
630   if (auto charBox = val.getCharBox()) {
631     auto buffer = charBox->getBuffer();
632     if (buffer.getType().isa<fir::BoxCharType>())
633       return buffer;
634     return Fortran::lower::CharacterExprHelper{builder, loc}.createEmboxChar(
635         buffer, charBox->getLen());
636   }
637 
638   // FIXME: need to access other ExtendedValue variants and handle them
639   // properly.
640   return fir::getBase(val);
641 }
642 
643 //===----------------------------------------------------------------------===//
644 // IntrinsicLibrary
645 //===----------------------------------------------------------------------===//
646 
647 template <typename GeneratorType>
648 fir::ExtendedValue IntrinsicLibrary::genElementalCall(
649     GeneratorType generator, llvm::StringRef name, mlir::Type resultType,
650     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
651   llvm::SmallVector<mlir::Value, 2> scalarArgs;
652   for (const auto &arg : args) {
653     if (arg.getUnboxed() || arg.getCharBox()) {
654       scalarArgs.emplace_back(fir::getBase(arg));
655     } else {
656       // TODO: get the result shape and create the loop...
657       mlir::emitError(loc, "array or descriptor not yet handled in elemental "
658                            "intrinsic lowering");
659       exit(1);
660     }
661   }
662   if (outline)
663     return outlineInWrapper(generator, name, resultType, scalarArgs);
664   return invokeGenerator(generator, resultType, scalarArgs);
665 }
666 
667 /// Some ExtendedGenerator operating on characters are also elemental
668 /// (e.g LEN_TRIM).
669 template <>
670 fir::ExtendedValue
671 IntrinsicLibrary::genElementalCall<IntrinsicLibrary::ExtendedGenerator>(
672     ExtendedGenerator generator, llvm::StringRef name, mlir::Type resultType,
673     llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
674   for (const auto &arg : args)
675     if (!arg.getUnboxed() && !arg.getCharBox()) {
676       // TODO: get the result shape and create the loop...
677       mlir::emitError(loc, "array or descriptor not yet handled in elemental "
678                            "intrinsic lowering");
679       exit(1);
680     }
681   if (outline)
682     return outlineInWrapper(generator, name, resultType, args);
683   return std::invoke(generator, *this, resultType, args);
684 }
685 
686 fir::ExtendedValue
687 IntrinsicLibrary::genIntrinsicCall(llvm::StringRef name, mlir::Type resultType,
688                                    llvm::ArrayRef<fir::ExtendedValue> args) {
689   for (auto &handler : handlers)
690     if (name == handler.name) {
691       bool outline = handler.outline || outlineAllIntrinsics;
692       if (const auto *elementalGenerator =
693               std::get_if<ElementalGenerator>(&handler.generator))
694         return genElementalCall(*elementalGenerator, name, resultType, args,
695                                 outline);
696       const auto &generator = std::get<ExtendedGenerator>(handler.generator);
697       if (handler.isElemental)
698         return genElementalCall(generator, name, resultType, args, outline);
699       if (outline)
700         return outlineInWrapper(generator, name, resultType, args);
701       return std::invoke(generator, *this, resultType, args);
702     }
703 
704   // Try the runtime if no special handler was defined for the
705   // intrinsic being called. Maths runtime only has numerical elemental.
706   // No optional arguments are expected at this point, the code will
707   // crash if it gets absent optional.
708 
709   // FIXME: using toValue to get the type won't work with array arguments.
710   llvm::SmallVector<mlir::Value, 2> mlirArgs;
711   for (const auto &extendedVal : args) {
712     auto val = toValue(extendedVal, builder, loc);
713     if (!val) {
714       // If an absent optional gets there, most likely its handler has just
715       // not yet been defined.
716       mlir::emitError(loc,
717                       "TODO: missing intrinsic lowering: " + llvm::Twine(name));
718       exit(1);
719     }
720     mlirArgs.emplace_back(val);
721   }
722   mlir::FunctionType soughtFuncType =
723       getFunctionType(resultType, mlirArgs, builder);
724 
725   auto runtimeCallGenerator = getRuntimeCallGenerator(name, soughtFuncType);
726   return genElementalCall(runtimeCallGenerator, name, resultType, args,
727                           /* outline */ true);
728 }
729 
730 mlir::Value
731 IntrinsicLibrary::invokeGenerator(ElementalGenerator generator,
732                                   mlir::Type resultType,
733                                   llvm::ArrayRef<mlir::Value> args) {
734   return std::invoke(generator, *this, resultType, args);
735 }
736 
737 mlir::Value
738 IntrinsicLibrary::invokeGenerator(RuntimeCallGenerator generator,
739                                   mlir::Type resultType,
740                                   llvm::ArrayRef<mlir::Value> args) {
741   return generator(builder, loc, args);
742 }
743 
744 mlir::Value
745 IntrinsicLibrary::invokeGenerator(ExtendedGenerator generator,
746                                   mlir::Type resultType,
747                                   llvm::ArrayRef<mlir::Value> args) {
748   llvm::SmallVector<fir::ExtendedValue, 2> extendedArgs;
749   for (auto arg : args)
750     extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
751   auto extendedResult = std::invoke(generator, *this, resultType, extendedArgs);
752   return toValue(extendedResult, builder, loc);
753 }
754 
755 template <typename GeneratorType>
756 mlir::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator,
757                                           llvm::StringRef name,
758                                           mlir::FunctionType funcType,
759                                           bool loadRefArguments) {
760   assert(funcType.getNumResults() == 1 &&
761          "expect one result for intrinsic functions");
762   auto resultType = funcType.getResult(0);
763   std::string wrapperName = fir::mangleIntrinsicProcedure(name, funcType);
764   auto function = builder.getNamedFunction(wrapperName);
765   if (!function) {
766     // First time this wrapper is needed, build it.
767     function = builder.createFunction(loc, wrapperName, funcType);
768     function->setAttr("fir.intrinsic", builder.getUnitAttr());
769     function.addEntryBlock();
770 
771     // Create local context to emit code into the newly created function
772     // This new function is not linked to a source file location, only
773     // its calls will be.
774     auto localBuilder =
775         std::make_unique<fir::FirOpBuilder>(function, builder.getKindMap());
776     localBuilder->setInsertionPointToStart(&function.front());
777     // Location of code inside wrapper of the wrapper is independent from
778     // the location of the intrinsic call.
779     auto localLoc = localBuilder->getUnknownLoc();
780     llvm::SmallVector<mlir::Value, 2> localArguments;
781     for (mlir::BlockArgument bArg : function.front().getArguments()) {
782       auto refType = bArg.getType().dyn_cast<fir::ReferenceType>();
783       if (loadRefArguments && refType) {
784         auto loaded = localBuilder->create<fir::LoadOp>(localLoc, bArg);
785         localArguments.push_back(loaded);
786       } else {
787         localArguments.push_back(bArg);
788       }
789     }
790 
791     IntrinsicLibrary localLib{*localBuilder, localLoc};
792     auto result =
793         localLib.invokeGenerator(generator, resultType, localArguments);
794     localBuilder->create<mlir::ReturnOp>(localLoc, result);
795   } else {
796     // Wrapper was already built, ensure it has the sought type
797     assert(function.getType() == funcType &&
798            "conflict between intrinsic wrapper types");
799   }
800   return function;
801 }
802 
803 /// Helpers to detect absent optional (not yet supported in outlining).
804 bool static hasAbsentOptional(llvm::ArrayRef<mlir::Value> args) {
805   for (const auto &arg : args)
806     if (!arg)
807       return true;
808   return false;
809 }
810 bool static hasAbsentOptional(llvm::ArrayRef<fir::ExtendedValue> args) {
811   for (const auto &arg : args)
812     if (!fir::getBase(arg))
813       return true;
814   return false;
815 }
816 
817 template <typename GeneratorType>
818 mlir::Value
819 IntrinsicLibrary::outlineInWrapper(GeneratorType generator,
820                                    llvm::StringRef name, mlir::Type resultType,
821                                    llvm::ArrayRef<mlir::Value> args) {
822   if (hasAbsentOptional(args)) {
823     // TODO: absent optional in outlining is an issue: we cannot just ignore
824     // them. Needs a better interface here. The issue is that we cannot easily
825     // tell that a value is optional or not here if it is presents. And if it is
826     // absent, we cannot tell what it type should be.
827     mlir::emitError(loc, "todo: cannot outline call to intrinsic " +
828                              llvm::Twine(name) +
829                              " with absent optional argument");
830     exit(1);
831   }
832 
833   auto funcType = getFunctionType(resultType, args, builder);
834   auto wrapper = getWrapper(generator, name, funcType);
835   return builder.create<mlir::CallOp>(loc, wrapper, args).getResult(0);
836 }
837 
838 fir::ExtendedValue
839 IntrinsicLibrary::outlineInWrapper(ExtendedGenerator generator,
840                                    llvm::StringRef name, mlir::Type resultType,
841                                    llvm::ArrayRef<fir::ExtendedValue> args) {
842   if (hasAbsentOptional(args)) {
843     // TODO
844     mlir::emitError(loc, "todo: cannot outline call to intrinsic " +
845                              llvm::Twine(name) +
846                              " with absent optional argument");
847     exit(1);
848   }
849   llvm::SmallVector<mlir::Value, 2> mlirArgs;
850   for (const auto &extendedVal : args)
851     mlirArgs.emplace_back(toValue(extendedVal, builder, loc));
852   auto funcType = getFunctionType(resultType, mlirArgs, builder);
853   auto wrapper = getWrapper(generator, name, funcType);
854   auto mlirResult =
855       builder.create<mlir::CallOp>(loc, wrapper, mlirArgs).getResult(0);
856   return toExtendedValue(mlirResult, builder, loc);
857 }
858 
859 IntrinsicLibrary::RuntimeCallGenerator
860 IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,
861                                           mlir::FunctionType soughtFuncType) {
862   auto funcOp = getRuntimeFunction(loc, builder, name, soughtFuncType);
863   if (!funcOp) {
864     mlir::emitError(loc,
865                     "TODO: missing intrinsic lowering: " + llvm::Twine(name));
866     llvm::errs() << "requested type was: " << soughtFuncType << "\n";
867     exit(1);
868   }
869 
870   mlir::FunctionType actualFuncType = funcOp.getType();
871   assert(actualFuncType.getNumResults() == soughtFuncType.getNumResults() &&
872          actualFuncType.getNumInputs() == soughtFuncType.getNumInputs() &&
873          actualFuncType.getNumResults() == 1 && "Bad intrinsic match");
874 
875   return [funcOp, actualFuncType,
876           soughtFuncType](fir::FirOpBuilder &builder, mlir::Location loc,
877                           llvm::ArrayRef<mlir::Value> args) {
878     llvm::SmallVector<mlir::Value, 2> convertedArguments;
879     for (const auto &pair : llvm::zip(actualFuncType.getInputs(), args))
880       convertedArguments.push_back(
881           builder.createConvert(loc, std::get<0>(pair), std::get<1>(pair)));
882     auto call = builder.create<mlir::CallOp>(loc, funcOp, convertedArguments);
883     mlir::Type soughtType = soughtFuncType.getResult(0);
884     return builder.createConvert(loc, soughtType, call.getResult(0));
885   };
886 }
887 
888 mlir::SymbolRefAttr IntrinsicLibrary::getUnrestrictedIntrinsicSymbolRefAttr(
889     llvm::StringRef name, mlir::FunctionType signature) {
890   // Unrestricted intrinsics signature follows implicit rules: argument
891   // are passed by references. But the runtime versions expect values.
892   // So instead of duplicating the runtime, just have the wrappers loading
893   // this before calling the code generators.
894   bool loadRefArguments = true;
895   mlir::FuncOp funcOp;
896   for (auto &handler : handlers)
897     if (name == handler.name)
898       funcOp = std::visit(
899           [&](auto generator) {
900             return getWrapper(generator, name, signature, loadRefArguments);
901           },
902           handler.generator);
903 
904   if (!funcOp) {
905     llvm::SmallVector<mlir::Type, 2> argTypes;
906     for (auto type : signature.getInputs()) {
907       if (auto refType = type.dyn_cast<fir::ReferenceType>())
908         argTypes.push_back(refType.getEleTy());
909       else
910         argTypes.push_back(type);
911     }
912     auto soughtFuncType =
913         builder.getFunctionType(signature.getResults(), argTypes);
914     auto rtCallGenerator = getRuntimeCallGenerator(name, soughtFuncType);
915     funcOp = getWrapper(rtCallGenerator, name, signature, loadRefArguments);
916   }
917 
918   return SymbolRefAttr::get(funcOp);
919 }
920 
921 //===----------------------------------------------------------------------===//
922 // Code generators for the intrinsic
923 //===----------------------------------------------------------------------===//
924 
925 mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name,
926                                              mlir::Type resultType,
927                                              llvm::ArrayRef<mlir::Value> args) {
928   mlir::FunctionType soughtFuncType =
929       getFunctionType(resultType, args, builder);
930   return getRuntimeCallGenerator(name, soughtFuncType)(builder, loc, args);
931 }
932 
933 mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType,
934                                             llvm::ArrayRef<mlir::Value> args) {
935   // There can be an optional kind in second argument.
936   assert(args.size() >= 1);
937   return builder.convertWithSemantics(loc, resultType, args[0]);
938 }
939 
940 // ABS
941 mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType,
942                                      llvm::ArrayRef<mlir::Value> args) {
943   assert(args.size() == 1);
944   auto arg = args[0];
945   auto type = arg.getType();
946   if (fir::isa_real(type)) {
947     // Runtime call to fp abs. An alternative would be to use mlir math::AbsOp
948     // but it does not support all fir floating point types.
949     return genRuntimeCall("abs", resultType, args);
950   }
951   if (auto intType = type.dyn_cast<mlir::IntegerType>()) {
952     // At the time of this implementation there is no abs op in mlir.
953     // So, implement abs here without branching.
954     auto shift =
955         builder.createIntegerConstant(loc, intType, intType.getWidth() - 1);
956     auto mask = builder.create<mlir::arith::ShRSIOp>(loc, arg, shift);
957     auto xored = builder.create<mlir::arith::XOrIOp>(loc, arg, mask);
958     return builder.create<mlir::arith::SubIOp>(loc, xored, mask);
959   }
960   if (fir::isa_complex(type)) {
961     // Use HYPOT to fulfill the no underflow/overflow requirement.
962     auto parts =
963         Fortran::lower::ComplexExprHelper{builder, loc}.extractParts(arg);
964     llvm::SmallVector<mlir::Value, 2> args = {parts.first, parts.second};
965     return genRuntimeCall("hypot", resultType, args);
966   }
967   llvm_unreachable("unexpected type in ABS argument");
968 }
969 
970 // AIMAG
971 mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType,
972                                        llvm::ArrayRef<mlir::Value> args) {
973   assert(args.size() == 1);
974   return Fortran::lower::ComplexExprHelper{builder, loc}.extractComplexPart(
975       args[0], true /* isImagPart */);
976 }
977 
978 // ANINT
979 mlir::Value IntrinsicLibrary::genAnint(mlir::Type resultType,
980                                        llvm::ArrayRef<mlir::Value> args) {
981   assert(args.size() >= 1);
982   // Skip optional kind argument to search the runtime; it is already reflected
983   // in result type.
984   return genRuntimeCall("anint", resultType, {args[0]});
985 }
986 
987 // AINT
988 mlir::Value IntrinsicLibrary::genAint(mlir::Type resultType,
989                                       llvm::ArrayRef<mlir::Value> args) {
990   assert(args.size() >= 1);
991   // Skip optional kind argument to search the runtime; it is already reflected
992   // in result type.
993   return genRuntimeCall("aint", resultType, {args[0]});
994 }
995 
996 // CEILING
997 mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType,
998                                          llvm::ArrayRef<mlir::Value> args) {
999   // Optional KIND argument.
1000   assert(args.size() >= 1);
1001   auto arg = args[0];
1002   // Use ceil that is not an actual Fortran intrinsic but that is
1003   // an llvm intrinsic that does the same, but return a floating
1004   // point.
1005   auto ceil = genRuntimeCall("ceil", arg.getType(), {arg});
1006   return builder.createConvert(loc, resultType, ceil);
1007 }
1008 
1009 // CONJG
1010 mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType,
1011                                        llvm::ArrayRef<mlir::Value> args) {
1012   assert(args.size() == 1);
1013   if (resultType != args[0].getType())
1014     llvm_unreachable("argument type mismatch");
1015 
1016   mlir::Value cplx = args[0];
1017   auto imag =
1018       Fortran::lower::ComplexExprHelper{builder, loc}.extractComplexPart(
1019           cplx, /*isImagPart=*/true);
1020   auto negImag = builder.create<mlir::arith::NegFOp>(loc, imag);
1021   return Fortran::lower::ComplexExprHelper{builder, loc}.insertComplexPart(
1022       cplx, negImag, /*isImagPart=*/true);
1023 }
1024 
1025 // DIM
1026 mlir::Value IntrinsicLibrary::genDim(mlir::Type resultType,
1027                                      llvm::ArrayRef<mlir::Value> args) {
1028   assert(args.size() == 2);
1029   if (resultType.isa<mlir::IntegerType>()) {
1030     auto zero = builder.createIntegerConstant(loc, resultType, 0);
1031     auto diff = builder.create<mlir::arith::SubIOp>(loc, args[0], args[1]);
1032     auto cmp = builder.create<mlir::arith::CmpIOp>(
1033         loc, mlir::arith::CmpIPredicate::sgt, diff, zero);
1034     return builder.create<mlir::SelectOp>(loc, cmp, diff, zero);
1035   }
1036   assert(fir::isa_real(resultType) && "Only expects real and integer in DIM");
1037   auto zero = builder.createRealZeroConstant(loc, resultType);
1038   auto diff = builder.create<mlir::arith::SubFOp>(loc, args[0], args[1]);
1039   auto cmp = builder.create<mlir::arith::CmpFOp>(
1040       loc, mlir::arith::CmpFPredicate::OGT, diff, zero);
1041   return builder.create<mlir::SelectOp>(loc, cmp, diff, zero);
1042 }
1043 
1044 // DPROD
1045 mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType,
1046                                        llvm::ArrayRef<mlir::Value> args) {
1047   assert(args.size() == 2);
1048   assert(fir::isa_real(resultType) &&
1049          "Result must be double precision in DPROD");
1050   auto a = builder.createConvert(loc, resultType, args[0]);
1051   auto b = builder.createConvert(loc, resultType, args[1]);
1052   return builder.create<mlir::arith::MulFOp>(loc, a, b);
1053 }
1054 
1055 // FLOOR
1056 mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType,
1057                                        llvm::ArrayRef<mlir::Value> args) {
1058   // Optional KIND argument.
1059   assert(args.size() >= 1);
1060   auto arg = args[0];
1061   // Use LLVM floor that returns real.
1062   auto floor = genRuntimeCall("floor", arg.getType(), {arg});
1063   return builder.createConvert(loc, resultType, floor);
1064 }
1065 
1066 // IAND
1067 mlir::Value IntrinsicLibrary::genIAnd(mlir::Type resultType,
1068                                       llvm::ArrayRef<mlir::Value> args) {
1069   assert(args.size() == 2);
1070 
1071   return builder.create<mlir::arith::AndIOp>(loc, args[0], args[1]);
1072 }
1073 
1074 // ICHAR
1075 mlir::Value IntrinsicLibrary::genIchar(mlir::Type resultType,
1076                                        llvm::ArrayRef<mlir::Value> args) {
1077   // There can be an optional kind in second argument.
1078   assert(args.size() >= 1);
1079 
1080   auto arg = args[0];
1081   Fortran::lower::CharacterExprHelper helper{builder, loc};
1082   auto dataAndLen = helper.createUnboxChar(arg);
1083   auto charType = fir::CharacterType::get(
1084       builder.getContext(), helper.getCharacterKind(arg.getType()), 1);
1085   auto refType = builder.getRefType(charType);
1086   auto charAddr = builder.createConvert(loc, refType, dataAndLen.first);
1087   auto charVal = builder.create<fir::LoadOp>(loc, charType, charAddr);
1088   return builder.createConvert(loc, resultType, charVal);
1089 }
1090 
1091 // IEOR
1092 mlir::Value IntrinsicLibrary::genIEOr(mlir::Type resultType,
1093                                       llvm::ArrayRef<mlir::Value> args) {
1094   assert(args.size() == 2);
1095   return builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
1096 }
1097 
1098 // IOR
1099 mlir::Value IntrinsicLibrary::genIOr(mlir::Type resultType,
1100                                      llvm::ArrayRef<mlir::Value> args) {
1101   assert(args.size() == 2);
1102   return builder.create<mlir::arith::OrIOp>(loc, args[0], args[1]);
1103 }
1104 
1105 // LEN
1106 // Note that this is only used for unrestricted intrinsic.
1107 // Usage of LEN are otherwise rewritten as descriptor inquiries by the
1108 // front-end.
1109 fir::ExtendedValue
1110 IntrinsicLibrary::genLen(mlir::Type resultType,
1111                          llvm::ArrayRef<fir::ExtendedValue> args) {
1112   // Optional KIND argument reflected in result type.
1113   assert(args.size() >= 1);
1114   mlir::Value len;
1115   if (const auto *charBox = args[0].getCharBox()) {
1116     len = charBox->getLen();
1117   } else if (const auto *charBoxArray = args[0].getCharBox()) {
1118     len = charBoxArray->getLen();
1119   } else {
1120     Fortran::lower::CharacterExprHelper helper{builder, loc};
1121     len = helper.createUnboxChar(fir::getBase(args[0])).second;
1122   }
1123 
1124   return builder.createConvert(loc, resultType, len);
1125 }
1126 
1127 // LEN_TRIM
1128 fir::ExtendedValue
1129 IntrinsicLibrary::genLenTrim(mlir::Type resultType,
1130                              llvm::ArrayRef<fir::ExtendedValue> args) {
1131   // Optional KIND argument reflected in result type.
1132   assert(args.size() >= 1);
1133   Fortran::lower::CharacterExprHelper helper{builder, loc};
1134   auto len = helper.createLenTrim(fir::getBase(args[0]));
1135   return builder.createConvert(loc, resultType, len);
1136 }
1137 
1138 // MERGE
1139 mlir::Value IntrinsicLibrary::genMerge(mlir::Type,
1140                                        llvm::ArrayRef<mlir::Value> args) {
1141   assert(args.size() == 3);
1142 
1143   auto i1Type = mlir::IntegerType::get(builder.getContext(), 1);
1144   auto mask = builder.createConvert(loc, i1Type, args[2]);
1145   return builder.create<mlir::SelectOp>(loc, mask, args[0], args[1]);
1146 }
1147 
1148 // MOD
1149 mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType,
1150                                      llvm::ArrayRef<mlir::Value> args) {
1151   assert(args.size() == 2);
1152   if (resultType.isa<mlir::IntegerType>())
1153     return builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
1154 
1155   // Use runtime. Note that mlir::arith::RemFOp implements floating point
1156   // remainder, but it does not work with fir::Real type.
1157   // TODO: consider using mlir::arith::RemFOp when possible, that may help
1158   // folding and  optimizations.
1159   return genRuntimeCall("mod", resultType, args);
1160 }
1161 
1162 // NINT
1163 mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType,
1164                                       llvm::ArrayRef<mlir::Value> args) {
1165   assert(args.size() >= 1);
1166   // Skip optional kind argument to search the runtime; it is already reflected
1167   // in result type.
1168   return genRuntimeCall("nint", resultType, {args[0]});
1169 }
1170 
1171 // SIGN
1172 mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType,
1173                                       llvm::ArrayRef<mlir::Value> args) {
1174   assert(args.size() == 2);
1175   auto abs = genAbs(resultType, {args[0]});
1176   if (resultType.isa<mlir::IntegerType>()) {
1177     auto zero = builder.createIntegerConstant(loc, resultType, 0);
1178     auto neg = builder.create<mlir::arith::SubIOp>(loc, zero, abs);
1179     auto cmp = builder.create<mlir::arith::CmpIOp>(
1180         loc, mlir::arith::CmpIPredicate::slt, args[1], zero);
1181     return builder.create<mlir::SelectOp>(loc, cmp, neg, abs);
1182   }
1183   // TODO: Requirements when second argument is +0./0.
1184   auto zeroAttr = builder.getZeroAttr(resultType);
1185   auto zero =
1186       builder.create<mlir::arith::ConstantOp>(loc, resultType, zeroAttr);
1187   auto neg = builder.create<mlir::arith::NegFOp>(loc, abs);
1188   auto cmp = builder.create<mlir::arith::CmpFOp>(
1189       loc, mlir::arith::CmpFPredicate::OLT, args[1], zero);
1190   return builder.create<mlir::SelectOp>(loc, cmp, neg, abs);
1191 }
1192 
1193 // Compare two FIR values and return boolean result as i1.
1194 template <Extremum extremum, ExtremumBehavior behavior>
1195 static mlir::Value createExtremumCompare(mlir::Location loc,
1196                                          fir::FirOpBuilder &builder,
1197                                          mlir::Value left, mlir::Value right) {
1198   static constexpr auto integerPredicate =
1199       extremum == Extremum::Max ? mlir::arith::CmpIPredicate::sgt
1200                                 : mlir::arith::CmpIPredicate::slt;
1201   static constexpr auto orderedCmp = extremum == Extremum::Max
1202                                          ? mlir::arith::CmpFPredicate::OGT
1203                                          : mlir::arith::CmpFPredicate::OLT;
1204   auto type = left.getType();
1205   mlir::Value result;
1206   if (fir::isa_real(type)) {
1207     // Note: the signaling/quit aspect of the result required by IEEE
1208     // cannot currently be obtained with LLVM without ad-hoc runtime.
1209     if constexpr (behavior == ExtremumBehavior::IeeeMinMaximumNumber) {
1210       // Return the number if one of the inputs is NaN and the other is
1211       // a number.
1212       auto leftIsResult =
1213           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
1214       auto rightIsNan = builder.create<mlir::arith::CmpFOp>(
1215           loc, mlir::arith::CmpFPredicate::UNE, right, right);
1216       result =
1217           builder.create<mlir::arith::OrIOp>(loc, leftIsResult, rightIsNan);
1218     } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) {
1219       // Always return NaNs if one the input is NaNs
1220       auto leftIsResult =
1221           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
1222       auto leftIsNan = builder.create<mlir::arith::CmpFOp>(
1223           loc, mlir::arith::CmpFPredicate::UNE, left, left);
1224       result = builder.create<mlir::arith::OrIOp>(loc, leftIsResult, leftIsNan);
1225     } else if constexpr (behavior == ExtremumBehavior::MinMaxss) {
1226       // If the left is a NaN, return the right whatever it is.
1227       result =
1228           builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
1229     } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) {
1230       // If one of the operand is a NaN, return left whatever it is.
1231       static constexpr auto unorderedCmp =
1232           extremum == Extremum::Max ? mlir::arith::CmpFPredicate::UGT
1233                                     : mlir::arith::CmpFPredicate::ULT;
1234       result =
1235           builder.create<mlir::arith::CmpFOp>(loc, unorderedCmp, left, right);
1236     } else {
1237       // TODO: ieeeMinNum/ieeeMaxNum
1238       static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum,
1239                     "ieeeMinNum/ieeeMaxNum behavior not implemented");
1240     }
1241   } else if (fir::isa_integer(type)) {
1242     result =
1243         builder.create<mlir::arith::CmpIOp>(loc, integerPredicate, left, right);
1244   } else if (type.isa<fir::CharacterType>()) {
1245     // TODO: ! character min and max is tricky because the result
1246     // length is the length of the longest argument!
1247     // So we may need a temp.
1248   }
1249   assert(result);
1250   return result;
1251 }
1252 
1253 // MIN and MAX
1254 template <Extremum extremum, ExtremumBehavior behavior>
1255 mlir::Value IntrinsicLibrary::genExtremum(mlir::Type,
1256                                           llvm::ArrayRef<mlir::Value> args) {
1257   assert(args.size() >= 1);
1258   mlir::Value result = args[0];
1259   for (auto arg : args.drop_front()) {
1260     auto mask =
1261         createExtremumCompare<extremum, behavior>(loc, builder, result, arg);
1262     result = builder.create<mlir::SelectOp>(loc, mask, result, arg);
1263   }
1264   return result;
1265 }
1266 
1267 //===----------------------------------------------------------------------===//
1268 // Public intrinsic call helpers
1269 //===----------------------------------------------------------------------===//
1270 
1271 fir::ExtendedValue
1272 Fortran::lower::genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
1273                                  llvm::StringRef name, mlir::Type resultType,
1274                                  llvm::ArrayRef<fir::ExtendedValue> args) {
1275   return IntrinsicLibrary{builder, loc}.genIntrinsicCall(name, resultType,
1276                                                          args);
1277 }
1278 
1279 mlir::Value Fortran::lower::genMax(fir::FirOpBuilder &builder,
1280                                    mlir::Location loc,
1281                                    llvm::ArrayRef<mlir::Value> args) {
1282   assert(args.size() > 0 && "max requires at least one argument");
1283   return IntrinsicLibrary{builder, loc}
1284       .genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>(args[0].getType(),
1285                                                               args);
1286 }
1287 
1288 mlir::Value Fortran::lower::genMin(fir::FirOpBuilder &builder,
1289                                    mlir::Location loc,
1290                                    llvm::ArrayRef<mlir::Value> args) {
1291   assert(args.size() > 0 && "min requires at least one argument");
1292   return IntrinsicLibrary{builder, loc}
1293       .genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>(args[0].getType(),
1294                                                               args);
1295 }
1296 
1297 mlir::Value Fortran::lower::genPow(fir::FirOpBuilder &builder,
1298                                    mlir::Location loc, mlir::Type type,
1299                                    mlir::Value x, mlir::Value y) {
1300   return IntrinsicLibrary{builder, loc}.genRuntimeCall("pow", type, {x, y});
1301 }
1302 
1303 mlir::SymbolRefAttr Fortran::lower::getUnrestrictedIntrinsicSymbolRefAttr(
1304     fir::FirOpBuilder &builder, mlir::Location loc, llvm::StringRef name,
1305     mlir::FunctionType signature) {
1306   return IntrinsicLibrary{builder, loc}.getUnrestrictedIntrinsicSymbolRefAttr(
1307       name, signature);
1308 }
1309