1 //===-- include/flang/Evaluate/fold.h ---------------------------*- C++ -*-===// 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 #ifndef FORTRAN_EVALUATE_FOLD_H_ 10 #define FORTRAN_EVALUATE_FOLD_H_ 11 12 // Implements expression tree rewriting, particularly constant expression 13 // and designator reference evaluation. 14 15 #include "common.h" 16 #include "constant.h" 17 #include "expression.h" 18 #include "tools.h" 19 #include "type.h" 20 #include <variant> 21 22 namespace Fortran::evaluate::characteristics { 23 class TypeAndShape; 24 } 25 26 namespace Fortran::evaluate { 27 28 using namespace Fortran::parser::literals; 29 30 // Fold() rewrites an expression and returns it. When the rewritten expression 31 // is a constant, UnwrapConstantValue() and GetScalarConstantValue() below will 32 // be able to extract it. 33 // Note the rvalue reference argument: the rewrites are performed in place 34 // for efficiency. 35 template <typename T> Expr<T> Fold(FoldingContext &context, Expr<T> &&expr) { 36 return Expr<T>::Rewrite(context, std::move(expr)); 37 } 38 39 characteristics::TypeAndShape Fold( 40 FoldingContext &, characteristics::TypeAndShape &&); 41 42 template <typename A> 43 std::optional<A> Fold(FoldingContext &context, std::optional<A> &&x) { 44 if (x) { 45 return Fold(context, std::move(*x)); 46 } else { 47 return std::nullopt; 48 } 49 } 50 51 // UnwrapConstantValue() isolates the known constant value of 52 // an expression, if it has one. It returns a pointer, which is 53 // const-qualified when the expression is so. The value can be 54 // parenthesized. 55 template <typename T, typename EXPR> 56 auto UnwrapConstantValue(EXPR &expr) -> common::Constify<Constant<T>, EXPR> * { 57 if (auto *c{UnwrapExpr<Constant<T>>(expr)}) { 58 return c; 59 } else { 60 if (auto *parens{UnwrapExpr<Parentheses<T>>(expr)}) { 61 return UnwrapConstantValue<T>(parens->left()); 62 } 63 return nullptr; 64 } 65 } 66 67 // GetScalarConstantValue() extracts the known scalar constant value of 68 // an expression, if it has one. The value can be parenthesized. 69 template <typename T, typename EXPR> 70 constexpr auto GetScalarConstantValue(const EXPR &expr) 71 -> std::optional<Scalar<T>> { 72 if (const Constant<T> *constant{UnwrapConstantValue<T>(expr)}) { 73 return constant->GetScalarValue(); 74 } else { 75 return std::nullopt; 76 } 77 } 78 79 // When an expression is a constant integer, ToInt64() extracts its value. 80 // Ensure that the expression has been folded beforehand when folding might 81 // be required. 82 template <int KIND> 83 constexpr std::optional<std::int64_t> ToInt64( 84 const Expr<Type<TypeCategory::Integer, KIND>> &expr) { 85 if (auto scalar{ 86 GetScalarConstantValue<Type<TypeCategory::Integer, KIND>>(expr)}) { 87 return scalar->ToInt64(); 88 } else { 89 return std::nullopt; 90 } 91 } 92 template <int KIND> 93 constexpr std::optional<std::int64_t> ToInt64( 94 const Expr<Type<TypeCategory::Unsigned, KIND>> &expr) { 95 if (auto scalar{ 96 GetScalarConstantValue<Type<TypeCategory::Unsigned, KIND>>(expr)}) { 97 return scalar->ToInt64(); 98 } else { 99 return std::nullopt; 100 } 101 } 102 103 std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &); 104 std::optional<std::int64_t> ToInt64(const Expr<SomeUnsigned> &); 105 std::optional<std::int64_t> ToInt64(const Expr<SomeType> &); 106 std::optional<std::int64_t> ToInt64(const ActualArgument &); 107 108 template <typename A> 109 std::optional<std::int64_t> ToInt64(const std::optional<A> &x) { 110 if (x) { 111 return ToInt64(*x); 112 } else { 113 return std::nullopt; 114 } 115 } 116 117 template <typename A> std::optional<std::int64_t> ToInt64(A *p) { 118 if (p) { 119 return ToInt64(std::as_const(*p)); 120 } else { 121 return std::nullopt; 122 } 123 } 124 125 } // namespace Fortran::evaluate 126 #endif // FORTRAN_EVALUATE_FOLD_H_ 127