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