1 //===-- lib/Evaluate/fold-logical.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-reduction.h"
11 #include "flang/Evaluate/check-expression.h"
12 
13 namespace Fortran::evaluate {
14 
15 // for ALL & ANY
16 template <typename T>
FoldAllAny(FoldingContext & context,FunctionRef<T> && ref,Scalar<T> (Scalar<T>::* operation)(const Scalar<T> &)const,Scalar<T> identity)17 static Expr<T> FoldAllAny(FoldingContext &context, FunctionRef<T> &&ref,
18     Scalar<T> (Scalar<T>::*operation)(const Scalar<T> &) const,
19     Scalar<T> identity) {
20   static_assert(T::category == TypeCategory::Logical);
21   using Element = Scalar<T>;
22   std::optional<int> dim;
23   if (std::optional<Constant<T>> array{
24           ProcessReductionArgs<T>(context, ref.arguments(), dim, identity,
25               /*ARRAY(MASK)=*/0, /*DIM=*/1)}) {
26     auto accumulator{[&](Element &element, const ConstantSubscripts &at) {
27       element = (element.*operation)(array->At(at));
28     }};
29     return Expr<T>{DoReduction<T>(*array, dim, identity, accumulator)};
30   }
31   return Expr<T>{std::move(ref)};
32 }
33 
34 template <int KIND>
FoldIntrinsicFunction(FoldingContext & context,FunctionRef<Type<TypeCategory::Logical,KIND>> && funcRef)35 Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
36     FoldingContext &context,
37     FunctionRef<Type<TypeCategory::Logical, KIND>> &&funcRef) {
38   using T = Type<TypeCategory::Logical, KIND>;
39   ActualArguments &args{funcRef.arguments()};
40   auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
41   CHECK(intrinsic);
42   std::string name{intrinsic->name};
43   if (name == "all") {
44     return FoldAllAny(
45         context, std::move(funcRef), &Scalar<T>::AND, Scalar<T>{true});
46   } else if (name == "any") {
47     return FoldAllAny(
48         context, std::move(funcRef), &Scalar<T>::OR, Scalar<T>{false});
49   } else if (name == "associated") {
50     bool gotConstant{true};
51     const Expr<SomeType> *firstArgExpr{args[0]->UnwrapExpr()};
52     if (!firstArgExpr || !IsNullPointer(*firstArgExpr)) {
53       gotConstant = false;
54     } else if (args[1]) { // There's a second argument
55       const Expr<SomeType> *secondArgExpr{args[1]->UnwrapExpr()};
56       if (!secondArgExpr || !IsNullPointer(*secondArgExpr)) {
57         gotConstant = false;
58       }
59     }
60     return gotConstant ? Expr<T>{false} : Expr<T>{std::move(funcRef)};
61   } else if (name == "bge" || name == "bgt" || name == "ble" || name == "blt") {
62     using LargestInt = Type<TypeCategory::Integer, 16>;
63     static_assert(std::is_same_v<Scalar<LargestInt>, BOZLiteralConstant>);
64     // Arguments do not have to be of the same integer type. Convert all
65     // arguments to the biggest integer type before comparing them to
66     // simplify.
67     for (int i{0}; i <= 1; ++i) {
68       if (auto *x{UnwrapExpr<Expr<SomeInteger>>(args[i])}) {
69         *args[i] = AsGenericExpr(
70             Fold(context, ConvertToType<LargestInt>(std::move(*x))));
71       } else if (auto *x{UnwrapExpr<BOZLiteralConstant>(args[i])}) {
72         *args[i] = AsGenericExpr(Constant<LargestInt>{std::move(*x)});
73       }
74     }
75     auto fptr{&Scalar<LargestInt>::BGE};
76     if (name == "bge") { // done in fptr declaration
77     } else if (name == "bgt") {
78       fptr = &Scalar<LargestInt>::BGT;
79     } else if (name == "ble") {
80       fptr = &Scalar<LargestInt>::BLE;
81     } else if (name == "blt") {
82       fptr = &Scalar<LargestInt>::BLT;
83     } else {
84       common::die("missing case to fold intrinsic function %s", name.c_str());
85     }
86     return FoldElementalIntrinsic<T, LargestInt, LargestInt>(context,
87         std::move(funcRef),
88         ScalarFunc<T, LargestInt, LargestInt>(
89             [&fptr](const Scalar<LargestInt> &i, const Scalar<LargestInt> &j) {
90               return Scalar<T>{std::invoke(fptr, i, j)};
91             }));
92   } else if (name == "isnan" || name == "__builtin_ieee_is_nan") {
93     // A warning about an invalid argument is discarded from converting
94     // the argument of isnan() / IEEE_IS_NAN().
95     auto restorer{context.messages().DiscardMessages()};
96     using DefaultReal = Type<TypeCategory::Real, 4>;
97     return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
98         ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
99           return Scalar<T>{x.IsNotANumber()};
100         }));
101   } else if (name == "is_contiguous") {
102     if (args.at(0)) {
103       if (auto *expr{args[0]->UnwrapExpr()}) {
104         if (IsSimplyContiguous(*expr, context)) {
105           return Expr<T>{true};
106         }
107       }
108     }
109   } else if (name == "logical") {
110     if (auto *expr{UnwrapExpr<Expr<SomeLogical>>(args[0])}) {
111       return Fold(context, ConvertToType<T>(std::move(*expr)));
112     }
113   } else if (name == "merge") {
114     return FoldMerge<T>(context, std::move(funcRef));
115   } else if (name == "__builtin_ieee_support_datatype" ||
116       name == "__builtin_ieee_support_denormal" ||
117       name == "__builtin_ieee_support_divide" ||
118       name == "__builtin_ieee_support_divide" ||
119       name == "__builtin_ieee_support_inf" ||
120       name == "__builtin_ieee_support_io" ||
121       name == "__builtin_ieee_support_nan" ||
122       name == "__builtin_ieee_support_sqrt" ||
123       name == "__builtin_ieee_support_standard" ||
124       name == "__builtin_ieee_support_subnormal" ||
125       name == "__builtin_ieee_support_underflow_control") {
126     return Expr<T>{true};
127   }
128   // TODO: btest, dot_product, is_iostat_end,
129   // is_iostat_eor, lge, lgt, lle, llt, logical, matmul, out_of_range,
130   // parity, transfer
131   return Expr<T>{std::move(funcRef)};
132 }
133 
134 template <typename T>
FoldOperation(FoldingContext & context,Relational<T> && relation)135 Expr<LogicalResult> FoldOperation(
136     FoldingContext &context, Relational<T> &&relation) {
137   if (auto array{ApplyElementwise(context, relation,
138           std::function<Expr<LogicalResult>(Expr<T> &&, Expr<T> &&)>{
139               [=](Expr<T> &&x, Expr<T> &&y) {
140                 return Expr<LogicalResult>{Relational<SomeType>{
141                     Relational<T>{relation.opr, std::move(x), std::move(y)}}};
142               }})}) {
143     return *array;
144   }
145   if (auto folded{OperandsAreConstants(relation)}) {
146     bool result{};
147     if constexpr (T::category == TypeCategory::Integer) {
148       result =
149           Satisfies(relation.opr, folded->first.CompareSigned(folded->second));
150     } else if constexpr (T::category == TypeCategory::Real) {
151       result = Satisfies(relation.opr, folded->first.Compare(folded->second));
152     } else if constexpr (T::category == TypeCategory::Complex) {
153       result = (relation.opr == RelationalOperator::EQ) ==
154           folded->first.Equals(folded->second);
155     } else if constexpr (T::category == TypeCategory::Character) {
156       result = Satisfies(relation.opr, Compare(folded->first, folded->second));
157     } else {
158       static_assert(T::category != TypeCategory::Logical);
159     }
160     return Expr<LogicalResult>{Constant<LogicalResult>{result}};
161   }
162   return Expr<LogicalResult>{Relational<SomeType>{std::move(relation)}};
163 }
164 
FoldOperation(FoldingContext & context,Relational<SomeType> && relation)165 Expr<LogicalResult> FoldOperation(
166     FoldingContext &context, Relational<SomeType> &&relation) {
167   return std::visit(
168       [&](auto &&x) {
169         return Expr<LogicalResult>{FoldOperation(context, std::move(x))};
170       },
171       std::move(relation.u));
172 }
173 
174 template <int KIND>
FoldOperation(FoldingContext & context,Not<KIND> && x)175 Expr<Type<TypeCategory::Logical, KIND>> FoldOperation(
176     FoldingContext &context, Not<KIND> &&x) {
177   if (auto array{ApplyElementwise(context, x)}) {
178     return *array;
179   }
180   using Ty = Type<TypeCategory::Logical, KIND>;
181   auto &operand{x.left()};
182   if (auto value{GetScalarConstantValue<Ty>(operand)}) {
183     return Expr<Ty>{Constant<Ty>{!value->IsTrue()}};
184   }
185   return Expr<Ty>{x};
186 }
187 
188 template <int KIND>
FoldOperation(FoldingContext & context,LogicalOperation<KIND> && operation)189 Expr<Type<TypeCategory::Logical, KIND>> FoldOperation(
190     FoldingContext &context, LogicalOperation<KIND> &&operation) {
191   using LOGICAL = Type<TypeCategory::Logical, KIND>;
192   if (auto array{ApplyElementwise(context, operation,
193           std::function<Expr<LOGICAL>(Expr<LOGICAL> &&, Expr<LOGICAL> &&)>{
194               [=](Expr<LOGICAL> &&x, Expr<LOGICAL> &&y) {
195                 return Expr<LOGICAL>{LogicalOperation<KIND>{
196                     operation.logicalOperator, std::move(x), std::move(y)}};
197               }})}) {
198     return *array;
199   }
200   if (auto folded{OperandsAreConstants(operation)}) {
201     bool xt{folded->first.IsTrue()}, yt{folded->second.IsTrue()}, result{};
202     switch (operation.logicalOperator) {
203     case LogicalOperator::And:
204       result = xt && yt;
205       break;
206     case LogicalOperator::Or:
207       result = xt || yt;
208       break;
209     case LogicalOperator::Eqv:
210       result = xt == yt;
211       break;
212     case LogicalOperator::Neqv:
213       result = xt != yt;
214       break;
215     case LogicalOperator::Not:
216       DIE("not a binary operator");
217     }
218     return Expr<LOGICAL>{Constant<LOGICAL>{result}};
219   }
220   return Expr<LOGICAL>{std::move(operation)};
221 }
222 
223 FOR_EACH_LOGICAL_KIND(template class ExpressionBase, )
224 template class ExpressionBase<SomeLogical>;
225 } // namespace Fortran::evaluate
226