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