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 "flang/Evaluate/check-expression.h"
11
12 namespace Fortran::evaluate {
13
14 template <int KIND>
FoldIntrinsicFunction(FoldingContext & context,FunctionRef<Type<TypeCategory::Logical,KIND>> && funcRef)15 Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
16 FoldingContext &context,
17 FunctionRef<Type<TypeCategory::Logical, KIND>> &&funcRef) {
18 using T = Type<TypeCategory::Logical, KIND>;
19 ActualArguments &args{funcRef.arguments()};
20 auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
21 CHECK(intrinsic);
22 std::string name{intrinsic->name};
23 if (name == "all") {
24 if (!args[1]) { // TODO: ALL(x,DIM=d)
25 if (const auto *constant{UnwrapConstantValue<T>(args[0])}) {
26 bool result{true};
27 for (const auto &element : constant->values()) {
28 if (!element.IsTrue()) {
29 result = false;
30 break;
31 }
32 }
33 return Expr<T>{result};
34 }
35 }
36 } else if (name == "any") {
37 if (!args[1]) { // TODO: ANY(x,DIM=d)
38 if (const auto *constant{UnwrapConstantValue<T>(args[0])}) {
39 bool result{false};
40 for (const auto &element : constant->values()) {
41 if (element.IsTrue()) {
42 result = true;
43 break;
44 }
45 }
46 return Expr<T>{result};
47 }
48 }
49 } else if (name == "bge" || name == "bgt" || name == "ble" || name == "blt") {
50 using LargestInt = Type<TypeCategory::Integer, 16>;
51 static_assert(std::is_same_v<Scalar<LargestInt>, BOZLiteralConstant>);
52 // Arguments do not have to be of the same integer type. Convert all
53 // arguments to the biggest integer type before comparing them to
54 // simplify.
55 for (int i{0}; i <= 1; ++i) {
56 if (auto *x{UnwrapExpr<Expr<SomeInteger>>(args[i])}) {
57 *args[i] = AsGenericExpr(
58 Fold(context, ConvertToType<LargestInt>(std::move(*x))));
59 } else if (auto *x{UnwrapExpr<BOZLiteralConstant>(args[i])}) {
60 *args[i] = AsGenericExpr(Constant<LargestInt>{std::move(*x)});
61 }
62 }
63 auto fptr{&Scalar<LargestInt>::BGE};
64 if (name == "bge") { // done in fptr declaration
65 } else if (name == "bgt") {
66 fptr = &Scalar<LargestInt>::BGT;
67 } else if (name == "ble") {
68 fptr = &Scalar<LargestInt>::BLE;
69 } else if (name == "blt") {
70 fptr = &Scalar<LargestInt>::BLT;
71 } else {
72 common::die("missing case to fold intrinsic function %s", name.c_str());
73 }
74 return FoldElementalIntrinsic<T, LargestInt, LargestInt>(context,
75 std::move(funcRef),
76 ScalarFunc<T, LargestInt, LargestInt>(
77 [&fptr](const Scalar<LargestInt> &i, const Scalar<LargestInt> &j) {
78 return Scalar<T>{std::invoke(fptr, i, j)};
79 }));
80 } else if (name == "is_contiguous") {
81 if (args.at(0)) {
82 if (auto *expr{args[0]->UnwrapExpr()}) {
83 if (IsSimplyContiguous(*expr, context.intrinsics())) {
84 return Expr<T>{true};
85 }
86 }
87 }
88 } else if (name == "merge") {
89 return FoldMerge<T>(context, std::move(funcRef));
90 }
91 // TODO: btest, cshift, dot_product, eoshift, is_iostat_end,
92 // is_iostat_eor, lge, lgt, lle, llt, logical, matmul, out_of_range,
93 // pack, parity, reduce, spread, transfer, transpose, unpack,
94 // extends_type_of, same_type_as
95 return Expr<T>{std::move(funcRef)};
96 }
97
98 template <typename T>
FoldOperation(FoldingContext & context,Relational<T> && relation)99 Expr<LogicalResult> FoldOperation(
100 FoldingContext &context, Relational<T> &&relation) {
101 if (auto array{ApplyElementwise(context, relation,
102 std::function<Expr<LogicalResult>(Expr<T> &&, Expr<T> &&)>{
103 [=](Expr<T> &&x, Expr<T> &&y) {
104 return Expr<LogicalResult>{Relational<SomeType>{
105 Relational<T>{relation.opr, std::move(x), std::move(y)}}};
106 }})}) {
107 return *array;
108 }
109 if (auto folded{OperandsAreConstants(relation)}) {
110 bool result{};
111 if constexpr (T::category == TypeCategory::Integer) {
112 result =
113 Satisfies(relation.opr, folded->first.CompareSigned(folded->second));
114 } else if constexpr (T::category == TypeCategory::Real) {
115 result = Satisfies(relation.opr, folded->first.Compare(folded->second));
116 } else if constexpr (T::category == TypeCategory::Character) {
117 result = Satisfies(relation.opr, Compare(folded->first, folded->second));
118 } else {
119 static_assert(T::category != TypeCategory::Complex &&
120 T::category != TypeCategory::Logical);
121 }
122 return Expr<LogicalResult>{Constant<LogicalResult>{result}};
123 }
124 return Expr<LogicalResult>{Relational<SomeType>{std::move(relation)}};
125 }
126
FoldOperation(FoldingContext & context,Relational<SomeType> && relation)127 Expr<LogicalResult> FoldOperation(
128 FoldingContext &context, Relational<SomeType> &&relation) {
129 return std::visit(
130 [&](auto &&x) {
131 return Expr<LogicalResult>{FoldOperation(context, std::move(x))};
132 },
133 std::move(relation.u));
134 }
135
136 template <int KIND>
FoldOperation(FoldingContext & context,Not<KIND> && x)137 Expr<Type<TypeCategory::Logical, KIND>> FoldOperation(
138 FoldingContext &context, Not<KIND> &&x) {
139 if (auto array{ApplyElementwise(context, x)}) {
140 return *array;
141 }
142 using Ty = Type<TypeCategory::Logical, KIND>;
143 auto &operand{x.left()};
144 if (auto value{GetScalarConstantValue<Ty>(operand)}) {
145 return Expr<Ty>{Constant<Ty>{!value->IsTrue()}};
146 }
147 return Expr<Ty>{x};
148 }
149
150 template <int KIND>
FoldOperation(FoldingContext & context,LogicalOperation<KIND> && operation)151 Expr<Type<TypeCategory::Logical, KIND>> FoldOperation(
152 FoldingContext &context, LogicalOperation<KIND> &&operation) {
153 using LOGICAL = Type<TypeCategory::Logical, KIND>;
154 if (auto array{ApplyElementwise(context, operation,
155 std::function<Expr<LOGICAL>(Expr<LOGICAL> &&, Expr<LOGICAL> &&)>{
156 [=](Expr<LOGICAL> &&x, Expr<LOGICAL> &&y) {
157 return Expr<LOGICAL>{LogicalOperation<KIND>{
158 operation.logicalOperator, std::move(x), std::move(y)}};
159 }})}) {
160 return *array;
161 }
162 if (auto folded{OperandsAreConstants(operation)}) {
163 bool xt{folded->first.IsTrue()}, yt{folded->second.IsTrue()}, result{};
164 switch (operation.logicalOperator) {
165 case LogicalOperator::And:
166 result = xt && yt;
167 break;
168 case LogicalOperator::Or:
169 result = xt || yt;
170 break;
171 case LogicalOperator::Eqv:
172 result = xt == yt;
173 break;
174 case LogicalOperator::Neqv:
175 result = xt != yt;
176 break;
177 case LogicalOperator::Not:
178 DIE("not a binary operator");
179 }
180 return Expr<LOGICAL>{Constant<LOGICAL>{result}};
181 }
182 return Expr<LOGICAL>{std::move(operation)};
183 }
184
185 FOR_EACH_LOGICAL_KIND(template class ExpressionBase, )
186 template class ExpressionBase<SomeLogical>;
187 } // namespace Fortran::evaluate
188