1 //===-- lib/Evaluate/fold-integer.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 #include "fold-implementation.h"
10 #include "fold-reduction.h"
11 #include "flang/Evaluate/check-expression.h"
12 
13 namespace Fortran::evaluate {
14 
15 // Class to retrieve the constant lower bound of an expression which is an
16 // array that devolves to a type of Constant<T>
17 class GetConstantArrayLboundHelper {
18 public:
19   GetConstantArrayLboundHelper(ConstantSubscript dim) : dim_{dim} {}
20 
21   template <typename T> ConstantSubscript GetLbound(const T &) {
22     // The method is needed for template expansion, but we should never get
23     // here in practice.
24     CHECK(false);
25     return 0;
26   }
27 
28   template <typename T> ConstantSubscript GetLbound(const Constant<T> &x) {
29     // Return the lower bound
30     return x.lbounds()[dim_];
31   }
32 
33   template <typename T> ConstantSubscript GetLbound(const Parentheses<T> &x) {
34     // Strip off the parentheses
35     return GetLbound(x.left());
36   }
37 
38   template <typename T> ConstantSubscript GetLbound(const Expr<T> &x) {
39     // recurse through Expr<T>'a until we hit a constant
40     return std::visit([&](const auto &inner) { return GetLbound(inner); },
41         //      [&](const auto &) { return 0; },
42         x.u);
43   }
44 
45 private:
46   ConstantSubscript dim_;
47 };
48 
49 template <int KIND>
50 Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
51     FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
52   using T = Type<TypeCategory::Integer, KIND>;
53   ActualArguments &args{funcRef.arguments()};
54   if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
55     if (int rank{array->Rank()}; rank > 0) {
56       std::optional<int> dim;
57       if (funcRef.Rank() == 0) {
58         // Optional DIM= argument is present: result is scalar.
59         if (auto dim64{GetInt64Arg(args[1])}) {
60           if (*dim64 < 1 || *dim64 > rank) {
61             context.messages().Say("DIM=%jd dimension is out of range for "
62                                    "rank-%d array"_err_en_US,
63                 *dim64, rank);
64             return MakeInvalidIntrinsic<T>(std::move(funcRef));
65           } else {
66             dim = *dim64 - 1; // 1-based to 0-based
67           }
68         } else {
69           // DIM= is present but not constant
70           return Expr<T>{std::move(funcRef)};
71         }
72       }
73       bool lowerBoundsAreOne{true};
74       if (auto named{ExtractNamedEntity(*array)}) {
75         const Symbol &symbol{named->GetLastSymbol()};
76         if (symbol.Rank() == rank) {
77           lowerBoundsAreOne = false;
78           if (dim) {
79             return Fold(context,
80                 ConvertToType<T>(GetLowerBound(context, *named, *dim)));
81           } else if (auto extents{
82                          AsExtentArrayExpr(GetLowerBounds(context, *named))}) {
83             return Fold(context,
84                 ConvertToType<T>(Expr<ExtentType>{std::move(*extents)}));
85           }
86         } else {
87           lowerBoundsAreOne = symbol.Rank() == 0; // LBOUND(array%component)
88         }
89       }
90       if (IsActuallyConstant(*array)) {
91         return Expr<T>{GetConstantArrayLboundHelper{*dim}.GetLbound(*array)};
92       }
93       if (lowerBoundsAreOne) {
94         if (dim) {
95           return Expr<T>{1};
96         } else {
97           std::vector<Scalar<T>> ones(rank, Scalar<T>{1});
98           return Expr<T>{
99               Constant<T>{std::move(ones), ConstantSubscripts{rank}}};
100         }
101       }
102     }
103   }
104   return Expr<T>{std::move(funcRef)};
105 }
106 
107 template <int KIND>
108 Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
109     FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
110   using T = Type<TypeCategory::Integer, KIND>;
111   ActualArguments &args{funcRef.arguments()};
112   if (auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
113     if (int rank{array->Rank()}; rank > 0) {
114       std::optional<int> dim;
115       if (funcRef.Rank() == 0) {
116         // Optional DIM= argument is present: result is scalar.
117         if (auto dim64{GetInt64Arg(args[1])}) {
118           if (*dim64 < 1 || *dim64 > rank) {
119             context.messages().Say("DIM=%jd dimension is out of range for "
120                                    "rank-%d array"_err_en_US,
121                 *dim64, rank);
122             return MakeInvalidIntrinsic<T>(std::move(funcRef));
123           } else {
124             dim = *dim64 - 1; // 1-based to 0-based
125           }
126         } else {
127           // DIM= is present but not constant
128           return Expr<T>{std::move(funcRef)};
129         }
130       }
131       bool takeBoundsFromShape{true};
132       if (auto named{ExtractNamedEntity(*array)}) {
133         const Symbol &symbol{named->GetLastSymbol()};
134         if (symbol.Rank() == rank) {
135           takeBoundsFromShape = false;
136           if (dim) {
137             if (semantics::IsAssumedSizeArray(symbol) && *dim == rank - 1) {
138               context.messages().Say("DIM=%jd dimension is out of range for "
139                                      "rank-%d assumed-size array"_err_en_US,
140                   rank, rank);
141               return MakeInvalidIntrinsic<T>(std::move(funcRef));
142             } else if (auto ub{GetUpperBound(context, *named, *dim)}) {
143               return Fold(context, ConvertToType<T>(std::move(*ub)));
144             }
145           } else {
146             Shape ubounds{GetUpperBounds(context, *named)};
147             if (semantics::IsAssumedSizeArray(symbol)) {
148               CHECK(!ubounds.back());
149               ubounds.back() = ExtentExpr{-1};
150             }
151             if (auto extents{AsExtentArrayExpr(ubounds)}) {
152               return Fold(context,
153                   ConvertToType<T>(Expr<ExtentType>{std::move(*extents)}));
154             }
155           }
156         } else {
157           takeBoundsFromShape = symbol.Rank() == 0; // UBOUND(array%component)
158         }
159       }
160       if (takeBoundsFromShape) {
161         if (auto shape{GetShape(context, *array)}) {
162           if (dim) {
163             if (auto &dimSize{shape->at(*dim)}) {
164               return Fold(context,
165                   ConvertToType<T>(Expr<ExtentType>{std::move(*dimSize)}));
166             }
167           } else if (auto shapeExpr{AsExtentArrayExpr(*shape)}) {
168             return Fold(context, ConvertToType<T>(std::move(*shapeExpr)));
169           }
170         }
171       }
172     }
173   }
174   return Expr<T>{std::move(funcRef)};
175 }
176 
177 template <int KIND>
178 Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
179     FoldingContext &context,
180     FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
181   using T = Type<TypeCategory::Integer, KIND>;
182   using Int4 = Type<TypeCategory::Integer, 4>;
183   ActualArguments &args{funcRef.arguments()};
184   auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
185   CHECK(intrinsic);
186   std::string name{intrinsic->name};
187   if (name == "abs") {
188     return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
189         ScalarFunc<T, T>([&context](const Scalar<T> &i) -> Scalar<T> {
190           typename Scalar<T>::ValueWithOverflow j{i.ABS()};
191           if (j.overflow) {
192             context.messages().Say(
193                 "abs(integer(kind=%d)) folding overflowed"_en_US, KIND);
194           }
195           return j.value;
196         }));
197   } else if (name == "bit_size") {
198     return Expr<T>{Scalar<T>::bits};
199   } else if (name == "ceiling" || name == "floor" || name == "nint") {
200     if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
201       // NINT rounds ties away from zero, not to even
202       common::RoundingMode mode{name == "ceiling" ? common::RoundingMode::Up
203               : name == "floor"                   ? common::RoundingMode::Down
204                                 : common::RoundingMode::TiesAwayFromZero};
205       return std::visit(
206           [&](const auto &kx) {
207             using TR = ResultType<decltype(kx)>;
208             return FoldElementalIntrinsic<T, TR>(context, std::move(funcRef),
209                 ScalarFunc<T, TR>([&](const Scalar<TR> &x) {
210                   auto y{x.template ToInteger<Scalar<T>>(mode)};
211                   if (y.flags.test(RealFlag::Overflow)) {
212                     context.messages().Say(
213                         "%s intrinsic folding overflow"_en_US, name);
214                   }
215                   return y.value;
216                 }));
217           },
218           cx->u);
219     }
220   } else if (name == "count") {
221     if (!args[1]) { // TODO: COUNT(x,DIM=d)
222       if (const auto *constant{UnwrapConstantValue<LogicalResult>(args[0])}) {
223         std::int64_t result{0};
224         for (const auto &element : constant->values()) {
225           if (element.IsTrue()) {
226             ++result;
227           }
228         }
229         return Expr<T>{result};
230       }
231     }
232   } else if (name == "digits") {
233     if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
234       return Expr<T>{std::visit(
235           [](const auto &kx) {
236             return Scalar<ResultType<decltype(kx)>>::DIGITS;
237           },
238           cx->u)};
239     } else if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
240       return Expr<T>{std::visit(
241           [](const auto &kx) {
242             return Scalar<ResultType<decltype(kx)>>::DIGITS;
243           },
244           cx->u)};
245     } else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
246       return Expr<T>{std::visit(
247           [](const auto &kx) {
248             return Scalar<typename ResultType<decltype(kx)>::Part>::DIGITS;
249           },
250           cx->u)};
251     }
252   } else if (name == "dim") {
253     return FoldElementalIntrinsic<T, T, T>(
254         context, std::move(funcRef), &Scalar<T>::DIM);
255   } else if (name == "dshiftl" || name == "dshiftr") {
256     const auto fptr{
257         name == "dshiftl" ? &Scalar<T>::DSHIFTL : &Scalar<T>::DSHIFTR};
258     // Third argument can be of any kind. However, it must be smaller or equal
259     // than BIT_SIZE. It can be converted to Int4 to simplify.
260     return FoldElementalIntrinsic<T, T, T, Int4>(context, std::move(funcRef),
261         ScalarFunc<T, T, T, Int4>(
262             [&fptr](const Scalar<T> &i, const Scalar<T> &j,
263                 const Scalar<Int4> &shift) -> Scalar<T> {
264               return std::invoke(fptr, i, j, static_cast<int>(shift.ToInt64()));
265             }));
266   } else if (name == "exponent") {
267     if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
268       return std::visit(
269           [&funcRef, &context](const auto &x) -> Expr<T> {
270             using TR = typename std::decay_t<decltype(x)>::Result;
271             return FoldElementalIntrinsic<T, TR>(context, std::move(funcRef),
272                 &Scalar<TR>::template EXPONENT<Scalar<T>>);
273           },
274           sx->u);
275     } else {
276       DIE("exponent argument must be real");
277     }
278   } else if (name == "huge") {
279     return Expr<T>{Scalar<T>::HUGE()};
280   } else if (name == "iachar" || name == "ichar") {
281     auto *someChar{UnwrapExpr<Expr<SomeCharacter>>(args[0])};
282     CHECK(someChar);
283     if (auto len{ToInt64(someChar->LEN())}) {
284       if (len.value() != 1) {
285         // Do not die, this was not checked before
286         context.messages().Say(
287             "Character in intrinsic function %s must have length one"_en_US,
288             name);
289       } else {
290         return std::visit(
291             [&funcRef, &context](const auto &str) -> Expr<T> {
292               using Char = typename std::decay_t<decltype(str)>::Result;
293               return FoldElementalIntrinsic<T, Char>(context,
294                   std::move(funcRef),
295                   ScalarFunc<T, Char>([](const Scalar<Char> &c) {
296                     return Scalar<T>{CharacterUtils<Char::kind>::ICHAR(c)};
297                   }));
298             },
299             someChar->u);
300       }
301     }
302   } else if (name == "iand" || name == "ior" || name == "ieor") {
303     auto fptr{&Scalar<T>::IAND};
304     if (name == "iand") { // done in fptr declaration
305     } else if (name == "ior") {
306       fptr = &Scalar<T>::IOR;
307     } else if (name == "ieor") {
308       fptr = &Scalar<T>::IEOR;
309     } else {
310       common::die("missing case to fold intrinsic function %s", name.c_str());
311     }
312     return FoldElementalIntrinsic<T, T, T>(
313         context, std::move(funcRef), ScalarFunc<T, T, T>(fptr));
314   } else if (name == "ibclr" || name == "ibset" || name == "ishft" ||
315       name == "shifta" || name == "shiftr" || name == "shiftl") {
316     // Second argument can be of any kind. However, it must be smaller or
317     // equal than BIT_SIZE. It can be converted to Int4 to simplify.
318     auto fptr{&Scalar<T>::IBCLR};
319     if (name == "ibclr") { // done in fprt definition
320     } else if (name == "ibset") {
321       fptr = &Scalar<T>::IBSET;
322     } else if (name == "ishft") {
323       fptr = &Scalar<T>::ISHFT;
324     } else if (name == "shifta") {
325       fptr = &Scalar<T>::SHIFTA;
326     } else if (name == "shiftr") {
327       fptr = &Scalar<T>::SHIFTR;
328     } else if (name == "shiftl") {
329       fptr = &Scalar<T>::SHIFTL;
330     } else {
331       common::die("missing case to fold intrinsic function %s", name.c_str());
332     }
333     return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
334         ScalarFunc<T, T, Int4>(
335             [&fptr](const Scalar<T> &i, const Scalar<Int4> &pos) -> Scalar<T> {
336               return std::invoke(fptr, i, static_cast<int>(pos.ToInt64()));
337             }));
338   } else if (name == "index" || name == "scan" || name == "verify") {
339     if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
340       return std::visit(
341           [&](const auto &kch) -> Expr<T> {
342             using TC = typename std::decay_t<decltype(kch)>::Result;
343             if (UnwrapExpr<Expr<SomeLogical>>(args[2])) { // BACK=
344               return FoldElementalIntrinsic<T, TC, TC, LogicalResult>(context,
345                   std::move(funcRef),
346                   ScalarFunc<T, TC, TC, LogicalResult>{
347                       [&name](const Scalar<TC> &str, const Scalar<TC> &other,
348                           const Scalar<LogicalResult> &back) -> Scalar<T> {
349                         return name == "index"
350                             ? CharacterUtils<TC::kind>::INDEX(
351                                   str, other, back.IsTrue())
352                             : name == "scan" ? CharacterUtils<TC::kind>::SCAN(
353                                                    str, other, back.IsTrue())
354                                              : CharacterUtils<TC::kind>::VERIFY(
355                                                    str, other, back.IsTrue());
356                       }});
357             } else {
358               return FoldElementalIntrinsic<T, TC, TC>(context,
359                   std::move(funcRef),
360                   ScalarFunc<T, TC, TC>{
361                       [&name](const Scalar<TC> &str,
362                           const Scalar<TC> &other) -> Scalar<T> {
363                         return name == "index"
364                             ? CharacterUtils<TC::kind>::INDEX(str, other)
365                             : name == "scan"
366                             ? CharacterUtils<TC::kind>::SCAN(str, other)
367                             : CharacterUtils<TC::kind>::VERIFY(str, other);
368                       }});
369             }
370           },
371           charExpr->u);
372     } else {
373       DIE("first argument must be CHARACTER");
374     }
375   } else if (name == "int") {
376     if (auto *expr{UnwrapExpr<Expr<SomeType>>(args[0])}) {
377       return std::visit(
378           [&](auto &&x) -> Expr<T> {
379             using From = std::decay_t<decltype(x)>;
380             if constexpr (std::is_same_v<From, BOZLiteralConstant> ||
381                 IsNumericCategoryExpr<From>()) {
382               return Fold(context, ConvertToType<T>(std::move(x)));
383             }
384             DIE("int() argument type not valid");
385           },
386           std::move(expr->u));
387     }
388   } else if (name == "int_ptr_kind") {
389     return Expr<T>{8};
390   } else if (name == "kind") {
391     if constexpr (common::HasMember<T, IntegerTypes>) {
392       return Expr<T>{args[0].value().GetType()->kind()};
393     } else {
394       DIE("kind() result not integral");
395     }
396   } else if (name == "lbound") {
397     return LBOUND(context, std::move(funcRef));
398   } else if (name == "leadz" || name == "trailz" || name == "poppar" ||
399       name == "popcnt") {
400     if (auto *sn{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
401       return std::visit(
402           [&funcRef, &context, &name](const auto &n) -> Expr<T> {
403             using TI = typename std::decay_t<decltype(n)>::Result;
404             if (name == "poppar") {
405               return FoldElementalIntrinsic<T, TI>(context, std::move(funcRef),
406                   ScalarFunc<T, TI>([](const Scalar<TI> &i) -> Scalar<T> {
407                     return Scalar<T>{i.POPPAR() ? 1 : 0};
408                   }));
409             }
410             auto fptr{&Scalar<TI>::LEADZ};
411             if (name == "leadz") { // done in fptr definition
412             } else if (name == "trailz") {
413               fptr = &Scalar<TI>::TRAILZ;
414             } else if (name == "popcnt") {
415               fptr = &Scalar<TI>::POPCNT;
416             } else {
417               common::die(
418                   "missing case to fold intrinsic function %s", name.c_str());
419             }
420             return FoldElementalIntrinsic<T, TI>(context, std::move(funcRef),
421                 ScalarFunc<T, TI>([&fptr](const Scalar<TI> &i) -> Scalar<T> {
422                   return Scalar<T>{std::invoke(fptr, i)};
423                 }));
424           },
425           sn->u);
426     } else {
427       DIE("leadz argument must be integer");
428     }
429   } else if (name == "len") {
430     if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
431       return std::visit(
432           [&](auto &kx) {
433             if (auto len{kx.LEN()}) {
434               return Fold(context, ConvertToType<T>(*std::move(len)));
435             } else {
436               return Expr<T>{std::move(funcRef)};
437             }
438           },
439           charExpr->u);
440     } else {
441       DIE("len() argument must be of character type");
442     }
443   } else if (name == "len_trim") {
444     if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
445       return std::visit(
446           [&](const auto &kch) -> Expr<T> {
447             using TC = typename std::decay_t<decltype(kch)>::Result;
448             return FoldElementalIntrinsic<T, TC>(context, std::move(funcRef),
449                 ScalarFunc<T, TC>{[](const Scalar<TC> &str) -> Scalar<T> {
450                   return CharacterUtils<TC::kind>::LEN_TRIM(str);
451                 }});
452           },
453           charExpr->u);
454     } else {
455       DIE("len_trim() argument must be of character type");
456     }
457   } else if (name == "maskl" || name == "maskr") {
458     // Argument can be of any kind but value has to be smaller than BIT_SIZE.
459     // It can be safely converted to Int4 to simplify.
460     const auto fptr{name == "maskl" ? &Scalar<T>::MASKL : &Scalar<T>::MASKR};
461     return FoldElementalIntrinsic<T, Int4>(context, std::move(funcRef),
462         ScalarFunc<T, Int4>([&fptr](const Scalar<Int4> &places) -> Scalar<T> {
463           return fptr(static_cast<int>(places.ToInt64()));
464         }));
465   } else if (name == "max") {
466     return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
467   } else if (name == "max0" || name == "max1") {
468     return RewriteSpecificMINorMAX(context, std::move(funcRef));
469   } else if (name == "maxexponent") {
470     if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
471       return std::visit(
472           [](const auto &x) {
473             using TR = typename std::decay_t<decltype(x)>::Result;
474             return Expr<T>{Scalar<TR>::MAXEXPONENT};
475           },
476           sx->u);
477     }
478   } else if (name == "maxval") {
479     return FoldMaxvalMinval<T>(context, std::move(funcRef),
480         RelationalOperator::GT, T::Scalar::Least());
481   } else if (name == "merge") {
482     return FoldMerge<T>(context, std::move(funcRef));
483   } else if (name == "merge_bits") {
484     return FoldElementalIntrinsic<T, T, T, T>(
485         context, std::move(funcRef), &Scalar<T>::MERGE_BITS);
486   } else if (name == "minexponent") {
487     if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
488       return std::visit(
489           [](const auto &x) {
490             using TR = typename std::decay_t<decltype(x)>::Result;
491             return Expr<T>{Scalar<TR>::MINEXPONENT};
492           },
493           sx->u);
494     }
495   } else if (name == "min") {
496     return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
497   } else if (name == "min0" || name == "min1") {
498     return RewriteSpecificMINorMAX(context, std::move(funcRef));
499   } else if (name == "minval") {
500     return FoldMaxvalMinval<T>(
501         context, std::move(funcRef), RelationalOperator::LT, T::Scalar::HUGE());
502   } else if (name == "mod") {
503     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
504         ScalarFuncWithContext<T, T, T>(
505             [](FoldingContext &context, const Scalar<T> &x,
506                 const Scalar<T> &y) -> Scalar<T> {
507               auto quotRem{x.DivideSigned(y)};
508               if (quotRem.divisionByZero) {
509                 context.messages().Say("mod() by zero"_en_US);
510               } else if (quotRem.overflow) {
511                 context.messages().Say("mod() folding overflowed"_en_US);
512               }
513               return quotRem.remainder;
514             }));
515   } else if (name == "modulo") {
516     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
517         ScalarFuncWithContext<T, T, T>(
518             [](FoldingContext &context, const Scalar<T> &x,
519                 const Scalar<T> &y) -> Scalar<T> {
520               auto result{x.MODULO(y)};
521               if (result.overflow) {
522                 context.messages().Say("modulo() folding overflowed"_en_US);
523               }
524               return result.value;
525             }));
526   } else if (name == "precision") {
527     if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
528       return Expr<T>{std::visit(
529           [](const auto &kx) {
530             return Scalar<ResultType<decltype(kx)>>::PRECISION;
531           },
532           cx->u)};
533     } else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
534       return Expr<T>{std::visit(
535           [](const auto &kx) {
536             return Scalar<typename ResultType<decltype(kx)>::Part>::PRECISION;
537           },
538           cx->u)};
539     }
540   } else if (name == "radix") {
541     return Expr<T>{2};
542   } else if (name == "range") {
543     if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
544       return Expr<T>{std::visit(
545           [](const auto &kx) {
546             return Scalar<ResultType<decltype(kx)>>::RANGE;
547           },
548           cx->u)};
549     } else if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
550       return Expr<T>{std::visit(
551           [](const auto &kx) {
552             return Scalar<ResultType<decltype(kx)>>::RANGE;
553           },
554           cx->u)};
555     } else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
556       return Expr<T>{std::visit(
557           [](const auto &kx) {
558             return Scalar<typename ResultType<decltype(kx)>::Part>::RANGE;
559           },
560           cx->u)};
561     }
562   } else if (name == "rank") {
563     if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
564       if (auto named{ExtractNamedEntity(*array)}) {
565         const Symbol &symbol{named->GetLastSymbol()};
566         if (semantics::IsAssumedRankArray(symbol)) {
567           // DescriptorInquiry can only be placed in expression of kind
568           // DescriptorInquiry::Result::kind.
569           return ConvertToType<T>(Expr<
570               Type<TypeCategory::Integer, DescriptorInquiry::Result::kind>>{
571               DescriptorInquiry{*named, DescriptorInquiry::Field::Rank}});
572         }
573       }
574       return Expr<T>{args[0].value().Rank()};
575     }
576     return Expr<T>{args[0].value().Rank()};
577   } else if (name == "selected_char_kind") {
578     if (const auto *chCon{UnwrapExpr<Constant<TypeOf<std::string>>>(args[0])}) {
579       if (std::optional<std::string> value{chCon->GetScalarValue()}) {
580         int defaultKind{
581             context.defaults().GetDefaultKind(TypeCategory::Character)};
582         return Expr<T>{SelectedCharKind(*value, defaultKind)};
583       }
584     }
585   } else if (name == "selected_int_kind") {
586     if (auto p{GetInt64Arg(args[0])}) {
587       return Expr<T>{SelectedIntKind(*p)};
588     }
589   } else if (name == "selected_real_kind" ||
590       name == "__builtin_ieee_selected_real_kind") {
591     if (auto p{GetInt64ArgOr(args[0], 0)}) {
592       if (auto r{GetInt64ArgOr(args[1], 0)}) {
593         if (auto radix{GetInt64ArgOr(args[2], 2)}) {
594           return Expr<T>{SelectedRealKind(*p, *r, *radix)};
595         }
596       }
597     }
598   } else if (name == "shape") {
599     if (auto shape{GetShape(context, args[0])}) {
600       if (auto shapeExpr{AsExtentArrayExpr(*shape)}) {
601         return Fold(context, ConvertToType<T>(std::move(*shapeExpr)));
602       }
603     }
604   } else if (name == "sign") {
605     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
606         ScalarFunc<T, T, T>(
607             [&context](const Scalar<T> &j, const Scalar<T> &k) -> Scalar<T> {
608               typename Scalar<T>::ValueWithOverflow result{j.SIGN(k)};
609               if (result.overflow) {
610                 context.messages().Say(
611                     "sign(integer(kind=%d)) folding overflowed"_en_US, KIND);
612               }
613               return result.value;
614             }));
615   } else if (name == "size") {
616     if (auto shape{GetShape(context, args[0])}) {
617       if (auto &dimArg{args[1]}) { // DIM= is present, get one extent
618         if (auto dim{GetInt64Arg(args[1])}) {
619           int rank{GetRank(*shape)};
620           if (*dim >= 1 && *dim <= rank) {
621             if (auto &extent{shape->at(*dim - 1)}) {
622               return Fold(context, ConvertToType<T>(std::move(*extent)));
623             }
624           } else {
625             context.messages().Say(
626                 "size(array,dim=%jd) dimension is out of range for rank-%d array"_en_US,
627                 *dim, rank);
628           }
629         }
630       } else if (auto extents{common::AllElementsPresent(std::move(*shape))}) {
631         // DIM= is absent; compute PRODUCT(SHAPE())
632         ExtentExpr product{1};
633         for (auto &&extent : std::move(*extents)) {
634           product = std::move(product) * std::move(extent);
635         }
636         return Expr<T>{ConvertToType<T>(Fold(context, std::move(product)))};
637       }
638     }
639   } else if (name == "sizeof") { // in bytes; extension
640     if (auto info{
641             characteristics::TypeAndShape::Characterize(args[0], context)}) {
642       if (auto bytes{info->MeasureSizeInBytes(context)}) {
643         return Expr<T>{Fold(context, ConvertToType<T>(std::move(*bytes)))};
644       }
645     }
646   } else if (name == "storage_size") { // in bits
647     if (auto info{
648             characteristics::TypeAndShape::Characterize(args[0], context)}) {
649       if (auto bytes{info->MeasureElementSizeInBytes(context, true)}) {
650         return Expr<T>{
651             Fold(context, Expr<T>{8} * ConvertToType<T>(std::move(*bytes)))};
652       }
653     }
654   } else if (name == "ubound") {
655     return UBOUND(context, std::move(funcRef));
656   }
657   // TODO:
658   // cshift, dot_product, eoshift,
659   // findloc, iall, iany, iparity, ibits, image_status, ishftc,
660   // matmul, maxloc, minloc, not, pack, product, reduce,
661   // sign, spread, sum, transfer, transpose, unpack
662   return Expr<T>{std::move(funcRef)};
663 }
664 
665 // Substitutes a bare type parameter reference with its value if it has one now
666 // in an instantiation.  Bare LEN type parameters are substituted only when
667 // the known value is constant.
668 Expr<TypeParamInquiry::Result> FoldOperation(
669     FoldingContext &context, TypeParamInquiry &&inquiry) {
670   std::optional<NamedEntity> base{inquiry.base()};
671   parser::CharBlock parameterName{inquiry.parameter().name()};
672   if (base) {
673     // Handling "designator%typeParam".  Get the value of the type parameter
674     // from the instantiation of the base
675     if (const semantics::DeclTypeSpec *
676         declType{base->GetLastSymbol().GetType()}) {
677       if (const semantics::ParamValue *
678           paramValue{
679               declType->derivedTypeSpec().FindParameter(parameterName)}) {
680         const semantics::MaybeIntExpr &paramExpr{paramValue->GetExplicit()};
681         if (paramExpr && IsConstantExpr(*paramExpr)) {
682           Expr<SomeInteger> intExpr{*paramExpr};
683           return Fold(context,
684               ConvertToType<TypeParamInquiry::Result>(std::move(intExpr)));
685         }
686       }
687     }
688   } else {
689     // A "bare" type parameter: replace with its value, if that's now known
690     // in a current derived type instantiation, for KIND type parameters.
691     if (const auto *pdt{context.pdtInstance()}) {
692       bool isLen{false};
693       if (const semantics::Scope * scope{context.pdtInstance()->scope()}) {
694         auto iter{scope->find(parameterName)};
695         if (iter != scope->end()) {
696           const Symbol &symbol{*iter->second};
697           const auto *details{symbol.detailsIf<semantics::TypeParamDetails>()};
698           if (details) {
699             isLen = details->attr() == common::TypeParamAttr::Len;
700             const semantics::MaybeIntExpr &initExpr{details->init()};
701             if (initExpr && IsConstantExpr(*initExpr) &&
702                 (!isLen || ToInt64(*initExpr))) {
703               Expr<SomeInteger> expr{*initExpr};
704               return Fold(context,
705                   ConvertToType<TypeParamInquiry::Result>(std::move(expr)));
706             }
707           }
708         }
709       }
710       if (const auto *value{pdt->FindParameter(parameterName)}) {
711         if (value->isExplicit()) {
712           auto folded{Fold(context,
713               AsExpr(ConvertToType<TypeParamInquiry::Result>(
714                   Expr<SomeInteger>{value->GetExplicit().value()})))};
715           if (!isLen || ToInt64(folded)) {
716             return folded;
717           }
718         }
719       }
720     }
721   }
722   return AsExpr(std::move(inquiry));
723 }
724 
725 std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &expr) {
726   return std::visit(
727       [](const auto &kindExpr) { return ToInt64(kindExpr); }, expr.u);
728 }
729 
730 std::optional<std::int64_t> ToInt64(const Expr<SomeType> &expr) {
731   if (const auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(expr)}) {
732     return ToInt64(*intExpr);
733   } else {
734     return std::nullopt;
735   }
736 }
737 
738 FOR_EACH_INTEGER_KIND(template class ExpressionBase, )
739 template class ExpressionBase<SomeInteger>;
740 } // namespace Fortran::evaluate
741