xref: /llvm-project/flang/lib/Evaluate/fold-integer.cpp (revision 76d71354dbbba0ed7e86d1c7c6edc7f6f4e44420) 
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"
161               ? common::RoundingMode::Up
162               : name == "floor" ? common::RoundingMode::Down
163                                 : common::RoundingMode::TiesAwayFromZero};
164       return std::visit(
165           [&](const auto &kx) {
166             using TR = ResultType<decltype(kx)>;
167             return FoldElementalIntrinsic<T, TR>(context, std::move(funcRef),
168                 ScalarFunc<T, TR>([&](const Scalar<TR> &x) {
169                   auto y{x.template ToInteger<Scalar<T>>(mode)};
170                   if (y.flags.test(RealFlag::Overflow)) {
171                     context.messages().Say(
172                         "%s intrinsic folding overflow"_en_US, name);
173                   }
174                   return y.value;
175                 }));
176           },
177           cx->u);
178     }
179   } else if (name == "count") {
180     if (!args[1]) { // TODO: COUNT(x,DIM=d)
181       if (const auto *constant{UnwrapConstantValue<LogicalResult>(args[0])}) {
182         std::int64_t result{0};
183         for (const auto &element : constant->values()) {
184           if (element.IsTrue()) {
185             ++result;
186           }
187         }
188         return Expr<T>{result};
189       }
190     }
191   } else if (name == "digits") {
192     if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
193       return Expr<T>{std::visit(
194           [](const auto &kx) {
195             return Scalar<ResultType<decltype(kx)>>::DIGITS;
196           },
197           cx->u)};
198     } else if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
199       return Expr<T>{std::visit(
200           [](const auto &kx) {
201             return Scalar<ResultType<decltype(kx)>>::DIGITS;
202           },
203           cx->u)};
204     } else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
205       return Expr<T>{std::visit(
206           [](const auto &kx) {
207             return Scalar<typename ResultType<decltype(kx)>::Part>::DIGITS;
208           },
209           cx->u)};
210     }
211   } else if (name == "dim") {
212     return FoldElementalIntrinsic<T, T, T>(
213         context, std::move(funcRef), &Scalar<T>::DIM);
214   } else if (name == "dshiftl" || name == "dshiftr") {
215     const auto fptr{
216         name == "dshiftl" ? &Scalar<T>::DSHIFTL : &Scalar<T>::DSHIFTR};
217     // Third argument can be of any kind. However, it must be smaller or equal
218     // than BIT_SIZE. It can be converted to Int4 to simplify.
219     return FoldElementalIntrinsic<T, T, T, Int4>(context, std::move(funcRef),
220         ScalarFunc<T, T, T, Int4>(
221             [&fptr](const Scalar<T> &i, const Scalar<T> &j,
222                 const Scalar<Int4> &shift) -> Scalar<T> {
223               return std::invoke(fptr, i, j, static_cast<int>(shift.ToInt64()));
224             }));
225   } else if (name == "exponent") {
226     if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
227       return std::visit(
228           [&funcRef, &context](const auto &x) -> Expr<T> {
229             using TR = typename std::decay_t<decltype(x)>::Result;
230             return FoldElementalIntrinsic<T, TR>(context, std::move(funcRef),
231                 &Scalar<TR>::template EXPONENT<Scalar<T>>);
232           },
233           sx->u);
234     } else {
235       DIE("exponent argument must be real");
236     }
237   } else if (name == "huge") {
238     return Expr<T>{Scalar<T>::HUGE()};
239   } else if (name == "iachar" || name == "ichar") {
240     auto *someChar{UnwrapExpr<Expr<SomeCharacter>>(args[0])};
241     CHECK(someChar);
242     if (auto len{ToInt64(someChar->LEN())}) {
243       if (len.value() != 1) {
244         // Do not die, this was not checked before
245         context.messages().Say(
246             "Character in intrinsic function %s must have length one"_en_US,
247             name);
248       } else {
249         return std::visit(
250             [&funcRef, &context](const auto &str) -> Expr<T> {
251               using Char = typename std::decay_t<decltype(str)>::Result;
252               return FoldElementalIntrinsic<T, Char>(context,
253                   std::move(funcRef),
254                   ScalarFunc<T, Char>([](const Scalar<Char> &c) {
255                     return Scalar<T>{CharacterUtils<Char::kind>::ICHAR(c)};
256                   }));
257             },
258             someChar->u);
259       }
260     }
261   } else if (name == "iand" || name == "ior" || name == "ieor") {
262     auto fptr{&Scalar<T>::IAND};
263     if (name == "iand") { // done in fptr declaration
264     } else if (name == "ior") {
265       fptr = &Scalar<T>::IOR;
266     } else if (name == "ieor") {
267       fptr = &Scalar<T>::IEOR;
268     } else {
269       common::die("missing case to fold intrinsic function %s", name.c_str());
270     }
271     return FoldElementalIntrinsic<T, T, T>(
272         context, std::move(funcRef), ScalarFunc<T, T, T>(fptr));
273   } else if (name == "ibclr" || name == "ibset" || name == "ishft" ||
274       name == "shifta" || name == "shiftr" || name == "shiftl") {
275     // Second argument can be of any kind. However, it must be smaller or
276     // equal than BIT_SIZE. It can be converted to Int4 to simplify.
277     auto fptr{&Scalar<T>::IBCLR};
278     if (name == "ibclr") { // done in fprt definition
279     } else if (name == "ibset") {
280       fptr = &Scalar<T>::IBSET;
281     } else if (name == "ishft") {
282       fptr = &Scalar<T>::ISHFT;
283     } else if (name == "shifta") {
284       fptr = &Scalar<T>::SHIFTA;
285     } else if (name == "shiftr") {
286       fptr = &Scalar<T>::SHIFTR;
287     } else if (name == "shiftl") {
288       fptr = &Scalar<T>::SHIFTL;
289     } else {
290       common::die("missing case to fold intrinsic function %s", name.c_str());
291     }
292     return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
293         ScalarFunc<T, T, Int4>(
294             [&fptr](const Scalar<T> &i, const Scalar<Int4> &pos) -> Scalar<T> {
295               return std::invoke(fptr, i, static_cast<int>(pos.ToInt64()));
296             }));
297   } else if (name == "index" || name == "scan" || name == "verify") {
298     if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
299       return std::visit(
300           [&](const auto &kch) -> Expr<T> {
301             using TC = typename std::decay_t<decltype(kch)>::Result;
302             if (UnwrapExpr<Expr<SomeLogical>>(args[2])) { // BACK=
303               return FoldElementalIntrinsic<T, TC, TC, LogicalResult>(context,
304                   std::move(funcRef),
305                   ScalarFunc<T, TC, TC, LogicalResult>{
306                       [&name](const Scalar<TC> &str, const Scalar<TC> &other,
307                           const Scalar<LogicalResult> &back) -> Scalar<T> {
308                         return name == "index"
309                             ? CharacterUtils<TC::kind>::INDEX(
310                                   str, other, back.IsTrue())
311                             : name == "scan" ? CharacterUtils<TC::kind>::SCAN(
312                                                    str, other, back.IsTrue())
313                                              : CharacterUtils<TC::kind>::VERIFY(
314                                                    str, other, back.IsTrue());
315                       }});
316             } else {
317               return FoldElementalIntrinsic<T, TC, TC>(context,
318                   std::move(funcRef),
319                   ScalarFunc<T, TC, TC>{
320                       [&name](const Scalar<TC> &str,
321                           const Scalar<TC> &other) -> Scalar<T> {
322                         return name == "index"
323                             ? CharacterUtils<TC::kind>::INDEX(str, other)
324                             : name == "scan"
325                                 ? CharacterUtils<TC::kind>::SCAN(str, other)
326                                 : CharacterUtils<TC::kind>::VERIFY(str, other);
327                       }});
328             }
329           },
330           charExpr->u);
331     } else {
332       DIE("first argument must be CHARACTER");
333     }
334   } else if (name == "int") {
335     if (auto *expr{UnwrapExpr<Expr<SomeType>>(args[0])}) {
336       return std::visit(
337           [&](auto &&x) -> Expr<T> {
338             using From = std::decay_t<decltype(x)>;
339             if constexpr (std::is_same_v<From, BOZLiteralConstant> ||
340                 IsNumericCategoryExpr<From>()) {
341               return Fold(context, ConvertToType<T>(std::move(x)));
342             }
343             DIE("int() argument type not valid");
344           },
345           std::move(expr->u));
346     }
347   } else if (name == "int_ptr_kind") {
348     return Expr<T>{8};
349   } else if (name == "kind") {
350     if constexpr (common::HasMember<T, IntegerTypes>) {
351       return Expr<T>{args[0].value().GetType()->kind()};
352     } else {
353       DIE("kind() result not integral");
354     }
355   } else if (name == "lbound") {
356     return LBOUND(context, std::move(funcRef));
357   } else if (name == "leadz" || name == "trailz" || name == "poppar" ||
358       name == "popcnt") {
359     if (auto *sn{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
360       return std::visit(
361           [&funcRef, &context, &name](const auto &n) -> Expr<T> {
362             using TI = typename std::decay_t<decltype(n)>::Result;
363             if (name == "poppar") {
364               return FoldElementalIntrinsic<T, TI>(context, std::move(funcRef),
365                   ScalarFunc<T, TI>([](const Scalar<TI> &i) -> Scalar<T> {
366                     return Scalar<T>{i.POPPAR() ? 1 : 0};
367                   }));
368             }
369             auto fptr{&Scalar<TI>::LEADZ};
370             if (name == "leadz") { // done in fptr definition
371             } else if (name == "trailz") {
372               fptr = &Scalar<TI>::TRAILZ;
373             } else if (name == "popcnt") {
374               fptr = &Scalar<TI>::POPCNT;
375             } else {
376               common::die(
377                   "missing case to fold intrinsic function %s", name.c_str());
378             }
379             return FoldElementalIntrinsic<T, TI>(context, std::move(funcRef),
380                 ScalarFunc<T, TI>([&fptr](const Scalar<TI> &i) -> Scalar<T> {
381                   return Scalar<T>{std::invoke(fptr, i)};
382                 }));
383           },
384           sn->u);
385     } else {
386       DIE("leadz argument must be integer");
387     }
388   } else if (name == "len") {
389     if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
390       return std::visit(
391           [&](auto &kx) {
392             if (auto len{kx.LEN()}) {
393               return Fold(context, ConvertToType<T>(*std::move(len)));
394             } else {
395               return Expr<T>{std::move(funcRef)};
396             }
397           },
398           charExpr->u);
399     } else {
400       DIE("len() argument must be of character type");
401     }
402   } else if (name == "len_trim") {
403     if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
404       return std::visit(
405           [&](const auto &kch) -> Expr<T> {
406             using TC = typename std::decay_t<decltype(kch)>::Result;
407             return FoldElementalIntrinsic<T, TC>(context, std::move(funcRef),
408                 ScalarFunc<T, TC>{[](const Scalar<TC> &str) -> Scalar<T> {
409                   return CharacterUtils<TC::kind>::LEN_TRIM(str);
410                 }});
411           },
412           charExpr->u);
413     } else {
414       DIE("len_trim() argument must be of character type");
415     }
416   } else if (name == "maskl" || name == "maskr") {
417     // Argument can be of any kind but value has to be smaller than BIT_SIZE.
418     // It can be safely converted to Int4 to simplify.
419     const auto fptr{name == "maskl" ? &Scalar<T>::MASKL : &Scalar<T>::MASKR};
420     return FoldElementalIntrinsic<T, Int4>(context, std::move(funcRef),
421         ScalarFunc<T, Int4>([&fptr](const Scalar<Int4> &places) -> Scalar<T> {
422           return fptr(static_cast<int>(places.ToInt64()));
423         }));
424   } else if (name == "max") {
425     return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
426   } else if (name == "maxexponent") {
427     if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
428       return std::visit(
429           [](const auto &x) {
430             using TR = typename std::decay_t<decltype(x)>::Result;
431             return Expr<T>{Scalar<TR>::MAXEXPONENT};
432           },
433           sx->u);
434     }
435   } else if (name == "merge") {
436     return FoldMerge<T>(context, std::move(funcRef));
437   } else if (name == "merge_bits") {
438     return FoldElementalIntrinsic<T, T, T, T>(
439         context, std::move(funcRef), &Scalar<T>::MERGE_BITS);
440   } else if (name == "minexponent") {
441     if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
442       return std::visit(
443           [](const auto &x) {
444             using TR = typename std::decay_t<decltype(x)>::Result;
445             return Expr<T>{Scalar<TR>::MINEXPONENT};
446           },
447           sx->u);
448     }
449   } else if (name == "min") {
450     return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
451   } else if (name == "mod") {
452     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
453         ScalarFuncWithContext<T, T, T>(
454             [](FoldingContext &context, const Scalar<T> &x,
455                 const Scalar<T> &y) -> Scalar<T> {
456               auto quotRem{x.DivideSigned(y)};
457               if (quotRem.divisionByZero) {
458                 context.messages().Say("mod() by zero"_en_US);
459               } else if (quotRem.overflow) {
460                 context.messages().Say("mod() folding overflowed"_en_US);
461               }
462               return quotRem.remainder;
463             }));
464   } else if (name == "modulo") {
465     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
466         ScalarFuncWithContext<T, T, T>(
467             [](FoldingContext &context, const Scalar<T> &x,
468                 const Scalar<T> &y) -> Scalar<T> {
469               auto result{x.MODULO(y)};
470               if (result.overflow) {
471                 context.messages().Say("modulo() folding overflowed"_en_US);
472               }
473               return result.value;
474             }));
475   } else if (name == "precision") {
476     if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
477       return Expr<T>{std::visit(
478           [](const auto &kx) {
479             return Scalar<ResultType<decltype(kx)>>::PRECISION;
480           },
481           cx->u)};
482     } else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
483       return Expr<T>{std::visit(
484           [](const auto &kx) {
485             return Scalar<typename ResultType<decltype(kx)>::Part>::PRECISION;
486           },
487           cx->u)};
488     }
489   } else if (name == "radix") {
490     return Expr<T>{2};
491   } else if (name == "range") {
492     if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
493       return Expr<T>{std::visit(
494           [](const auto &kx) {
495             return Scalar<ResultType<decltype(kx)>>::RANGE;
496           },
497           cx->u)};
498     } else if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
499       return Expr<T>{std::visit(
500           [](const auto &kx) {
501             return Scalar<ResultType<decltype(kx)>>::RANGE;
502           },
503           cx->u)};
504     } else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
505       return Expr<T>{std::visit(
506           [](const auto &kx) {
507             return Scalar<typename ResultType<decltype(kx)>::Part>::RANGE;
508           },
509           cx->u)};
510     }
511   } else if (name == "rank") {
512     if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
513       if (auto named{ExtractNamedEntity(*array)}) {
514         const Symbol &symbol{named->GetLastSymbol()};
515         if (semantics::IsAssumedRankArray(symbol)) {
516           // DescriptorInquiry can only be placed in expression of kind
517           // DescriptorInquiry::Result::kind.
518           return ConvertToType<T>(Expr<
519               Type<TypeCategory::Integer, DescriptorInquiry::Result::kind>>{
520               DescriptorInquiry{*named, DescriptorInquiry::Field::Rank}});
521         }
522       }
523       return Expr<T>{args[0].value().Rank()};
524     }
525     return Expr<T>{args[0].value().Rank()};
526   } else if (name == "selected_char_kind") {
527     if (const auto *chCon{UnwrapExpr<Constant<TypeOf<std::string>>>(args[0])}) {
528       if (std::optional<std::string> value{chCon->GetScalarValue()}) {
529         int defaultKind{
530             context.defaults().GetDefaultKind(TypeCategory::Character)};
531         return Expr<T>{SelectedCharKind(*value, defaultKind)};
532       }
533     }
534   } else if (name == "selected_int_kind") {
535     if (auto p{GetInt64Arg(args[0])}) {
536       return Expr<T>{SelectedIntKind(*p)};
537     }
538   } else if (name == "selected_real_kind") {
539     if (auto p{GetInt64ArgOr(args[0], 0)}) {
540       if (auto r{GetInt64ArgOr(args[1], 0)}) {
541         if (auto radix{GetInt64ArgOr(args[2], 2)}) {
542           return Expr<T>{SelectedRealKind(*p, *r, *radix)};
543         }
544       }
545     }
546   } else if (name == "shape") {
547     if (auto shape{GetShape(context, args[0])}) {
548       if (auto shapeExpr{AsExtentArrayExpr(*shape)}) {
549         return Fold(context, ConvertToType<T>(std::move(*shapeExpr)));
550       }
551     }
552   } else if (name == "sign") {
553     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
554         ScalarFunc<T, T, T>(
555             [&context](const Scalar<T> &j, const Scalar<T> &k) -> Scalar<T> {
556               typename Scalar<T>::ValueWithOverflow result{j.SIGN(k)};
557               if (result.overflow) {
558                 context.messages().Say(
559                     "sign(integer(kind=%d)) folding overflowed"_en_US, KIND);
560               }
561               return result.value;
562             }));
563   } else if (name == "size") {
564     if (auto shape{GetShape(context, args[0])}) {
565       if (auto &dimArg{args[1]}) { // DIM= is present, get one extent
566         if (auto dim{GetInt64Arg(args[1])}) {
567           int rank{GetRank(*shape)};
568           if (*dim >= 1 && *dim <= rank) {
569             if (auto &extent{shape->at(*dim - 1)}) {
570               return Fold(context, ConvertToType<T>(std::move(*extent)));
571             }
572           } else {
573             context.messages().Say(
574                 "size(array,dim=%jd) dimension is out of range for rank-%d array"_en_US,
575                 *dim, rank);
576           }
577         }
578       } else if (auto extents{common::AllElementsPresent(std::move(*shape))}) {
579         // DIM= is absent; compute PRODUCT(SHAPE())
580         ExtentExpr product{1};
581         for (auto &&extent : std::move(*extents)) {
582           product = std::move(product) * std::move(extent);
583         }
584         return Expr<T>{ConvertToType<T>(Fold(context, std::move(product)))};
585       }
586     }
587   } else if (name == "ubound") {
588     return UBOUND(context, std::move(funcRef));
589   }
590   // TODO:
591   // cshift, dot_product, eoshift,
592   // findloc, iall, iany, iparity, ibits, image_status, ishftc,
593   // matmul, maxloc, maxval,
594   // minloc, minval, not, pack, product, reduce,
595   // sign, spread, sum, transfer, transpose, unpack
596   return Expr<T>{std::move(funcRef)};
597 }
598 
599 // Substitute a bare type parameter reference with its value if it has one now
600 template <int KIND>
601 Expr<Type<TypeCategory::Integer, KIND>> FoldOperation(
602     FoldingContext &context, TypeParamInquiry<KIND> &&inquiry) {
603   using IntKIND = Type<TypeCategory::Integer, KIND>;
604   if (!inquiry.base()) {
605     // A "bare" type parameter: replace with its value, if that's now known.
606     if (const auto *pdt{context.pdtInstance()}) {
607       if (const semantics::Scope * scope{context.pdtInstance()->scope()}) {
608         auto iter{scope->find(inquiry.parameter().name())};
609         if (iter != scope->end()) {
610           const Symbol &symbol{*iter->second};
611           const auto *details{symbol.detailsIf<semantics::TypeParamDetails>()};
612           if (details && details->init()) {
613             Expr<SomeInteger> expr{*details->init()};
614             return Fold(context,
615                 Expr<IntKIND>{
616                     Convert<IntKIND, TypeCategory::Integer>(std::move(expr))});
617           }
618         }
619       }
620       if (const auto *value{pdt->FindParameter(inquiry.parameter().name())}) {
621         if (value->isExplicit()) {
622           return Fold(context,
623               Expr<IntKIND>{Convert<IntKIND, TypeCategory::Integer>(
624                   Expr<SomeInteger>{value->GetExplicit().value()})});
625         }
626       }
627     }
628   }
629   return Expr<IntKIND>{std::move(inquiry)};
630 }
631 
632 std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &expr) {
633   return std::visit(
634       [](const auto &kindExpr) { return ToInt64(kindExpr); }, expr.u);
635 }
636 
637 std::optional<std::int64_t> ToInt64(const Expr<SomeType> &expr) {
638   if (const auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(expr)}) {
639     return ToInt64(*intExpr);
640   } else {
641     return std::nullopt;
642   }
643 }
644 
645 FOR_EACH_INTEGER_KIND(template class ExpressionBase, )
646 template class ExpressionBase<SomeInteger>;
647 } // namespace Fortran::evaluate
648