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