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/char-block.h" 16 #include "flang/Parser/message.h" 17 #include "flang/Semantics/scope.h" 18 #include "flang/Semantics/symbol.h" 19 #include "flang/Semantics/tools.h" 20 #include "flang/Semantics/type.h" 21 #include "llvm/Support/raw_ostream.h" 22 #include <string> 23 #include <type_traits> 24 25 using namespace Fortran::parser::literals; 26 27 namespace Fortran::evaluate { 28 29 template <int KIND> 30 std::optional<Expr<SubscriptInteger>> 31 Expr<Type<TypeCategory::Character, KIND>>::LEN() const { 32 using T = std::optional<Expr<SubscriptInteger>>; 33 return common::visit( 34 common::visitors{ 35 [](const Constant<Result> &c) -> T { 36 return AsExpr(Constant<SubscriptInteger>{c.LEN()}); 37 }, 38 [](const ArrayConstructor<Result> &a) -> T { 39 if (const auto *len{a.LEN()}) { 40 return T{*len}; 41 } else { 42 return std::nullopt; 43 } 44 }, 45 [](const Parentheses<Result> &x) { return x.left().LEN(); }, 46 [](const Convert<Result> &x) { 47 return common::visit( 48 [&](const auto &kx) { return kx.LEN(); }, x.left().u); 49 }, 50 [](const Concat<KIND> &c) -> T { 51 if (auto llen{c.left().LEN()}) { 52 if (auto rlen{c.right().LEN()}) { 53 return *std::move(llen) + *std::move(rlen); 54 } 55 } 56 return std::nullopt; 57 }, 58 [](const Extremum<Result> &c) -> T { 59 if (auto llen{c.left().LEN()}) { 60 if (auto rlen{c.right().LEN()}) { 61 return Expr<SubscriptInteger>{Extremum<SubscriptInteger>{ 62 Ordering::Greater, *std::move(llen), *std::move(rlen)}}; 63 } 64 } 65 return std::nullopt; 66 }, 67 [](const Designator<Result> &dr) { return dr.LEN(); }, 68 [](const FunctionRef<Result> &fr) { return fr.LEN(); }, 69 [](const SetLength<KIND> &x) -> T { return x.right(); }, 70 }, 71 u); 72 } 73 74 Expr<SomeType>::~Expr() = default; 75 76 #if defined(__APPLE__) && defined(__GNUC__) 77 template <typename A> 78 typename ExpressionBase<A>::Derived &ExpressionBase<A>::derived() { 79 return *static_cast<Derived *>(this); 80 } 81 82 template <typename A> 83 const typename ExpressionBase<A>::Derived &ExpressionBase<A>::derived() const { 84 return *static_cast<const Derived *>(this); 85 } 86 #endif 87 88 template <typename A> 89 std::optional<DynamicType> ExpressionBase<A>::GetType() const { 90 if constexpr (IsLengthlessIntrinsicType<Result>) { 91 return Result::GetType(); 92 } else { 93 return common::visit( 94 [&](const auto &x) -> std::optional<DynamicType> { 95 if constexpr (!common::HasMember<decltype(x), TypelessExpression>) { 96 return x.GetType(); 97 } 98 return std::nullopt; // w/o "else" to dodge bogus g++ 8.1 warning 99 }, 100 derived().u); 101 } 102 } 103 104 template <typename A> int ExpressionBase<A>::Rank() const { 105 return common::visit( 106 [](const auto &x) { 107 if constexpr (common::HasMember<decltype(x), TypelessExpression>) { 108 return 0; 109 } else { 110 return x.Rank(); 111 } 112 }, 113 derived().u); 114 } 115 116 DynamicType Parentheses<SomeDerived>::GetType() const { 117 return left().GetType().value(); 118 } 119 120 #if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP) 121 template <typename A> LLVM_DUMP_METHOD void ExpressionBase<A>::dump() const { 122 llvm::errs() << "Expr is <{" << AsFortran() << "}>\n"; 123 } 124 #endif 125 126 // Equality testing 127 128 bool ImpliedDoIndex::operator==(const ImpliedDoIndex &that) const { 129 return name == that.name; 130 } 131 132 template <typename T> 133 bool ImpliedDo<T>::operator==(const ImpliedDo<T> &that) const { 134 return name_ == that.name_ && lower_ == that.lower_ && 135 upper_ == that.upper_ && stride_ == that.stride_ && 136 values_ == that.values_; 137 } 138 139 template <typename T> 140 bool ArrayConstructorValue<T>::operator==( 141 const ArrayConstructorValue<T> &that) const { 142 return u == that.u; 143 } 144 145 template <typename R> 146 bool ArrayConstructorValues<R>::operator==( 147 const ArrayConstructorValues<R> &that) const { 148 return values_ == that.values_; 149 } 150 151 template <int KIND> 152 auto ArrayConstructor<Type<TypeCategory::Character, KIND>>::set_LEN( 153 Expr<SubscriptInteger> &&len) -> ArrayConstructor & { 154 length_.emplace(std::move(len)); 155 return *this; 156 } 157 158 template <int KIND> 159 bool ArrayConstructor<Type<TypeCategory::Character, KIND>>::operator==( 160 const ArrayConstructor &that) const { 161 return length_ == that.length_ && 162 static_cast<const Base &>(*this) == static_cast<const Base &>(that); 163 } 164 165 bool ArrayConstructor<SomeDerived>::operator==( 166 const ArrayConstructor &that) const { 167 return result_ == that.result_ && 168 static_cast<const Base &>(*this) == static_cast<const Base &>(that); 169 ; 170 } 171 172 StructureConstructor::StructureConstructor( 173 const semantics::DerivedTypeSpec &spec, 174 const StructureConstructorValues &values) 175 : result_{spec}, values_{values} {} 176 StructureConstructor::StructureConstructor( 177 const semantics::DerivedTypeSpec &spec, StructureConstructorValues &&values) 178 : result_{spec}, values_{std::move(values)} {} 179 180 bool StructureConstructor::operator==(const StructureConstructor &that) const { 181 return result_ == that.result_ && values_ == that.values_; 182 } 183 184 bool Relational<SomeType>::operator==(const Relational<SomeType> &that) const { 185 return u == that.u; 186 } 187 188 template <int KIND> 189 bool Expr<Type<TypeCategory::Integer, KIND>>::operator==( 190 const Expr<Type<TypeCategory::Integer, KIND>> &that) const { 191 return u == that.u; 192 } 193 194 template <int KIND> 195 bool Expr<Type<TypeCategory::Real, KIND>>::operator==( 196 const Expr<Type<TypeCategory::Real, KIND>> &that) const { 197 return u == that.u; 198 } 199 200 template <int KIND> 201 bool Expr<Type<TypeCategory::Complex, KIND>>::operator==( 202 const Expr<Type<TypeCategory::Complex, KIND>> &that) const { 203 return u == that.u; 204 } 205 206 template <int KIND> 207 bool Expr<Type<TypeCategory::Logical, KIND>>::operator==( 208 const Expr<Type<TypeCategory::Logical, KIND>> &that) const { 209 return u == that.u; 210 } 211 212 template <int KIND> 213 bool Expr<Type<TypeCategory::Character, KIND>>::operator==( 214 const Expr<Type<TypeCategory::Character, KIND>> &that) const { 215 return u == that.u; 216 } 217 218 template <TypeCategory CAT> 219 bool Expr<SomeKind<CAT>>::operator==(const Expr<SomeKind<CAT>> &that) const { 220 return u == that.u; 221 } 222 223 bool Expr<SomeDerived>::operator==(const Expr<SomeDerived> &that) const { 224 return u == that.u; 225 } 226 227 bool Expr<SomeCharacter>::operator==(const Expr<SomeCharacter> &that) const { 228 return u == that.u; 229 } 230 231 bool Expr<SomeType>::operator==(const Expr<SomeType> &that) const { 232 return u == that.u; 233 } 234 235 DynamicType StructureConstructor::GetType() const { return result_.GetType(); } 236 237 std::optional<Expr<SomeType>> StructureConstructor::CreateParentComponent( 238 const Symbol &component) const { 239 if (const semantics::DerivedTypeSpec * 240 parentSpec{GetParentTypeSpec(derivedTypeSpec())}) { 241 StructureConstructor structureConstructor{*parentSpec}; 242 if (const auto *parentDetails{ 243 component.detailsIf<semantics::DerivedTypeDetails>()}) { 244 auto parentIter{parentDetails->componentNames().begin()}; 245 for (const auto &childIter : values_) { 246 if (parentIter == parentDetails->componentNames().end()) { 247 break; // There are more components in the child 248 } 249 SymbolRef componentSymbol{childIter.first}; 250 structureConstructor.Add( 251 *componentSymbol, common::Clone(childIter.second.value())); 252 ++parentIter; 253 } 254 Constant<SomeDerived> constResult{std::move(structureConstructor)}; 255 Expr<SomeDerived> result{std::move(constResult)}; 256 return std::optional<Expr<SomeType>>{result}; 257 } 258 } 259 return std::nullopt; 260 } 261 262 static const Symbol *GetParentComponentSymbol(const Symbol &symbol) { 263 if (symbol.test(Symbol::Flag::ParentComp)) { 264 // we have a created parent component 265 const auto &compObject{symbol.get<semantics::ObjectEntityDetails>()}; 266 if (const semantics::DeclTypeSpec * compType{compObject.type()}) { 267 const semantics::DerivedTypeSpec &dtSpec{compType->derivedTypeSpec()}; 268 const semantics::Symbol &compTypeSymbol{dtSpec.typeSymbol()}; 269 return &compTypeSymbol; 270 } 271 } 272 if (symbol.detailsIf<semantics::DerivedTypeDetails>()) { 273 // we have an implicit parent type component 274 return &symbol; 275 } 276 return nullptr; 277 } 278 279 std::optional<Expr<SomeType>> StructureConstructor::Find( 280 const Symbol &component) const { 281 if (auto iter{values_.find(component)}; iter != values_.end()) { 282 return iter->second.value(); 283 } 284 // The component wasn't there directly, see if we're looking for the parent 285 // component of an extended type 286 if (const Symbol * typeSymbol{GetParentComponentSymbol(component)}) { 287 return CreateParentComponent(*typeSymbol); 288 } 289 // Look for the component in the parent type component. The parent type 290 // component is always the first one 291 if (!values_.empty()) { 292 const Expr<SomeType> *parentExpr{&values_.begin()->second.value()}; 293 if (const Expr<SomeDerived> *derivedExpr{ 294 std::get_if<Expr<SomeDerived>>(&parentExpr->u)}) { 295 if (const Constant<SomeDerived> *constExpr{ 296 std::get_if<Constant<SomeDerived>>(&derivedExpr->u)}) { 297 if (std::optional<StructureConstructor> parentComponentValue{ 298 constExpr->GetScalarValue()}) { 299 // Try to find the component in the parent structure constructor 300 return parentComponentValue->Find(component); 301 } 302 } 303 } 304 } 305 return std::nullopt; 306 } 307 308 StructureConstructor &StructureConstructor::Add( 309 const Symbol &symbol, Expr<SomeType> &&expr) { 310 values_.emplace(symbol, std::move(expr)); 311 return *this; 312 } 313 314 GenericExprWrapper::~GenericExprWrapper() {} 315 316 void GenericExprWrapper::Deleter(GenericExprWrapper *p) { delete p; } 317 318 GenericAssignmentWrapper::~GenericAssignmentWrapper() {} 319 320 void GenericAssignmentWrapper::Deleter(GenericAssignmentWrapper *p) { 321 delete p; 322 } 323 324 template <TypeCategory CAT> int Expr<SomeKind<CAT>>::GetKind() const { 325 return common::visit( 326 [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; }, 327 u); 328 } 329 330 int Expr<SomeCharacter>::GetKind() const { 331 return common::visit( 332 [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; }, 333 u); 334 } 335 336 std::optional<Expr<SubscriptInteger>> Expr<SomeCharacter>::LEN() const { 337 return common::visit([](const auto &kx) { return kx.LEN(); }, u); 338 } 339 340 #ifdef _MSC_VER // disable bogus warning about missing definitions 341 #pragma warning(disable : 4661) 342 #endif 343 INSTANTIATE_EXPRESSION_TEMPLATES 344 } // namespace Fortran::evaluate 345