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