xref: /llvm-project/flang/lib/Evaluate/fold-integer.cpp (revision 94963919011d77c2f3f9d867cb73067a4f50e87c) 
1 //===-- lib/Evaluate/fold-integer.cpp -------------------------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 #include "fold-implementation.h"
10 #include "fold-matmul.h"
11 #include "fold-reduction.h"
12 #include "flang/Evaluate/check-expression.h"
13 
14 namespace Fortran::evaluate {
15 
16 // Given a collection of ConstantSubscripts values, package them as a Constant.
17 // Return scalar value if asScalar == true and shape-dim array otherwise.
18 template <typename T>
19 Expr<T> PackageConstantBounds(
20     const ConstantSubscripts &&bounds, bool asScalar = false) {
21   if (asScalar) {
22     return Expr<T>{Constant<T>{bounds.at(0)}};
23   } else {
24     // As rank-dim array
25     const int rank{GetRank(bounds)};
26     std::vector<Scalar<T>> packed(rank);
27     std::transform(bounds.begin(), bounds.end(), packed.begin(),
28         [](ConstantSubscript x) { return Scalar<T>(x); });
29     return Expr<T>{Constant<T>{std::move(packed), ConstantSubscripts{rank}}};
30   }
31 }
32 
33 // If a DIM= argument to LBOUND(), UBOUND(), or SIZE() exists and has a valid
34 // constant value, return in "dimVal" that value, less 1 (to make it suitable
35 // for use as a C++ vector<> index).  Also check for erroneous constant values
36 // and returns false on error.
37 static bool CheckDimArg(const std::optional<ActualArgument> &dimArg,
38     const Expr<SomeType> &array, parser::ContextualMessages &messages,
39     bool isLBound, std::optional<int> &dimVal) {
40   dimVal.reset();
41   if (int rank{array.Rank()}; rank > 0 || IsAssumedRank(array)) {
42     auto named{ExtractNamedEntity(array)};
43     if (auto dim64{ToInt64(dimArg)}) {
44       if (*dim64 < 1) {
45         messages.Say("DIM=%jd dimension must be positive"_err_en_US, *dim64);
46         return false;
47       } else if (!IsAssumedRank(array) && *dim64 > rank) {
48         messages.Say(
49             "DIM=%jd dimension is out of range for rank-%d array"_err_en_US,
50             *dim64, rank);
51         return false;
52       } else if (!isLBound && named &&
53           semantics::IsAssumedSizeArray(named->GetLastSymbol()) &&
54           *dim64 == rank) {
55         messages.Say(
56             "DIM=%jd dimension is out of range for rank-%d assumed-size array"_err_en_US,
57             *dim64, rank);
58         return false;
59       } else if (IsAssumedRank(array)) {
60         if (*dim64 > common::maxRank) {
61           messages.Say(
62               "DIM=%jd dimension is too large for any array (maximum rank %d)"_err_en_US,
63               *dim64, common::maxRank);
64           return false;
65         }
66       } else {
67         dimVal = static_cast<int>(*dim64 - 1); // 1-based to 0-based
68       }
69     }
70   }
71   return true;
72 }
73 
74 static bool CheckCoDimArg(const std::optional<ActualArgument> &dimArg,
75     const Symbol &symbol, parser::ContextualMessages &messages,
76     std::optional<int> &dimVal) {
77   dimVal.reset();
78   if (int corank{symbol.Corank()}; corank > 0) {
79     if (auto dim64{ToInt64(dimArg)}) {
80       if (*dim64 < 1) {
81         messages.Say("DIM=%jd dimension must be positive"_err_en_US, *dim64);
82         return false;
83       } else if (*dim64 > corank) {
84         messages.Say(
85             "DIM=%jd dimension is out of range for corank-%d coarray"_err_en_US,
86             *dim64, corank);
87         return false;
88       } else {
89         dimVal = static_cast<int>(*dim64 - 1); // 1-based to 0-based
90       }
91     }
92   }
93   return true;
94 }
95 
96 // Class to retrieve the constant bound of an expression which is an
97 // array that devolves to a type of Constant<T>
98 class GetConstantArrayBoundHelper {
99 public:
100   template <typename T>
101   static Expr<T> GetLbound(
102       const Expr<SomeType> &array, std::optional<int> dim) {
103     return PackageConstantBounds<T>(
104         GetConstantArrayBoundHelper(dim, /*getLbound=*/true).Get(array),
105         dim.has_value());
106   }
107 
108   template <typename T>
109   static Expr<T> GetUbound(
110       const Expr<SomeType> &array, std::optional<int> dim) {
111     return PackageConstantBounds<T>(
112         GetConstantArrayBoundHelper(dim, /*getLbound=*/false).Get(array),
113         dim.has_value());
114   }
115 
116 private:
117   GetConstantArrayBoundHelper(
118       std::optional<ConstantSubscript> dim, bool getLbound)
119       : dim_{dim}, getLbound_{getLbound} {}
120 
121   template <typename T> ConstantSubscripts Get(const T &) {
122     // The method is needed for template expansion, but we should never get
123     // here in practice.
124     CHECK(false);
125     return {0};
126   }
127 
128   template <typename T> ConstantSubscripts Get(const Constant<T> &x) {
129     if (getLbound_) {
130       // Return the lower bound
131       if (dim_) {
132         return {x.lbounds().at(*dim_)};
133       } else {
134         return x.lbounds();
135       }
136     } else {
137       // Return the upper bound
138       if (arrayFromParenthesesExpr) {
139         // Underlying array comes from (x) expression - return shapes
140         if (dim_) {
141           return {x.shape().at(*dim_)};
142         } else {
143           return x.shape();
144         }
145       } else {
146         return x.ComputeUbounds(dim_);
147       }
148     }
149   }
150 
151   template <typename T> ConstantSubscripts Get(const Parentheses<T> &x) {
152     // Case of temp variable inside parentheses - return [1, ... 1] for lower
153     // bounds and shape for upper bounds
154     if (getLbound_) {
155       return ConstantSubscripts(x.Rank(), ConstantSubscript{1});
156     } else {
157       // Indicate that underlying array comes from parentheses expression.
158       // Continue to unwrap expression until we hit a constant
159       arrayFromParenthesesExpr = true;
160       return Get(x.left());
161     }
162   }
163 
164   template <typename T> ConstantSubscripts Get(const Expr<T> &x) {
165     // recurse through Expr<T>'a until we hit a constant
166     return common::visit([&](const auto &inner) { return Get(inner); },
167         //      [&](const auto &) { return 0; },
168         x.u);
169   }
170 
171   const std::optional<ConstantSubscript> dim_;
172   const bool getLbound_;
173   bool arrayFromParenthesesExpr{false};
174 };
175 
176 template <int KIND>
177 Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
178     FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
179   using T = Type<TypeCategory::Integer, KIND>;
180   ActualArguments &args{funcRef.arguments()};
181   if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
182     std::optional<int> dim;
183     if (funcRef.Rank() == 0) {
184       // Optional DIM= argument is present: result is scalar.
185       if (!CheckDimArg(args[1], *array, context.messages(), true, dim)) {
186         return MakeInvalidIntrinsic<T>(std::move(funcRef));
187       } else if (!dim) {
188         // DIM= is present but not constant, or error
189         return Expr<T>{std::move(funcRef)};
190       }
191     }
192     if (IsAssumedRank(*array)) {
193       // Would like to return 1 if DIM=.. is present, but that would be
194       // hiding a runtime error if the DIM= were too large (including
195       // the case of an assumed-rank argument that's scalar).
196     } else if (int rank{array->Rank()}; rank > 0) {
197       bool lowerBoundsAreOne{true};
198       if (auto named{ExtractNamedEntity(*array)}) {
199         const Symbol &symbol{named->GetLastSymbol()};
200         if (symbol.Rank() == rank) {
201           lowerBoundsAreOne = false;
202           if (dim) {
203             if (auto lb{GetLBOUND(context, *named, *dim)}) {
204               return Fold(context, ConvertToType<T>(std::move(*lb)));
205             }
206           } else if (auto extents{
207                          AsExtentArrayExpr(GetLBOUNDs(context, *named))}) {
208             return Fold(context,
209                 ConvertToType<T>(Expr<ExtentType>{std::move(*extents)}));
210           }
211         } else {
212           lowerBoundsAreOne = symbol.Rank() == 0; // LBOUND(array%component)
213         }
214       }
215       if (IsActuallyConstant(*array)) {
216         return GetConstantArrayBoundHelper::GetLbound<T>(*array, dim);
217       }
218       if (lowerBoundsAreOne) {
219         ConstantSubscripts ones(rank, ConstantSubscript{1});
220         return PackageConstantBounds<T>(std::move(ones), dim.has_value());
221       }
222     }
223   }
224   return Expr<T>{std::move(funcRef)};
225 }
226 
227 template <int KIND>
228 Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
229     FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
230   using T = Type<TypeCategory::Integer, KIND>;
231   ActualArguments &args{funcRef.arguments()};
232   if (auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
233     std::optional<int> dim;
234     if (funcRef.Rank() == 0) {
235       // Optional DIM= argument is present: result is scalar.
236       if (!CheckDimArg(args[1], *array, context.messages(), false, dim)) {
237         return MakeInvalidIntrinsic<T>(std::move(funcRef));
238       } else if (!dim) {
239         // DIM= is present but not constant, or error
240         return Expr<T>{std::move(funcRef)};
241       }
242     }
243     if (IsAssumedRank(*array)) {
244     } else if (int rank{array->Rank()}; rank > 0) {
245       bool takeBoundsFromShape{true};
246       if (auto named{ExtractNamedEntity(*array)}) {
247         const Symbol &symbol{named->GetLastSymbol()};
248         if (symbol.Rank() == rank) {
249           takeBoundsFromShape = false;
250           if (dim) {
251             if (auto ub{GetUBOUND(context, *named, *dim)}) {
252               return Fold(context, ConvertToType<T>(std::move(*ub)));
253             }
254           } else {
255             Shape ubounds{GetUBOUNDs(context, *named)};
256             if (semantics::IsAssumedSizeArray(symbol)) {
257               CHECK(!ubounds.back());
258               ubounds.back() = ExtentExpr{-1};
259             }
260             if (auto extents{AsExtentArrayExpr(ubounds)}) {
261               return Fold(context,
262                   ConvertToType<T>(Expr<ExtentType>{std::move(*extents)}));
263             }
264           }
265         } else {
266           takeBoundsFromShape = symbol.Rank() == 0; // UBOUND(array%component)
267         }
268       }
269       if (IsActuallyConstant(*array)) {
270         return GetConstantArrayBoundHelper::GetUbound<T>(*array, dim);
271       }
272       if (takeBoundsFromShape) {
273         if (auto shape{GetContextFreeShape(context, *array)}) {
274           if (dim) {
275             if (auto &dimSize{shape->at(*dim)}) {
276               return Fold(context,
277                   ConvertToType<T>(Expr<ExtentType>{std::move(*dimSize)}));
278             }
279           } else if (auto shapeExpr{AsExtentArrayExpr(*shape)}) {
280             return Fold(context, ConvertToType<T>(std::move(*shapeExpr)));
281           }
282         }
283       }
284     }
285   }
286   return Expr<T>{std::move(funcRef)};
287 }
288 
289 // LCOBOUND() & UCOBOUND()
290 template <int KIND>
291 Expr<Type<TypeCategory::Integer, KIND>> COBOUND(FoldingContext &context,
292     FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef, bool isUCOBOUND) {
293   using T = Type<TypeCategory::Integer, KIND>;
294   ActualArguments &args{funcRef.arguments()};
295   if (const Symbol * coarray{UnwrapWholeSymbolOrComponentDataRef(args[0])}) {
296     std::optional<int> dim;
297     if (funcRef.Rank() == 0) {
298       // Optional DIM= argument is present: result is scalar.
299       if (!CheckCoDimArg(args[1], *coarray, context.messages(), dim)) {
300         return MakeInvalidIntrinsic<T>(std::move(funcRef));
301       } else if (!dim) {
302         // DIM= is present but not constant, or error
303         return Expr<T>{std::move(funcRef)};
304       }
305     }
306     if (dim) {
307       if (auto cb{isUCOBOUND ? GetUCOBOUND(*coarray, *dim)
308                              : GetLCOBOUND(*coarray, *dim)}) {
309         return Fold(context, ConvertToType<T>(std::move(*cb)));
310       }
311     } else if (auto cbs{
312                    AsExtentArrayExpr(isUCOBOUND ? GetUCOBOUNDs(*coarray)
313                                                 : GetLCOBOUNDs(*coarray))}) {
314       return Fold(context, ConvertToType<T>(Expr<ExtentType>{std::move(*cbs)}));
315     }
316   }
317   return Expr<T>{std::move(funcRef)};
318 }
319 
320 // COUNT()
321 template <typename T, int MASK_KIND> class CountAccumulator {
322   using MaskT = Type<TypeCategory::Logical, MASK_KIND>;
323 
324 public:
325   CountAccumulator(const Constant<MaskT> &mask) : mask_{mask} {}
326   void operator()(
327       Scalar<T> &element, const ConstantSubscripts &at, bool /*first*/) {
328     if (mask_.At(at).IsTrue()) {
329       auto incremented{element.AddSigned(Scalar<T>{1})};
330       overflow_ |= incremented.overflow;
331       element = incremented.value;
332     }
333   }
334   bool overflow() const { return overflow_; }
335   void Done(Scalar<T> &) const {}
336 
337 private:
338   const Constant<MaskT> &mask_;
339   bool overflow_{false};
340 };
341 
342 template <typename T, int maskKind>
343 static Expr<T> FoldCount(FoldingContext &context, FunctionRef<T> &&ref) {
344   using KindLogical = Type<TypeCategory::Logical, maskKind>;
345   static_assert(T::category == TypeCategory::Integer);
346   std::optional<int> dim;
347   if (std::optional<ArrayAndMask<KindLogical>> arrayAndMask{
348           ProcessReductionArgs<KindLogical>(
349               context, ref.arguments(), dim, /*ARRAY=*/0, /*DIM=*/1)}) {
350     CountAccumulator<T, maskKind> accumulator{arrayAndMask->array};
351     Constant<T> result{DoReduction<T>(arrayAndMask->array, arrayAndMask->mask,
352         dim, Scalar<T>{}, accumulator)};
353     if (accumulator.overflow() &&
354         context.languageFeatures().ShouldWarn(
355             common::UsageWarning::FoldingException)) {
356       context.messages().Say(common::UsageWarning::FoldingException,
357           "Result of intrinsic function COUNT overflows its result type"_warn_en_US);
358     }
359     return Expr<T>{std::move(result)};
360   }
361   return Expr<T>{std::move(ref)};
362 }
363 
364 // FINDLOC(), MAXLOC(), & MINLOC()
365 enum class WhichLocation { Findloc, Maxloc, Minloc };
366 template <WhichLocation WHICH> class LocationHelper {
367 public:
368   LocationHelper(
369       DynamicType &&type, ActualArguments &arg, FoldingContext &context)
370       : type_{type}, arg_{arg}, context_{context} {}
371   using Result = std::optional<Constant<SubscriptInteger>>;
372   using Types = std::conditional_t<WHICH == WhichLocation::Findloc,
373       AllIntrinsicTypes, RelationalTypes>;
374 
375   template <typename T> Result Test() const {
376     if (T::category != type_.category() || T::kind != type_.kind()) {
377       return std::nullopt;
378     }
379     CHECK(arg_.size() == (WHICH == WhichLocation::Findloc ? 6 : 5));
380     Folder<T> folder{context_};
381     Constant<T> *array{folder.Folding(arg_[0])};
382     if (!array) {
383       return std::nullopt;
384     }
385     std::optional<Constant<T>> value;
386     if constexpr (WHICH == WhichLocation::Findloc) {
387       if (const Constant<T> *p{folder.Folding(arg_[1])}) {
388         value.emplace(*p);
389       } else {
390         return std::nullopt;
391       }
392     }
393     std::optional<int> dim;
394     Constant<LogicalResult> *mask{
395         GetReductionMASK(arg_[maskArg], array->shape(), context_)};
396     if ((!mask && arg_[maskArg]) ||
397         !CheckReductionDIM(dim, context_, arg_, dimArg, array->Rank())) {
398       return std::nullopt;
399     }
400     bool back{false};
401     if (arg_[backArg]) {
402       const auto *backConst{
403           Folder<LogicalResult>{context_, /*forOptionalArgument=*/true}.Folding(
404               arg_[backArg])};
405       if (backConst) {
406         back = backConst->GetScalarValue().value().IsTrue();
407       } else {
408         return std::nullopt;
409       }
410     }
411     const RelationalOperator relation{WHICH == WhichLocation::Findloc
412             ? RelationalOperator::EQ
413             : WHICH == WhichLocation::Maxloc
414             ? (back ? RelationalOperator::GE : RelationalOperator::GT)
415             : back ? RelationalOperator::LE
416                    : RelationalOperator::LT};
417     // Use lower bounds of 1 exclusively.
418     array->SetLowerBoundsToOne();
419     ConstantSubscripts at{array->lbounds()}, maskAt, resultIndices, resultShape;
420     if (mask) {
421       if (auto scalarMask{mask->GetScalarValue()}) {
422         // Convert into array in case of scalar MASK= (for
423         // MAXLOC/MINLOC/FINDLOC mask should be conformable)
424         ConstantSubscript n{GetSize(array->shape())};
425         std::vector<Scalar<LogicalResult>> mask_elements(
426             n, Scalar<LogicalResult>{scalarMask.value()});
427         *mask = Constant<LogicalResult>{
428             std::move(mask_elements), ConstantSubscripts{array->shape()}};
429       }
430       mask->SetLowerBoundsToOne();
431       maskAt = mask->lbounds();
432     }
433     if (dim) { // DIM=
434       if (*dim < 1 || *dim > array->Rank()) {
435         context_.messages().Say("DIM=%d is out of range"_err_en_US, *dim);
436         return std::nullopt;
437       }
438       int zbDim{*dim - 1};
439       resultShape = array->shape();
440       resultShape.erase(
441           resultShape.begin() + zbDim); // scalar if array is vector
442       ConstantSubscript dimLength{array->shape()[zbDim]};
443       ConstantSubscript n{GetSize(resultShape)};
444       for (ConstantSubscript j{0}; j < n; ++j) {
445         ConstantSubscript hit{0};
446         if constexpr (WHICH == WhichLocation::Maxloc ||
447             WHICH == WhichLocation::Minloc) {
448           value.reset();
449         }
450         for (ConstantSubscript k{0}; k < dimLength;
451              ++k, ++at[zbDim], mask && ++maskAt[zbDim]) {
452           if ((!mask || mask->At(maskAt).IsTrue()) &&
453               IsHit(array->At(at), value, relation, back)) {
454             hit = at[zbDim];
455             if constexpr (WHICH == WhichLocation::Findloc) {
456               if (!back) {
457                 break;
458               }
459             }
460           }
461         }
462         resultIndices.emplace_back(hit);
463         at[zbDim] = std::max<ConstantSubscript>(dimLength, 1);
464         array->IncrementSubscripts(at);
465         at[zbDim] = 1;
466         if (mask) {
467           maskAt[zbDim] = mask->lbounds()[zbDim] +
468               std::max<ConstantSubscript>(dimLength, 1) - 1;
469           mask->IncrementSubscripts(maskAt);
470           maskAt[zbDim] = mask->lbounds()[zbDim];
471         }
472       }
473     } else { // no DIM=
474       resultShape = ConstantSubscripts{array->Rank()}; // always a vector
475       ConstantSubscript n{GetSize(array->shape())};
476       resultIndices = ConstantSubscripts(array->Rank(), 0);
477       for (ConstantSubscript j{0}; j < n; ++j, array->IncrementSubscripts(at),
478            mask && mask->IncrementSubscripts(maskAt)) {
479         if ((!mask || mask->At(maskAt).IsTrue()) &&
480             IsHit(array->At(at), value, relation, back)) {
481           resultIndices = at;
482           if constexpr (WHICH == WhichLocation::Findloc) {
483             if (!back) {
484               break;
485             }
486           }
487         }
488       }
489     }
490     std::vector<Scalar<SubscriptInteger>> resultElements;
491     for (ConstantSubscript j : resultIndices) {
492       resultElements.emplace_back(j);
493     }
494     return Constant<SubscriptInteger>{
495         std::move(resultElements), std::move(resultShape)};
496   }
497 
498 private:
499   template <typename T>
500   bool IsHit(typename Constant<T>::Element element,
501       std::optional<Constant<T>> &value,
502       [[maybe_unused]] RelationalOperator relation,
503       [[maybe_unused]] bool back) const {
504     std::optional<Expr<LogicalResult>> cmp;
505     bool result{true};
506     if (value) {
507       if constexpr (T::category == TypeCategory::Logical) {
508         // array(at) .EQV. value?
509         static_assert(WHICH == WhichLocation::Findloc);
510         cmp.emplace(ConvertToType<LogicalResult>(
511             Expr<T>{LogicalOperation<T::kind>{LogicalOperator::Eqv,
512                 Expr<T>{Constant<T>{element}}, Expr<T>{Constant<T>{*value}}}}));
513       } else { // compare array(at) to value
514         if constexpr (T::category == TypeCategory::Real &&
515             (WHICH == WhichLocation::Maxloc ||
516                 WHICH == WhichLocation::Minloc)) {
517           if (value && value->GetScalarValue().value().IsNotANumber() &&
518               (back || !element.IsNotANumber())) {
519             // Replace NaN
520             cmp.emplace(Constant<LogicalResult>{Scalar<LogicalResult>{true}});
521           }
522         }
523         if (!cmp) {
524           cmp.emplace(PackageRelation(relation, Expr<T>{Constant<T>{element}},
525               Expr<T>{Constant<T>{*value}}));
526         }
527       }
528       Expr<LogicalResult> folded{Fold(context_, std::move(*cmp))};
529       result = GetScalarConstantValue<LogicalResult>(folded).value().IsTrue();
530     } else {
531       // first unmasked element for MAXLOC/MINLOC - always take it
532     }
533     if constexpr (WHICH == WhichLocation::Maxloc ||
534         WHICH == WhichLocation::Minloc) {
535       if (result) {
536         value.emplace(std::move(element));
537       }
538     }
539     return result;
540   }
541 
542   static constexpr int dimArg{WHICH == WhichLocation::Findloc ? 2 : 1};
543   static constexpr int maskArg{dimArg + 1};
544   static constexpr int backArg{maskArg + 2};
545 
546   DynamicType type_;
547   ActualArguments &arg_;
548   FoldingContext &context_;
549 };
550 
551 template <WhichLocation which>
552 static std::optional<Constant<SubscriptInteger>> FoldLocationCall(
553     ActualArguments &arg, FoldingContext &context) {
554   if (arg[0]) {
555     if (auto type{arg[0]->GetType()}) {
556       if constexpr (which == WhichLocation::Findloc) {
557         // Both ARRAY and VALUE are susceptible to conversion to a common
558         // comparison type.
559         if (arg[1]) {
560           if (auto valType{arg[1]->GetType()}) {
561             if (auto compareType{ComparisonType(*type, *valType)}) {
562               type = compareType;
563             }
564           }
565         }
566       }
567       return common::SearchTypes(
568           LocationHelper<which>{std::move(*type), arg, context});
569     }
570   }
571   return std::nullopt;
572 }
573 
574 template <WhichLocation which, typename T>
575 static Expr<T> FoldLocation(FoldingContext &context, FunctionRef<T> &&ref) {
576   static_assert(T::category == TypeCategory::Integer);
577   if (std::optional<Constant<SubscriptInteger>> found{
578           FoldLocationCall<which>(ref.arguments(), context)}) {
579     return Expr<T>{Fold(
580         context, ConvertToType<T>(Expr<SubscriptInteger>{std::move(*found)}))};
581   } else {
582     return Expr<T>{std::move(ref)};
583   }
584 }
585 
586 // for IALL, IANY, & IPARITY
587 template <typename T>
588 static Expr<T> FoldBitReduction(FoldingContext &context, FunctionRef<T> &&ref,
589     Scalar<T> (Scalar<T>::*operation)(const Scalar<T> &) const,
590     Scalar<T> identity) {
591   static_assert(T::category == TypeCategory::Integer ||
592       T::category == TypeCategory::Unsigned);
593   std::optional<int> dim;
594   if (std::optional<ArrayAndMask<T>> arrayAndMask{
595           ProcessReductionArgs<T>(context, ref.arguments(), dim,
596               /*ARRAY=*/0, /*DIM=*/1, /*MASK=*/2)}) {
597     OperationAccumulator<T> accumulator{arrayAndMask->array, operation};
598     return Expr<T>{DoReduction<T>(
599         arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)};
600   }
601   return Expr<T>{std::move(ref)};
602 }
603 
604 // Common cases for INTEGER and UNSIGNED
605 template <typename T>
606 std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
607     FoldingContext &context, FunctionRef<T> &funcRef) {
608   ActualArguments &args{funcRef.arguments()};
609   auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
610   CHECK(intrinsic);
611   std::string name{intrinsic->name};
612   using Int4 = Type<TypeCategory::Integer, 4>;
613   if (name == "bit_size") {
614     return Expr<T>{Scalar<T>::bits};
615   } else if (name == "digits") {
616     if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
617       return Expr<T>{common::visit(
618           [](const auto &kx) {
619             return Scalar<ResultType<decltype(kx)>>::DIGITS;
620           },
621           cx->u)};
622     } else if (const auto *cx{UnwrapExpr<Expr<SomeUnsigned>>(args[0])}) {
623       return Expr<T>{common::visit(
624           [](const auto &kx) {
625             return Scalar<ResultType<decltype(kx)>>::DIGITS + 1;
626           },
627           cx->u)};
628     } else if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
629       return Expr<T>{common::visit(
630           [](const auto &kx) {
631             return Scalar<ResultType<decltype(kx)>>::DIGITS;
632           },
633           cx->u)};
634     } else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
635       return Expr<T>{common::visit(
636           [](const auto &kx) {
637             return Scalar<typename ResultType<decltype(kx)>::Part>::DIGITS;
638           },
639           cx->u)};
640     }
641   } else if (name == "dot_product") {
642     return FoldDotProduct<T>(context, std::move(funcRef));
643   } else if (name == "dshiftl" || name == "dshiftr") {
644     const auto fptr{
645         name == "dshiftl" ? &Scalar<T>::DSHIFTL : &Scalar<T>::DSHIFTR};
646     // Third argument can be of any kind. However, it must be smaller or equal
647     // than BIT_SIZE. It can be converted to Int4 to simplify.
648     if (const auto *argCon{Folder<T>(context).Folding(args[0])};
649         argCon && argCon->empty()) {
650     } else if (const auto *shiftCon{Folder<Int4>(context).Folding(args[2])}) {
651       for (const auto &scalar : shiftCon->values()) {
652         std::int64_t shiftVal{scalar.ToInt64()};
653         if (shiftVal < 0) {
654           context.messages().Say("SHIFT=%jd count for %s is negative"_err_en_US,
655               std::intmax_t{shiftVal}, name);
656           break;
657         } else if (shiftVal > T::Scalar::bits) {
658           context.messages().Say(
659               "SHIFT=%jd count for %s is greater than %d"_err_en_US,
660               std::intmax_t{shiftVal}, name, T::Scalar::bits);
661           break;
662         }
663       }
664     }
665     return FoldElementalIntrinsic<T, T, T, Int4>(context, std::move(funcRef),
666         ScalarFunc<T, T, T, Int4>(
667             [&fptr](const Scalar<T> &i, const Scalar<T> &j,
668                 const Scalar<Int4> &shift) -> Scalar<T> {
669               return std::invoke(fptr, i, j, static_cast<int>(shift.ToInt64()));
670             }));
671   } else if (name == "iand" || name == "ior" || name == "ieor") {
672     auto fptr{&Scalar<T>::IAND};
673     if (name == "iand") { // done in fptr declaration
674     } else if (name == "ior") {
675       fptr = &Scalar<T>::IOR;
676     } else if (name == "ieor") {
677       fptr = &Scalar<T>::IEOR;
678     } else {
679       common::die("missing case to fold intrinsic function %s", name.c_str());
680     }
681     return FoldElementalIntrinsic<T, T, T>(
682         context, std::move(funcRef), ScalarFunc<T, T, T>(fptr));
683   } else if (name == "iall") {
684     return FoldBitReduction(
685         context, std::move(funcRef), &Scalar<T>::IAND, Scalar<T>{}.NOT());
686   } else if (name == "iany") {
687     return FoldBitReduction(
688         context, std::move(funcRef), &Scalar<T>::IOR, Scalar<T>{});
689   } else if (name == "ibclr" || name == "ibset") {
690     // Second argument can be of any kind. However, it must be smaller
691     // than BIT_SIZE. It can be converted to Int4 to simplify.
692     auto fptr{&Scalar<T>::IBCLR};
693     if (name == "ibclr") { // done in fptr definition
694     } else if (name == "ibset") {
695       fptr = &Scalar<T>::IBSET;
696     } else {
697       common::die("missing case to fold intrinsic function %s", name.c_str());
698     }
699     if (const auto *argCon{Folder<T>(context).Folding(args[0])};
700         argCon && argCon->empty()) {
701     } else if (const auto *posCon{Folder<Int4>(context).Folding(args[1])}) {
702       for (const auto &scalar : posCon->values()) {
703         std::int64_t posVal{scalar.ToInt64()};
704         if (posVal < 0) {
705           context.messages().Say(
706               "bit position for %s (%jd) is negative"_err_en_US, name,
707               std::intmax_t{posVal});
708           break;
709         } else if (posVal >= T::Scalar::bits) {
710           context.messages().Say(
711               "bit position for %s (%jd) is not less than %d"_err_en_US, name,
712               std::intmax_t{posVal}, T::Scalar::bits);
713           break;
714         }
715       }
716     }
717     return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
718         ScalarFunc<T, T, Int4>(
719             [&](const Scalar<T> &i, const Scalar<Int4> &pos) -> Scalar<T> {
720               return std::invoke(fptr, i, static_cast<int>(pos.ToInt64()));
721             }));
722   } else if (name == "ibits") {
723     const auto *posCon{Folder<Int4>(context).Folding(args[1])};
724     const auto *lenCon{Folder<Int4>(context).Folding(args[2])};
725     if (const auto *argCon{Folder<T>(context).Folding(args[0])};
726         argCon && argCon->empty()) {
727     } else {
728       std::size_t posCt{posCon ? posCon->size() : 0};
729       std::size_t lenCt{lenCon ? lenCon->size() : 0};
730       std::size_t n{std::max(posCt, lenCt)};
731       for (std::size_t j{0}; j < n; ++j) {
732         int posVal{j < posCt || posCt == 1
733                 ? static_cast<int>(posCon->values()[j % posCt].ToInt64())
734                 : 0};
735         int lenVal{j < lenCt || lenCt == 1
736                 ? static_cast<int>(lenCon->values()[j % lenCt].ToInt64())
737                 : 0};
738         if (posVal < 0) {
739           context.messages().Say(
740               "bit position for IBITS(POS=%jd) is negative"_err_en_US,
741               std::intmax_t{posVal});
742           break;
743         } else if (lenVal < 0) {
744           context.messages().Say(
745               "bit length for IBITS(LEN=%jd) is negative"_err_en_US,
746               std::intmax_t{lenVal});
747           break;
748         } else if (posVal + lenVal > T::Scalar::bits) {
749           context.messages().Say(
750               "IBITS() must have POS+LEN (>=%jd) no greater than %d"_err_en_US,
751               std::intmax_t{posVal + lenVal}, T::Scalar::bits);
752           break;
753         }
754       }
755     }
756     return FoldElementalIntrinsic<T, T, Int4, Int4>(context, std::move(funcRef),
757         ScalarFunc<T, T, Int4, Int4>(
758             [&](const Scalar<T> &i, const Scalar<Int4> &pos,
759                 const Scalar<Int4> &len) -> Scalar<T> {
760               return i.IBITS(static_cast<int>(pos.ToInt64()),
761                   static_cast<int>(len.ToInt64()));
762             }));
763   } else if (name == "int" || name == "int2" || name == "int8" ||
764       name == "uint") {
765     if (auto *expr{UnwrapExpr<Expr<SomeType>>(args[0])}) {
766       return common::visit(
767           [&](auto &&x) -> Expr<T> {
768             using From = std::decay_t<decltype(x)>;
769             if constexpr (std::is_same_v<From, BOZLiteralConstant> ||
770                 IsNumericCategoryExpr<From>()) {
771               return Fold(context, ConvertToType<T>(std::move(x)));
772             }
773             DIE("int() argument type not valid");
774           },
775           std::move(expr->u));
776     }
777   } else if (name == "iparity") {
778     return FoldBitReduction(
779         context, std::move(funcRef), &Scalar<T>::IEOR, Scalar<T>{});
780   } else if (name == "ishft" || name == "ishftc") {
781     const auto *argCon{Folder<T>(context).Folding(args[0])};
782     const auto *shiftCon{Folder<Int4>(context).Folding(args[1])};
783     const auto *shiftVals{shiftCon ? &shiftCon->values() : nullptr};
784     const auto *sizeCon{args.size() == 3
785             ? Folder<Int4>{context, /*forOptionalArgument=*/true}.Folding(
786                   args[2])
787             : nullptr};
788     const auto *sizeVals{sizeCon ? &sizeCon->values() : nullptr};
789     if ((argCon && argCon->empty()) || !shiftVals || shiftVals->empty() ||
790         (sizeVals && sizeVals->empty())) {
791       // size= and shift= values don't need to be checked
792     } else {
793       for (const auto &scalar : *shiftVals) {
794         std::int64_t shiftVal{scalar.ToInt64()};
795         if (shiftVal < -T::Scalar::bits) {
796           context.messages().Say(
797               "SHIFT=%jd count for %s is less than %d"_err_en_US,
798               std::intmax_t{shiftVal}, name, -T::Scalar::bits);
799           break;
800         } else if (shiftVal > T::Scalar::bits) {
801           context.messages().Say(
802               "SHIFT=%jd count for %s is greater than %d"_err_en_US,
803               std::intmax_t{shiftVal}, name, T::Scalar::bits);
804           break;
805         }
806       }
807       if (sizeVals) {
808         for (const auto &scalar : *sizeVals) {
809           std::int64_t sizeVal{scalar.ToInt64()};
810           if (sizeVal <= 0) {
811             context.messages().Say(
812                 "SIZE=%jd count for ishftc is not positive"_err_en_US,
813                 std::intmax_t{sizeVal}, name);
814             break;
815           } else if (sizeVal > T::Scalar::bits) {
816             context.messages().Say(
817                 "SIZE=%jd count for ishftc is greater than %d"_err_en_US,
818                 std::intmax_t{sizeVal}, T::Scalar::bits);
819             break;
820           }
821         }
822         if (shiftVals->size() == 1 || sizeVals->size() == 1 ||
823             shiftVals->size() == sizeVals->size()) {
824           auto iters{std::max(shiftVals->size(), sizeVals->size())};
825           for (std::size_t j{0}; j < iters; ++j) {
826             auto shiftVal{static_cast<int>(
827                 (*shiftVals)[j % shiftVals->size()].ToInt64())};
828             auto sizeVal{
829                 static_cast<int>((*sizeVals)[j % sizeVals->size()].ToInt64())};
830             if (sizeVal > 0 && std::abs(shiftVal) > sizeVal) {
831               context.messages().Say(
832                   "SHIFT=%jd count for ishftc is greater in magnitude than SIZE=%jd"_err_en_US,
833                   std::intmax_t{shiftVal}, std::intmax_t{sizeVal});
834               break;
835             }
836           }
837         }
838       }
839     }
840     if (name == "ishft") {
841       return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
842           ScalarFunc<T, T, Int4>(
843               [&](const Scalar<T> &i, const Scalar<Int4> &shift) -> Scalar<T> {
844                 return i.ISHFT(static_cast<int>(shift.ToInt64()));
845               }));
846     } else if (!args.at(2)) { // ISHFTC(no SIZE=)
847       return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
848           ScalarFunc<T, T, Int4>(
849               [&](const Scalar<T> &i, const Scalar<Int4> &shift) -> Scalar<T> {
850                 return i.ISHFTC(static_cast<int>(shift.ToInt64()));
851               }));
852     } else { // ISHFTC(with SIZE=)
853       return FoldElementalIntrinsic<T, T, Int4, Int4>(context,
854           std::move(funcRef),
855           ScalarFunc<T, T, Int4, Int4>(
856               [&](const Scalar<T> &i, const Scalar<Int4> &shift,
857                   const Scalar<Int4> &size) -> Scalar<T> {
858                 auto shiftVal{static_cast<int>(shift.ToInt64())};
859                 auto sizeVal{static_cast<int>(size.ToInt64())};
860                 return i.ISHFTC(shiftVal, sizeVal);
861               }),
862           /*hasOptionalArgument=*/true);
863     }
864   } else if (name == "izext" || name == "jzext") {
865     if (args.size() == 1) {
866       if (auto *expr{UnwrapExpr<Expr<SomeKind<T::category>>>(args[0])}) {
867         // Rewrite to IAND(INT(n,k),255_k) for k=KIND(T)
868         intrinsic->name = "iand";
869         auto converted{ConvertToType<T>(std::move(*expr))};
870         *expr =
871             Fold(context, Expr<SomeKind<T::category>>{std::move(converted)});
872         args.emplace_back(AsGenericExpr(Expr<T>{Scalar<T>{255}}));
873         return FoldIntrinsicFunction(context, std::move(funcRef));
874       }
875     }
876   } else if (name == "maskl" || name == "maskr" || name == "umaskl" ||
877       name == "umaskr") {
878     // Argument can be of any kind but value has to be smaller than BIT_SIZE.
879     // It can be safely converted to Int4 to simplify.
880     const auto fptr{name == "maskl" || name == "umaskl" ? &Scalar<T>::MASKL
881                                                         : &Scalar<T>::MASKR};
882     return FoldElementalIntrinsic<T, Int4>(context, std::move(funcRef),
883         ScalarFunc<T, Int4>([&fptr](const Scalar<Int4> &places) -> Scalar<T> {
884           return fptr(static_cast<int>(places.ToInt64()));
885         }));
886   } else if (name == "matmul") {
887     return FoldMatmul(context, std::move(funcRef));
888   } else if (name == "max") {
889     return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
890   } else if (name == "maxval") {
891     return FoldMaxvalMinval<T>(context, std::move(funcRef),
892         RelationalOperator::GT,
893         T::category == TypeCategory::Unsigned ? typename T::Scalar{}
894                                               : T::Scalar::Least());
895   } else if (name == "merge_bits") {
896     return FoldElementalIntrinsic<T, T, T, T>(
897         context, std::move(funcRef), &Scalar<T>::MERGE_BITS);
898   } else if (name == "min") {
899     return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
900   } else if (name == "minval") {
901     return FoldMaxvalMinval<T>(context, std::move(funcRef),
902         RelationalOperator::LT,
903         T::category == TypeCategory::Unsigned ? typename T::Scalar{}.NOT()
904                                               : T::Scalar::HUGE());
905   } else if (name == "not") {
906     return FoldElementalIntrinsic<T, T>(
907         context, std::move(funcRef), &Scalar<T>::NOT);
908   } else if (name == "product") {
909     return FoldProduct<T>(context, std::move(funcRef), Scalar<T>{1});
910   } else if (name == "radix") {
911     return Expr<T>{2};
912   } else if (name == "shifta" || name == "shiftr" || name == "shiftl") {
913     // Second argument can be of any kind. However, it must be smaller or
914     // equal than BIT_SIZE. It can be converted to Int4 to simplify.
915     auto fptr{&Scalar<T>::SHIFTA};
916     if (name == "shifta") { // done in fptr definition
917     } else if (name == "shiftr") {
918       fptr = &Scalar<T>::SHIFTR;
919     } else if (name == "shiftl") {
920       fptr = &Scalar<T>::SHIFTL;
921     } else {
922       common::die("missing case to fold intrinsic function %s", name.c_str());
923     }
924     if (const auto *argCon{Folder<T>(context).Folding(args[0])};
925         argCon && argCon->empty()) {
926     } else if (const auto *shiftCon{Folder<Int4>(context).Folding(args[1])}) {
927       for (const auto &scalar : shiftCon->values()) {
928         std::int64_t shiftVal{scalar.ToInt64()};
929         if (shiftVal < 0) {
930           context.messages().Say("SHIFT=%jd count for %s is negative"_err_en_US,
931               std::intmax_t{shiftVal}, name, -T::Scalar::bits);
932           break;
933         } else if (shiftVal > T::Scalar::bits) {
934           context.messages().Say(
935               "SHIFT=%jd count for %s is greater than %d"_err_en_US,
936               std::intmax_t{shiftVal}, name, T::Scalar::bits);
937           break;
938         }
939       }
940     }
941     return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
942         ScalarFunc<T, T, Int4>(
943             [&](const Scalar<T> &i, const Scalar<Int4> &shift) -> Scalar<T> {
944               return std::invoke(fptr, i, static_cast<int>(shift.ToInt64()));
945             }));
946   } else if (name == "sum") {
947     return FoldSum<T>(context, std::move(funcRef));
948   }
949   return std::nullopt;
950 }
951 
952 template <int KIND>
953 Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
954     FoldingContext &context,
955     FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
956   if (auto foldedCommon{FoldIntrinsicFunctionCommon(context, funcRef)}) {
957     return std::move(*foldedCommon);
958   }
959 
960   using T = Type<TypeCategory::Integer, KIND>;
961   ActualArguments &args{funcRef.arguments()};
962   auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
963   CHECK(intrinsic);
964   std::string name{intrinsic->name};
965 
966   auto FromInt64{[&name, &context](std::int64_t n) {
967     Scalar<T> result{n};
968     if (result.ToInt64() != n &&
969         context.languageFeatures().ShouldWarn(
970             common::UsageWarning::FoldingException)) {
971       context.messages().Say(common::UsageWarning::FoldingException,
972           "Result of intrinsic function '%s' (%jd) overflows its result type"_warn_en_US,
973           name, std::intmax_t{n});
974     }
975     return result;
976   }};
977 
978   if (name == "abs") { // incl. babs, iiabs, jiaabs, & kiabs
979     return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
980         ScalarFunc<T, T>([&context](const Scalar<T> &i) -> Scalar<T> {
981           typename Scalar<T>::ValueWithOverflow j{i.ABS()};
982           if (j.overflow &&
983               context.languageFeatures().ShouldWarn(
984                   common::UsageWarning::FoldingException)) {
985             context.messages().Say(common::UsageWarning::FoldingException,
986                 "abs(integer(kind=%d)) folding overflowed"_warn_en_US, KIND);
987           }
988           return j.value;
989         }));
990   } else if (name == "ceiling" || name == "floor" || name == "nint") {
991     if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
992       // NINT rounds ties away from zero, not to even
993       common::RoundingMode mode{name == "ceiling" ? common::RoundingMode::Up
994               : name == "floor"                   ? common::RoundingMode::Down
995                                 : common::RoundingMode::TiesAwayFromZero};
996       return common::visit(
997           [&](const auto &kx) {
998             using TR = ResultType<decltype(kx)>;
999             return FoldElementalIntrinsic<T, TR>(context, std::move(funcRef),
1000                 ScalarFunc<T, TR>([&](const Scalar<TR> &x) {
1001                   auto y{x.template ToInteger<Scalar<T>>(mode)};
1002                   if (y.flags.test(RealFlag::Overflow) &&
1003                       context.languageFeatures().ShouldWarn(
1004                           common::UsageWarning::FoldingException)) {
1005                     context.messages().Say(
1006                         common::UsageWarning::FoldingException,
1007                         "%s intrinsic folding overflow"_warn_en_US, name);
1008                   }
1009                   return y.value;
1010                 }));
1011           },
1012           cx->u);
1013     }
1014   } else if (name == "count") {
1015     int maskKind = args[0]->GetType()->kind();
1016     switch (maskKind) {
1017       SWITCH_COVERS_ALL_CASES
1018     case 1:
1019       return FoldCount<T, 1>(context, std::move(funcRef));
1020     case 2:
1021       return FoldCount<T, 2>(context, std::move(funcRef));
1022     case 4:
1023       return FoldCount<T, 4>(context, std::move(funcRef));
1024     case 8:
1025       return FoldCount<T, 8>(context, std::move(funcRef));
1026     }
1027   } else if (name == "dim") {
1028     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
1029         ScalarFunc<T, T, T>(
1030             [&context](const Scalar<T> &x, const Scalar<T> &y) -> Scalar<T> {
1031               auto result{x.DIM(y)};
1032               if (result.overflow &&
1033                   context.languageFeatures().ShouldWarn(
1034                       common::UsageWarning::FoldingException)) {
1035                 context.messages().Say(common::UsageWarning::FoldingException,
1036                     "DIM intrinsic folding overflow"_warn_en_US);
1037               }
1038               return result.value;
1039             }));
1040   } else if (name == "exponent") {
1041     if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
1042       return common::visit(
1043           [&funcRef, &context](const auto &x) -> Expr<T> {
1044             using TR = typename std::decay_t<decltype(x)>::Result;
1045             return FoldElementalIntrinsic<T, TR>(context, std::move(funcRef),
1046                 &Scalar<TR>::template EXPONENT<Scalar<T>>);
1047           },
1048           sx->u);
1049     } else {
1050       DIE("exponent argument must be real");
1051     }
1052   } else if (name == "findloc") {
1053     return FoldLocation<WhichLocation::Findloc, T>(context, std::move(funcRef));
1054   } else if (name == "huge") {
1055     return Expr<T>{Scalar<T>::HUGE()};
1056   } else if (name == "iachar" || name == "ichar") {
1057     auto *someChar{UnwrapExpr<Expr<SomeCharacter>>(args[0])};
1058     CHECK(someChar);
1059     if (auto len{ToInt64(someChar->LEN())}) {
1060       if (len.value() < 1) {
1061         context.messages().Say(
1062             "Character in intrinsic function %s must have length one"_err_en_US,
1063             name);
1064       } else if (len.value() > 1 &&
1065           context.languageFeatures().ShouldWarn(
1066               common::UsageWarning::Portability)) {
1067         // Do not die, this was not checked before
1068         context.messages().Say(common::UsageWarning::Portability,
1069             "Character in intrinsic function %s should have length one"_port_en_US,
1070             name);
1071       } else {
1072         return common::visit(
1073             [&funcRef, &context, &FromInt64](const auto &str) -> Expr<T> {
1074               using Char = typename std::decay_t<decltype(str)>::Result;
1075               (void)FromInt64;
1076               return FoldElementalIntrinsic<T, Char>(context,
1077                   std::move(funcRef),
1078                   ScalarFunc<T, Char>(
1079 #ifndef _MSC_VER
1080                       [&FromInt64](const Scalar<Char> &c) {
1081                         return FromInt64(CharacterUtils<Char::kind>::ICHAR(
1082                             CharacterUtils<Char::kind>::Resize(c, 1)));
1083                       }));
1084 #else // _MSC_VER
1085       // MSVC 14 get confused by the original code above and
1086       // ends up emitting an error about passing a std::string
1087       // to the std::u16string instantiation of
1088       // CharacterUtils<2>::ICHAR(). Can't find a work-around,
1089       // so remove the FromInt64 error checking lambda that
1090       // seems to have caused the proble.
1091                       [](const Scalar<Char> &c) {
1092                         return CharacterUtils<Char::kind>::ICHAR(
1093                             CharacterUtils<Char::kind>::Resize(c, 1));
1094                       }));
1095 #endif // _MSC_VER
1096             },
1097             someChar->u);
1098       }
1099     }
1100   } else if (name == "index" || name == "scan" || name == "verify") {
1101     if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
1102       return common::visit(
1103           [&](const auto &kch) -> Expr<T> {
1104             using TC = typename std::decay_t<decltype(kch)>::Result;
1105             if (UnwrapExpr<Expr<SomeLogical>>(args[2])) { // BACK=
1106               return FoldElementalIntrinsic<T, TC, TC, LogicalResult>(context,
1107                   std::move(funcRef),
1108                   ScalarFunc<T, TC, TC, LogicalResult>{
1109                       [&name, &FromInt64](const Scalar<TC> &str,
1110                           const Scalar<TC> &other,
1111                           const Scalar<LogicalResult> &back) {
1112                         return FromInt64(name == "index"
1113                                 ? CharacterUtils<TC::kind>::INDEX(
1114                                       str, other, back.IsTrue())
1115                                 : name == "scan"
1116                                 ? CharacterUtils<TC::kind>::SCAN(
1117                                       str, other, back.IsTrue())
1118                                 : CharacterUtils<TC::kind>::VERIFY(
1119                                       str, other, back.IsTrue()));
1120                       }});
1121             } else {
1122               return FoldElementalIntrinsic<T, TC, TC>(context,
1123                   std::move(funcRef),
1124                   ScalarFunc<T, TC, TC>{
1125                       [&name, &FromInt64](
1126                           const Scalar<TC> &str, const Scalar<TC> &other) {
1127                         return FromInt64(name == "index"
1128                                 ? CharacterUtils<TC::kind>::INDEX(str, other)
1129                                 : name == "scan"
1130                                 ? CharacterUtils<TC::kind>::SCAN(str, other)
1131                                 : CharacterUtils<TC::kind>::VERIFY(str, other));
1132                       }});
1133             }
1134           },
1135           charExpr->u);
1136     } else {
1137       DIE("first argument must be CHARACTER");
1138     }
1139   } else if (name == "int_ptr_kind") {
1140     return Expr<T>{8};
1141   } else if (name == "kind") {
1142     // FoldOperation(FunctionRef &&) in fold-implementation.h will not
1143     // have folded the argument; in the case of TypeParamInquiry,
1144     // try to get the type of the parameter itself.
1145     if (const auto *expr{args[0] ? args[0]->UnwrapExpr() : nullptr}) {
1146       if (const auto *inquiry{UnwrapExpr<TypeParamInquiry>(*expr)}) {
1147         if (const auto *typeSpec{inquiry->parameter().GetType()}) {
1148           if (const auto *intrinType{typeSpec->AsIntrinsic()}) {
1149             if (auto k{ToInt64(Fold(
1150                     context, Expr<SubscriptInteger>{intrinType->kind()}))}) {
1151               return Expr<T>{*k};
1152             }
1153           }
1154         }
1155       } else if (auto dyType{expr->GetType()}) {
1156         return Expr<T>{dyType->kind()};
1157       }
1158     }
1159   } else if (name == "lbound") {
1160     return LBOUND(context, std::move(funcRef));
1161   } else if (name == "lcobound") {
1162     return COBOUND(context, std::move(funcRef), /*isUCOBOUND=*/false);
1163   } else if (name == "leadz" || name == "trailz" || name == "poppar" ||
1164       name == "popcnt") {
1165     if (auto *sn{UnwrapExpr<Expr<SomeKind<T::category>>>(args[0])}) {
1166       return common::visit(
1167           [&funcRef, &context, &name](const auto &n) -> Expr<T> {
1168             using TI = typename std::decay_t<decltype(n)>::Result;
1169             if (name == "poppar") {
1170               return FoldElementalIntrinsic<T, TI>(context, std::move(funcRef),
1171                   ScalarFunc<T, TI>([](const Scalar<TI> &i) -> Scalar<T> {
1172                     return Scalar<T>{i.POPPAR() ? 1 : 0};
1173                   }));
1174             }
1175             auto fptr{&Scalar<TI>::LEADZ};
1176             if (name == "leadz") { // done in fptr definition
1177             } else if (name == "trailz") {
1178               fptr = &Scalar<TI>::TRAILZ;
1179             } else if (name == "popcnt") {
1180               fptr = &Scalar<TI>::POPCNT;
1181             } else {
1182               common::die(
1183                   "missing case to fold intrinsic function %s", name.c_str());
1184             }
1185             return FoldElementalIntrinsic<T, TI>(context, std::move(funcRef),
1186                 // `i` should be declared as `const Scalar<TI>&`.
1187                 // We declare it as `auto` to workaround an msvc bug:
1188                 // https://developercommunity.visualstudio.com/t/Regression:-nested-closure-assumes-wrong/10130223
1189                 ScalarFunc<T, TI>([&fptr](const auto &i) -> Scalar<T> {
1190                   return Scalar<T>{std::invoke(fptr, i)};
1191                 }));
1192           },
1193           sn->u);
1194     } else {
1195       DIE("leadz argument must be integer");
1196     }
1197   } else if (name == "len") {
1198     if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
1199       return common::visit(
1200           [&](auto &kx) {
1201             if (auto len{kx.LEN()}) {
1202               if (IsScopeInvariantExpr(*len)) {
1203                 return Fold(context, ConvertToType<T>(*std::move(len)));
1204               } else {
1205                 return Expr<T>{std::move(funcRef)};
1206               }
1207             } else {
1208               return Expr<T>{std::move(funcRef)};
1209             }
1210           },
1211           charExpr->u);
1212     } else {
1213       DIE("len() argument must be of character type");
1214     }
1215   } else if (name == "len_trim") {
1216     if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
1217       return common::visit(
1218           [&](const auto &kch) -> Expr<T> {
1219             using TC = typename std::decay_t<decltype(kch)>::Result;
1220             return FoldElementalIntrinsic<T, TC>(context, std::move(funcRef),
1221                 ScalarFunc<T, TC>{[&FromInt64](const Scalar<TC> &str) {
1222                   return FromInt64(CharacterUtils<TC::kind>::LEN_TRIM(str));
1223                 }});
1224           },
1225           charExpr->u);
1226     } else {
1227       DIE("len_trim() argument must be of character type");
1228     }
1229   } else if (name == "max0" || name == "max1") {
1230     return RewriteSpecificMINorMAX(context, std::move(funcRef));
1231   } else if (name == "maxexponent") {
1232     if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
1233       return common::visit(
1234           [](const auto &x) {
1235             using TR = typename std::decay_t<decltype(x)>::Result;
1236             return Expr<T>{Scalar<TR>::MAXEXPONENT};
1237           },
1238           sx->u);
1239     }
1240   } else if (name == "maxloc") {
1241     return FoldLocation<WhichLocation::Maxloc, T>(context, std::move(funcRef));
1242   } else if (name == "min0" || name == "min1") {
1243     return RewriteSpecificMINorMAX(context, std::move(funcRef));
1244   } else if (name == "minexponent") {
1245     if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
1246       return common::visit(
1247           [](const auto &x) {
1248             using TR = typename std::decay_t<decltype(x)>::Result;
1249             return Expr<T>{Scalar<TR>::MINEXPONENT};
1250           },
1251           sx->u);
1252     }
1253   } else if (name == "minloc") {
1254     return FoldLocation<WhichLocation::Minloc, T>(context, std::move(funcRef));
1255   } else if (name == "mod") {
1256     bool badPConst{false};
1257     if (auto *pExpr{UnwrapExpr<Expr<T>>(args[1])}) {
1258       *pExpr = Fold(context, std::move(*pExpr));
1259       if (auto pConst{GetScalarConstantValue<T>(*pExpr)}; pConst &&
1260           pConst->IsZero() &&
1261           context.languageFeatures().ShouldWarn(
1262               common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
1263         context.messages().Say(common::UsageWarning::FoldingAvoidsRuntimeCrash,
1264             "MOD: P argument is zero"_warn_en_US);
1265         badPConst = true;
1266       }
1267     }
1268     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
1269         ScalarFuncWithContext<T, T, T>(
1270             [badPConst](FoldingContext &context, const Scalar<T> &x,
1271                 const Scalar<T> &y) -> Scalar<T> {
1272               auto quotRem{x.DivideSigned(y)};
1273               if (context.languageFeatures().ShouldWarn(
1274                       common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
1275                 if (!badPConst && quotRem.divisionByZero) {
1276                   context.messages().Say(
1277                       common::UsageWarning::FoldingAvoidsRuntimeCrash,
1278                       "mod() by zero"_warn_en_US);
1279                 } else if (quotRem.overflow) {
1280                   context.messages().Say(
1281                       common::UsageWarning::FoldingAvoidsRuntimeCrash,
1282                       "mod() folding overflowed"_warn_en_US);
1283                 }
1284               }
1285               return quotRem.remainder;
1286             }));
1287   } else if (name == "modulo") {
1288     bool badPConst{false};
1289     if (auto *pExpr{UnwrapExpr<Expr<T>>(args[1])}) {
1290       *pExpr = Fold(context, std::move(*pExpr));
1291       if (auto pConst{GetScalarConstantValue<T>(*pExpr)}; pConst &&
1292           pConst->IsZero() &&
1293           context.languageFeatures().ShouldWarn(
1294               common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
1295         context.messages().Say(common::UsageWarning::FoldingAvoidsRuntimeCrash,
1296             "MODULO: P argument is zero"_warn_en_US);
1297         badPConst = true;
1298       }
1299     }
1300     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
1301         ScalarFuncWithContext<T, T, T>([badPConst](FoldingContext &context,
1302                                            const Scalar<T> &x,
1303                                            const Scalar<T> &y) -> Scalar<T> {
1304           auto result{x.MODULO(y)};
1305           if (!badPConst && result.overflow &&
1306               context.languageFeatures().ShouldWarn(
1307                   common::UsageWarning::FoldingException)) {
1308             context.messages().Say(common::UsageWarning::FoldingException,
1309                 "modulo() folding overflowed"_warn_en_US);
1310           }
1311           return result.value;
1312         }));
1313   } else if (name == "precision") {
1314     if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
1315       return Expr<T>{common::visit(
1316           [](const auto &kx) {
1317             return Scalar<ResultType<decltype(kx)>>::PRECISION;
1318           },
1319           cx->u)};
1320     } else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
1321       return Expr<T>{common::visit(
1322           [](const auto &kx) {
1323             return Scalar<typename ResultType<decltype(kx)>::Part>::PRECISION;
1324           },
1325           cx->u)};
1326     }
1327   } else if (name == "range") {
1328     if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
1329       return Expr<T>{common::visit(
1330           [](const auto &kx) {
1331             return Scalar<ResultType<decltype(kx)>>::RANGE;
1332           },
1333           cx->u)};
1334     } else if (const auto *cx{UnwrapExpr<Expr<SomeUnsigned>>(args[0])}) {
1335       return Expr<T>{common::visit(
1336           [](const auto &kx) {
1337             return Scalar<ResultType<decltype(kx)>>::UnsignedRANGE;
1338           },
1339           cx->u)};
1340     } else if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
1341       return Expr<T>{common::visit(
1342           [](const auto &kx) {
1343             return Scalar<ResultType<decltype(kx)>>::RANGE;
1344           },
1345           cx->u)};
1346     } else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
1347       return Expr<T>{common::visit(
1348           [](const auto &kx) {
1349             return Scalar<typename ResultType<decltype(kx)>::Part>::RANGE;
1350           },
1351           cx->u)};
1352     }
1353   } else if (name == "rank") {
1354     if (args[0]) {
1355       const Symbol *symbol{nullptr};
1356       if (auto dataRef{ExtractDataRef(args[0])}) {
1357         symbol = &dataRef->GetLastSymbol();
1358       } else {
1359         symbol = args[0]->GetAssumedTypeDummy();
1360       }
1361       if (symbol && IsAssumedRank(*symbol)) {
1362         // DescriptorInquiry can only be placed in expression of kind
1363         // DescriptorInquiry::Result::kind.
1364         return ConvertToType<T>(
1365             Expr<Type<TypeCategory::Integer, DescriptorInquiry::Result::kind>>{
1366                 DescriptorInquiry{
1367                     NamedEntity{*symbol}, DescriptorInquiry::Field::Rank}});
1368       }
1369       return Expr<T>{args[0]->Rank()};
1370     }
1371   } else if (name == "selected_char_kind") {
1372     if (const auto *chCon{UnwrapExpr<Constant<TypeOf<std::string>>>(args[0])}) {
1373       if (std::optional<std::string> value{chCon->GetScalarValue()}) {
1374         int defaultKind{
1375             context.defaults().GetDefaultKind(TypeCategory::Character)};
1376         return Expr<T>{SelectedCharKind(*value, defaultKind)};
1377       }
1378     }
1379   } else if (name == "selected_int_kind" || name == "selected_unsigned_kind") {
1380     if (auto p{ToInt64(args[0])}) {
1381       return Expr<T>{context.targetCharacteristics().SelectedIntKind(*p)};
1382     }
1383   } else if (name == "selected_logical_kind") {
1384     if (auto p{ToInt64(args[0])}) {
1385       return Expr<T>{context.targetCharacteristics().SelectedLogicalKind(*p)};
1386     }
1387   } else if (name == "selected_real_kind" ||
1388       name == "__builtin_ieee_selected_real_kind") {
1389     if (auto p{GetInt64ArgOr(args[0], 0)}) {
1390       if (auto r{GetInt64ArgOr(args[1], 0)}) {
1391         if (auto radix{GetInt64ArgOr(args[2], 2)}) {
1392           return Expr<T>{
1393               context.targetCharacteristics().SelectedRealKind(*p, *r, *radix)};
1394         }
1395       }
1396     }
1397   } else if (name == "shape") {
1398     if (auto shape{GetContextFreeShape(context, args[0])}) {
1399       if (auto shapeExpr{AsExtentArrayExpr(*shape)}) {
1400         return Fold(context, ConvertToType<T>(std::move(*shapeExpr)));
1401       }
1402     }
1403   } else if (name == "sign") {
1404     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
1405         ScalarFunc<T, T, T>([&context](const Scalar<T> &j,
1406                                 const Scalar<T> &k) -> Scalar<T> {
1407           typename Scalar<T>::ValueWithOverflow result{j.SIGN(k)};
1408           if (result.overflow &&
1409               context.languageFeatures().ShouldWarn(
1410                   common::UsageWarning::FoldingException)) {
1411             context.messages().Say(common::UsageWarning::FoldingException,
1412                 "sign(integer(kind=%d)) folding overflowed"_warn_en_US, KIND);
1413           }
1414           return result.value;
1415         }));
1416   } else if (name == "size") {
1417     if (auto shape{GetContextFreeShape(context, args[0])}) {
1418       if (args[1]) { // DIM= is present, get one extent
1419         std::optional<int> dim;
1420         if (const auto *array{args[0].value().UnwrapExpr()}; array &&
1421             !CheckDimArg(args[1], *array, context.messages(), false, dim)) {
1422           return MakeInvalidIntrinsic<T>(std::move(funcRef));
1423         } else if (dim) {
1424           if (auto &extent{shape->at(*dim)}) {
1425             return Fold(context, ConvertToType<T>(std::move(*extent)));
1426           }
1427         }
1428       } else if (auto extents{common::AllElementsPresent(std::move(*shape))}) {
1429         // DIM= is absent; compute PRODUCT(SHAPE())
1430         ExtentExpr product{1};
1431         for (auto &&extent : std::move(*extents)) {
1432           product = std::move(product) * std::move(extent);
1433         }
1434         return Expr<T>{ConvertToType<T>(Fold(context, std::move(product)))};
1435       }
1436     }
1437   } else if (name == "sizeof") { // in bytes; extension
1438     if (auto info{
1439             characteristics::TypeAndShape::Characterize(args[0], context)}) {
1440       if (auto bytes{info->MeasureSizeInBytes(context)}) {
1441         return Expr<T>{Fold(context, ConvertToType<T>(std::move(*bytes)))};
1442       }
1443     }
1444   } else if (name == "storage_size") { // in bits
1445     if (auto info{
1446             characteristics::TypeAndShape::Characterize(args[0], context)}) {
1447       if (auto bytes{info->MeasureElementSizeInBytes(context, true)}) {
1448         return Expr<T>{
1449             Fold(context, Expr<T>{8} * ConvertToType<T>(std::move(*bytes)))};
1450       }
1451     }
1452   } else if (name == "ubound") {
1453     return UBOUND(context, std::move(funcRef));
1454   } else if (name == "ucobound") {
1455     return COBOUND(context, std::move(funcRef), /*isUCOBOUND=*/true);
1456   } else if (name == "__builtin_numeric_storage_size") {
1457     if (!context.moduleFileName()) {
1458       // Don't fold this reference until it appears in the module file
1459       // for ISO_FORTRAN_ENV -- the value depends on the compiler options
1460       // that might be in force.
1461     } else {
1462       auto intBytes{
1463           context.targetCharacteristics().GetByteSize(TypeCategory::Integer,
1464               context.defaults().GetDefaultKind(TypeCategory::Integer))};
1465       auto realBytes{
1466           context.targetCharacteristics().GetByteSize(TypeCategory::Real,
1467               context.defaults().GetDefaultKind(TypeCategory::Real))};
1468       if (intBytes != realBytes &&
1469           context.languageFeatures().ShouldWarn(
1470               common::UsageWarning::FoldingValueChecks)) {
1471         context.messages().Say(common::UsageWarning::FoldingValueChecks,
1472             *context.moduleFileName(),
1473             "NUMERIC_STORAGE_SIZE from ISO_FORTRAN_ENV is not well-defined when default INTEGER and REAL are not consistent due to compiler options"_warn_en_US);
1474       }
1475       return Expr<T>{8 * std::min(intBytes, realBytes)};
1476     }
1477   }
1478   return Expr<T>{std::move(funcRef)};
1479 }
1480 
1481 template <int KIND>
1482 Expr<Type<TypeCategory::Unsigned, KIND>> FoldIntrinsicFunction(
1483     FoldingContext &context,
1484     FunctionRef<Type<TypeCategory::Unsigned, KIND>> &&funcRef) {
1485   if (auto foldedCommon{FoldIntrinsicFunctionCommon(context, funcRef)}) {
1486     return std::move(*foldedCommon);
1487   }
1488   using T = Type<TypeCategory::Unsigned, KIND>;
1489   ActualArguments &args{funcRef.arguments()};
1490   auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
1491   CHECK(intrinsic);
1492   std::string name{intrinsic->name};
1493   if (name == "huge") {
1494     return Expr<T>{Scalar<T>{}.NOT()};
1495   } else if (name == "mod" || name == "modulo") {
1496     bool badPConst{false};
1497     if (auto *pExpr{UnwrapExpr<Expr<T>>(args[1])}) {
1498       *pExpr = Fold(context, std::move(*pExpr));
1499       if (auto pConst{GetScalarConstantValue<T>(*pExpr)}; pConst &&
1500           pConst->IsZero() &&
1501           context.languageFeatures().ShouldWarn(
1502               common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
1503         context.messages().Say(common::UsageWarning::FoldingAvoidsRuntimeCrash,
1504             "%s: P argument is zero"_warn_en_US, name);
1505         badPConst = true;
1506       }
1507     }
1508     return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
1509         ScalarFuncWithContext<T, T, T>(
1510             [badPConst, &name](FoldingContext &context, const Scalar<T> &x,
1511                 const Scalar<T> &y) -> Scalar<T> {
1512               auto quotRem{x.DivideUnsigned(y)};
1513               if (context.languageFeatures().ShouldWarn(
1514                       common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
1515                 if (!badPConst && quotRem.divisionByZero) {
1516                   context.messages().Say(
1517                       common::UsageWarning::FoldingAvoidsRuntimeCrash,
1518                       "%s() by zero"_warn_en_US, name);
1519                 }
1520               }
1521               return quotRem.remainder;
1522             }));
1523   }
1524   return Expr<T>{std::move(funcRef)};
1525 }
1526 
1527 // Substitutes a bare type parameter reference with its value if it has one now
1528 // in an instantiation.  Bare LEN type parameters are substituted only when
1529 // the known value is constant.
1530 Expr<TypeParamInquiry::Result> FoldOperation(
1531     FoldingContext &context, TypeParamInquiry &&inquiry) {
1532   std::optional<NamedEntity> base{inquiry.base()};
1533   parser::CharBlock parameterName{inquiry.parameter().name()};
1534   if (base) {
1535     // Handling "designator%typeParam".  Get the value of the type parameter
1536     // from the instantiation of the base
1537     if (const semantics::DeclTypeSpec *
1538         declType{base->GetLastSymbol().GetType()}) {
1539       if (const semantics::ParamValue *
1540           paramValue{
1541               declType->derivedTypeSpec().FindParameter(parameterName)}) {
1542         const semantics::MaybeIntExpr &paramExpr{paramValue->GetExplicit()};
1543         if (paramExpr && IsConstantExpr(*paramExpr)) {
1544           Expr<SomeInteger> intExpr{*paramExpr};
1545           return Fold(context,
1546               ConvertToType<TypeParamInquiry::Result>(std::move(intExpr)));
1547         }
1548       }
1549     }
1550   } else {
1551     // A "bare" type parameter: replace with its value, if that's now known
1552     // in a current derived type instantiation.
1553     if (const auto *pdt{context.pdtInstance()}) {
1554       auto restorer{context.WithoutPDTInstance()}; // don't loop
1555       bool isLen{false};
1556       if (const semantics::Scope * scope{pdt->scope()}) {
1557         auto iter{scope->find(parameterName)};
1558         if (iter != scope->end()) {
1559           const Symbol &symbol{*iter->second};
1560           const auto *details{symbol.detailsIf<semantics::TypeParamDetails>()};
1561           if (details) {
1562             isLen = details->attr() == common::TypeParamAttr::Len;
1563             const semantics::MaybeIntExpr &initExpr{details->init()};
1564             if (initExpr && IsConstantExpr(*initExpr) &&
1565                 (!isLen || ToInt64(*initExpr))) {
1566               Expr<SomeInteger> expr{*initExpr};
1567               return Fold(context,
1568                   ConvertToType<TypeParamInquiry::Result>(std::move(expr)));
1569             }
1570           }
1571         }
1572       }
1573       if (const auto *value{pdt->FindParameter(parameterName)}) {
1574         if (value->isExplicit()) {
1575           auto folded{Fold(context,
1576               AsExpr(ConvertToType<TypeParamInquiry::Result>(
1577                   Expr<SomeInteger>{value->GetExplicit().value()})))};
1578           if (!isLen || ToInt64(folded)) {
1579             return folded;
1580           }
1581         }
1582       }
1583     }
1584   }
1585   return AsExpr(std::move(inquiry));
1586 }
1587 
1588 std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &expr) {
1589   return common::visit(
1590       [](const auto &kindExpr) { return ToInt64(kindExpr); }, expr.u);
1591 }
1592 
1593 std::optional<std::int64_t> ToInt64(const Expr<SomeUnsigned> &expr) {
1594   return common::visit(
1595       [](const auto &kindExpr) { return ToInt64(kindExpr); }, expr.u);
1596 }
1597 
1598 std::optional<std::int64_t> ToInt64(const Expr<SomeType> &expr) {
1599   if (const auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(expr)}) {
1600     return ToInt64(*intExpr);
1601   } else if (const auto *unsignedExpr{UnwrapExpr<Expr<SomeUnsigned>>(expr)}) {
1602     return ToInt64(*unsignedExpr);
1603   } else {
1604     return std::nullopt;
1605   }
1606 }
1607 
1608 std::optional<std::int64_t> ToInt64(const ActualArgument &arg) {
1609   return ToInt64(arg.UnwrapExpr());
1610 }
1611 
1612 #ifdef _MSC_VER // disable bogus warning about missing definitions
1613 #pragma warning(disable : 4661)
1614 #endif
1615 FOR_EACH_INTEGER_KIND(template class ExpressionBase, )
1616 FOR_EACH_UNSIGNED_KIND(template class ExpressionBase, )
1617 template class ExpressionBase<SomeInteger>;
1618 template class ExpressionBase<SomeUnsigned>;
1619 } // namespace Fortran::evaluate
1620