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 == "max0" || name == "max1") {
427     return RewriteSpecificMINorMAX(context, std::move(funcRef));
428   } else if (name == "maxexponent") {
429     if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
430       return std::visit(
431           [](const auto &x) {
432             using TR = typename std::decay_t<decltype(x)>::Result;
433             return Expr<T>{Scalar<TR>::MAXEXPONENT};
434           },
435           sx->u);
436     }
437   } else if (name == "merge") {
438     return FoldMerge<T>(context, std::move(funcRef));
439   } else if (name == "merge_bits") {
440     return FoldElementalIntrinsic<T, T, T, T>(
441         context, std::move(funcRef), &Scalar<T>::MERGE_BITS);
442   } else if (name == "minexponent") {
443     if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
444       return std::visit(
445           [](const auto &x) {
446             using TR = typename std::decay_t<decltype(x)>::Result;
447             return Expr<T>{Scalar<TR>::MINEXPONENT};
448           },
449           sx->u);
450     }
451   } else if (name == "min") {
452     return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
453   } else if (name == "min0" || name == "min1") {
454     return RewriteSpecificMINorMAX(context, std::move(funcRef));
455   } else if (name == "mod") {
456     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
457         ScalarFuncWithContext<T, T, T>(
458             [](FoldingContext &context, const Scalar<T> &x,
459                 const Scalar<T> &y) -> Scalar<T> {
460               auto quotRem{x.DivideSigned(y)};
461               if (quotRem.divisionByZero) {
462                 context.messages().Say("mod() by zero"_en_US);
463               } else if (quotRem.overflow) {
464                 context.messages().Say("mod() folding overflowed"_en_US);
465               }
466               return quotRem.remainder;
467             }));
468   } else if (name == "modulo") {
469     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
470         ScalarFuncWithContext<T, T, T>(
471             [](FoldingContext &context, const Scalar<T> &x,
472                 const Scalar<T> &y) -> Scalar<T> {
473               auto result{x.MODULO(y)};
474               if (result.overflow) {
475                 context.messages().Say("modulo() folding overflowed"_en_US);
476               }
477               return result.value;
478             }));
479   } else if (name == "precision") {
480     if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
481       return Expr<T>{std::visit(
482           [](const auto &kx) {
483             return Scalar<ResultType<decltype(kx)>>::PRECISION;
484           },
485           cx->u)};
486     } else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
487       return Expr<T>{std::visit(
488           [](const auto &kx) {
489             return Scalar<typename ResultType<decltype(kx)>::Part>::PRECISION;
490           },
491           cx->u)};
492     }
493   } else if (name == "radix") {
494     return Expr<T>{2};
495   } else if (name == "range") {
496     if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
497       return Expr<T>{std::visit(
498           [](const auto &kx) {
499             return Scalar<ResultType<decltype(kx)>>::RANGE;
500           },
501           cx->u)};
502     } else if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
503       return Expr<T>{std::visit(
504           [](const auto &kx) {
505             return Scalar<ResultType<decltype(kx)>>::RANGE;
506           },
507           cx->u)};
508     } else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
509       return Expr<T>{std::visit(
510           [](const auto &kx) {
511             return Scalar<typename ResultType<decltype(kx)>::Part>::RANGE;
512           },
513           cx->u)};
514     }
515   } else if (name == "rank") {
516     if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
517       if (auto named{ExtractNamedEntity(*array)}) {
518         const Symbol &symbol{named->GetLastSymbol()};
519         if (semantics::IsAssumedRankArray(symbol)) {
520           // DescriptorInquiry can only be placed in expression of kind
521           // DescriptorInquiry::Result::kind.
522           return ConvertToType<T>(Expr<
523               Type<TypeCategory::Integer, DescriptorInquiry::Result::kind>>{
524               DescriptorInquiry{*named, DescriptorInquiry::Field::Rank}});
525         }
526       }
527       return Expr<T>{args[0].value().Rank()};
528     }
529     return Expr<T>{args[0].value().Rank()};
530   } else if (name == "selected_char_kind") {
531     if (const auto *chCon{UnwrapExpr<Constant<TypeOf<std::string>>>(args[0])}) {
532       if (std::optional<std::string> value{chCon->GetScalarValue()}) {
533         int defaultKind{
534             context.defaults().GetDefaultKind(TypeCategory::Character)};
535         return Expr<T>{SelectedCharKind(*value, defaultKind)};
536       }
537     }
538   } else if (name == "selected_int_kind") {
539     if (auto p{GetInt64Arg(args[0])}) {
540       return Expr<T>{SelectedIntKind(*p)};
541     }
542   } else if (name == "selected_real_kind") {
543     if (auto p{GetInt64ArgOr(args[0], 0)}) {
544       if (auto r{GetInt64ArgOr(args[1], 0)}) {
545         if (auto radix{GetInt64ArgOr(args[2], 2)}) {
546           return Expr<T>{SelectedRealKind(*p, *r, *radix)};
547         }
548       }
549     }
550   } else if (name == "shape") {
551     if (auto shape{GetShape(context, args[0])}) {
552       if (auto shapeExpr{AsExtentArrayExpr(*shape)}) {
553         return Fold(context, ConvertToType<T>(std::move(*shapeExpr)));
554       }
555     }
556   } else if (name == "sign") {
557     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
558         ScalarFunc<T, T, T>(
559             [&context](const Scalar<T> &j, const Scalar<T> &k) -> Scalar<T> {
560               typename Scalar<T>::ValueWithOverflow result{j.SIGN(k)};
561               if (result.overflow) {
562                 context.messages().Say(
563                     "sign(integer(kind=%d)) folding overflowed"_en_US, KIND);
564               }
565               return result.value;
566             }));
567   } else if (name == "size") {
568     if (auto shape{GetShape(context, args[0])}) {
569       if (auto &dimArg{args[1]}) { // DIM= is present, get one extent
570         if (auto dim{GetInt64Arg(args[1])}) {
571           int rank{GetRank(*shape)};
572           if (*dim >= 1 && *dim <= rank) {
573             if (auto &extent{shape->at(*dim - 1)}) {
574               return Fold(context, ConvertToType<T>(std::move(*extent)));
575             }
576           } else {
577             context.messages().Say(
578                 "size(array,dim=%jd) dimension is out of range for rank-%d array"_en_US,
579                 *dim, rank);
580           }
581         }
582       } else if (auto extents{common::AllElementsPresent(std::move(*shape))}) {
583         // DIM= is absent; compute PRODUCT(SHAPE())
584         ExtentExpr product{1};
585         for (auto &&extent : std::move(*extents)) {
586           product = std::move(product) * std::move(extent);
587         }
588         return Expr<T>{ConvertToType<T>(Fold(context, std::move(product)))};
589       }
590     }
591   } else if (name == "ubound") {
592     return UBOUND(context, std::move(funcRef));
593   }
594   // TODO:
595   // cshift, dot_product, eoshift,
596   // findloc, iall, iany, iparity, ibits, image_status, ishftc,
597   // matmul, maxloc, maxval,
598   // minloc, minval, not, pack, product, reduce,
599   // sign, spread, sum, transfer, transpose, unpack
600   return Expr<T>{std::move(funcRef)};
601 }
602 
603 // Substitute a bare type parameter reference with its value if it has one now
604 template <int KIND>
605 Expr<Type<TypeCategory::Integer, KIND>> FoldOperation(
606     FoldingContext &context, TypeParamInquiry<KIND> &&inquiry) {
607   using IntKIND = Type<TypeCategory::Integer, KIND>;
608   if (!inquiry.base()) {
609     // A "bare" type parameter: replace with its value, if that's now known.
610     if (const auto *pdt{context.pdtInstance()}) {
611       if (const semantics::Scope * scope{context.pdtInstance()->scope()}) {
612         auto iter{scope->find(inquiry.parameter().name())};
613         if (iter != scope->end()) {
614           const Symbol &symbol{*iter->second};
615           const auto *details{symbol.detailsIf<semantics::TypeParamDetails>()};
616           if (details && details->init()) {
617             Expr<SomeInteger> expr{*details->init()};
618             return Fold(context,
619                 Expr<IntKIND>{
620                     Convert<IntKIND, TypeCategory::Integer>(std::move(expr))});
621           }
622         }
623       }
624       if (const auto *value{pdt->FindParameter(inquiry.parameter().name())}) {
625         if (value->isExplicit()) {
626           return Fold(context,
627               Expr<IntKIND>{Convert<IntKIND, TypeCategory::Integer>(
628                   Expr<SomeInteger>{value->GetExplicit().value()})});
629         }
630       }
631     }
632   }
633   return Expr<IntKIND>{std::move(inquiry)};
634 }
635 
636 std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &expr) {
637   return std::visit(
638       [](const auto &kindExpr) { return ToInt64(kindExpr); }, expr.u);
639 }
640 
641 std::optional<std::int64_t> ToInt64(const Expr<SomeType> &expr) {
642   if (const auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(expr)}) {
643     return ToInt64(*intExpr);
644   } else {
645     return std::nullopt;
646   }
647 }
648 
649 FOR_EACH_INTEGER_KIND(template class ExpressionBase, )
650 template class ExpressionBase<SomeInteger>;
651 } // namespace Fortran::evaluate
652