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