1 //===-- lib/Evaluate/expression.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 "flang/Evaluate/expression.h" 10 #include "int-power.h" 11 #include "flang/Common/idioms.h" 12 #include "flang/Evaluate/common.h" 13 #include "flang/Evaluate/tools.h" 14 #include "flang/Evaluate/variable.h" 15 #include "flang/Parser/message.h" 16 #include <string> 17 #include <type_traits> 18 19 using namespace Fortran::parser::literals; 20 21 namespace Fortran::evaluate { 22 23 template<int KIND> 24 std::optional<Expr<SubscriptInteger>> 25 Expr<Type<TypeCategory::Character, KIND>>::LEN() const { 26 using T = std::optional<Expr<SubscriptInteger>>; 27 return std::visit( 28 common::visitors{ 29 [](const Constant<Result> &c) -> T { 30 return AsExpr(Constant<SubscriptInteger>{c.LEN()}); 31 }, 32 [](const ArrayConstructor<Result> &a) -> T { return a.LEN(); }, 33 [](const Parentheses<Result> &x) { return x.left().LEN(); }, 34 [](const Convert<Result> &x) { 35 return std::visit( 36 [&](const auto &kx) { return kx.LEN(); }, x.left().u); 37 }, 38 [](const Concat<KIND> &c) -> T { 39 if (auto llen{c.left().LEN()}) { 40 if (auto rlen{c.right().LEN()}) { 41 return *std::move(llen) + *std::move(rlen); 42 } 43 } 44 return std::nullopt; 45 }, 46 [](const Extremum<Result> &c) -> T { 47 if (auto llen{c.left().LEN()}) { 48 if (auto rlen{c.right().LEN()}) { 49 return Expr<SubscriptInteger>{Extremum<SubscriptInteger>{ 50 Ordering::Greater, *std::move(llen), *std::move(rlen)}}; 51 } 52 } 53 return std::nullopt; 54 }, 55 [](const Designator<Result> &dr) { return dr.LEN(); }, 56 [](const FunctionRef<Result> &fr) { return fr.LEN(); }, 57 [](const SetLength<KIND> &x) -> T { return x.right(); }, 58 }, 59 u); 60 } 61 62 Expr<SomeType>::~Expr() = default; 63 64 #if defined(__APPLE__) && defined(__GNUC__) 65 template<typename A> 66 typename ExpressionBase<A>::Derived &ExpressionBase<A>::derived() { 67 return *static_cast<Derived *>(this); 68 } 69 70 template<typename A> 71 const typename ExpressionBase<A>::Derived &ExpressionBase<A>::derived() const { 72 return *static_cast<const Derived *>(this); 73 } 74 #endif 75 76 template<typename A> 77 std::optional<DynamicType> ExpressionBase<A>::GetType() const { 78 if constexpr (IsLengthlessIntrinsicType<Result>) { 79 return Result::GetType(); 80 } else { 81 return std::visit( 82 [&](const auto &x) -> std::optional<DynamicType> { 83 if constexpr (!common::HasMember<decltype(x), TypelessExpression>) { 84 return x.GetType(); 85 } 86 return std::nullopt; // w/o "else" to dodge bogus g++ 8.1 warning 87 }, 88 derived().u); 89 } 90 } 91 92 template<typename A> int ExpressionBase<A>::Rank() const { 93 return std::visit( 94 [](const auto &x) { 95 if constexpr (common::HasMember<decltype(x), TypelessExpression>) { 96 return 0; 97 } else { 98 return x.Rank(); 99 } 100 }, 101 derived().u); 102 } 103 104 // Equality testing 105 106 bool ImpliedDoIndex::operator==(const ImpliedDoIndex &that) const { 107 return name == that.name; 108 } 109 110 template<typename T> 111 bool ImpliedDo<T>::operator==(const ImpliedDo<T> &that) const { 112 return name_ == that.name_ && lower_ == that.lower_ && 113 upper_ == that.upper_ && stride_ == that.stride_ && 114 values_ == that.values_; 115 } 116 117 template<typename T> 118 bool ArrayConstructorValue<T>::operator==( 119 const ArrayConstructorValue<T> &that) const { 120 return u == that.u; 121 } 122 123 template<typename R> 124 bool ArrayConstructorValues<R>::operator==( 125 const ArrayConstructorValues<R> &that) const { 126 return values_ == that.values_; 127 } 128 129 template<int KIND> 130 bool ArrayConstructor<Type<TypeCategory::Character, KIND>>::operator==( 131 const ArrayConstructor &that) const { 132 return length_ == that.length_ && 133 static_cast<const Base &>(*this) == static_cast<const Base &>(that); 134 } 135 136 bool ArrayConstructor<SomeDerived>::operator==( 137 const ArrayConstructor &that) const { 138 return result_ == that.result_ && 139 static_cast<const Base &>(*this) == static_cast<const Base &>(that); 140 ; 141 } 142 143 StructureConstructor::StructureConstructor( 144 const semantics::DerivedTypeSpec &spec, 145 const StructureConstructorValues &values) 146 : result_{spec}, values_{values} {} 147 StructureConstructor::StructureConstructor( 148 const semantics::DerivedTypeSpec &spec, StructureConstructorValues &&values) 149 : result_{spec}, values_{std::move(values)} {} 150 151 bool StructureConstructor::operator==(const StructureConstructor &that) const { 152 return result_ == that.result_ && values_ == that.values_; 153 } 154 155 bool Relational<SomeType>::operator==(const Relational<SomeType> &that) const { 156 return u == that.u; 157 } 158 159 template<int KIND> 160 bool Expr<Type<TypeCategory::Integer, KIND>>::operator==( 161 const Expr<Type<TypeCategory::Integer, KIND>> &that) const { 162 return u == that.u; 163 } 164 165 template<int KIND> 166 bool Expr<Type<TypeCategory::Real, KIND>>::operator==( 167 const Expr<Type<TypeCategory::Real, KIND>> &that) const { 168 return u == that.u; 169 } 170 171 template<int KIND> 172 bool Expr<Type<TypeCategory::Complex, KIND>>::operator==( 173 const Expr<Type<TypeCategory::Complex, KIND>> &that) const { 174 return u == that.u; 175 } 176 177 template<int KIND> 178 bool Expr<Type<TypeCategory::Logical, KIND>>::operator==( 179 const Expr<Type<TypeCategory::Logical, KIND>> &that) const { 180 return u == that.u; 181 } 182 183 template<int KIND> 184 bool Expr<Type<TypeCategory::Character, KIND>>::operator==( 185 const Expr<Type<TypeCategory::Character, KIND>> &that) const { 186 return u == that.u; 187 } 188 189 template<TypeCategory CAT> 190 bool Expr<SomeKind<CAT>>::operator==(const Expr<SomeKind<CAT>> &that) const { 191 return u == that.u; 192 } 193 194 bool Expr<SomeDerived>::operator==(const Expr<SomeDerived> &that) const { 195 return u == that.u; 196 } 197 198 bool Expr<SomeCharacter>::operator==(const Expr<SomeCharacter> &that) const { 199 return u == that.u; 200 } 201 202 bool Expr<SomeType>::operator==(const Expr<SomeType> &that) const { 203 return u == that.u; 204 } 205 206 DynamicType StructureConstructor::GetType() const { return result_.GetType(); } 207 208 const Expr<SomeType> *StructureConstructor::Find( 209 const Symbol &component) const { 210 if (auto iter{values_.find(component)}; iter != values_.end()) { 211 return &iter->second.value(); 212 } else { 213 return nullptr; 214 } 215 } 216 217 StructureConstructor &StructureConstructor::Add( 218 const Symbol &symbol, Expr<SomeType> &&expr) { 219 values_.emplace(symbol, std::move(expr)); 220 return *this; 221 } 222 223 GenericExprWrapper::~GenericExprWrapper() {} 224 225 std::ostream &Assignment::AsFortran(std::ostream &o) const { 226 std::visit( 227 common::visitors{ 228 [&](const Assignment::Intrinsic &) { 229 rhs.AsFortran(lhs.AsFortran(o) << '='); 230 }, 231 [&](const ProcedureRef &proc) { proc.AsFortran(o << "CALL "); }, 232 [&](const BoundsSpec &bounds) { 233 lhs.AsFortran(o); 234 if (!bounds.empty()) { 235 char sep{'('}; 236 for (const auto &bound : bounds) { 237 bound.AsFortran(o << sep) << ':'; 238 sep = ','; 239 } 240 o << ')'; 241 } 242 }, 243 [&](const BoundsRemapping &bounds) { 244 lhs.AsFortran(o); 245 if (!bounds.empty()) { 246 char sep{'('}; 247 for (const auto &bound : bounds) { 248 bound.first.AsFortran(o << sep) << ':'; 249 bound.second.AsFortran(o); 250 sep = ','; 251 } 252 o << ')'; 253 } 254 rhs.AsFortran(o << " => "); 255 }, 256 }, 257 u); 258 return o; 259 } 260 261 GenericAssignmentWrapper::~GenericAssignmentWrapper() {} 262 263 template<TypeCategory CAT> int Expr<SomeKind<CAT>>::GetKind() const { 264 return std::visit( 265 [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; }, 266 u); 267 } 268 269 int Expr<SomeCharacter>::GetKind() const { 270 return std::visit( 271 [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; }, 272 u); 273 } 274 275 std::optional<Expr<SubscriptInteger>> Expr<SomeCharacter>::LEN() const { 276 return std::visit([](const auto &kx) { return kx.LEN(); }, u); 277 } 278 279 INSTANTIATE_EXPRESSION_TEMPLATES 280 } 281 DEFINE_DELETER(Fortran::evaluate::GenericExprWrapper) 282 DEFINE_DELETER(Fortran::evaluate::GenericAssignmentWrapper) 283