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 template <typename A> int ExpressionBase<A>::Corank() const { 117 return common::visit( 118 [](const auto &x) { 119 if constexpr (common::HasMember<decltype(x), TypelessExpression>) { 120 return 0; 121 } else { 122 return x.Corank(); 123 } 124 }, 125 derived().u); 126 } 127 128 DynamicType Parentheses<SomeDerived>::GetType() const { 129 return left().GetType().value(); 130 } 131 132 #if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP) 133 template <typename A> LLVM_DUMP_METHOD void ExpressionBase<A>::dump() const { 134 llvm::errs() << "Expr is <{" << AsFortran() << "}>\n"; 135 } 136 #endif 137 138 // Equality testing 139 140 template <typename A> bool Extremum<A>::operator==(const Extremum &that) const { 141 return ordering == that.ordering && Base::operator==(that); 142 } 143 144 template <int KIND> 145 bool LogicalOperation<KIND>::operator==(const LogicalOperation &that) const { 146 return logicalOperator == that.logicalOperator && Base::operator==(that); 147 } 148 149 template <typename A> 150 bool Relational<A>::operator==(const Relational &that) const { 151 return opr == that.opr && Base::operator==(that); 152 } 153 154 bool Relational<SomeType>::operator==(const Relational &that) const { 155 return u == that.u; 156 } 157 158 bool ImpliedDoIndex::operator==(const ImpliedDoIndex &that) const { 159 return name == that.name; 160 } 161 162 template <typename T> 163 bool ImpliedDo<T>::operator==(const ImpliedDo<T> &that) const { 164 return name_ == that.name_ && lower_ == that.lower_ && 165 upper_ == that.upper_ && stride_ == that.stride_ && 166 values_ == that.values_; 167 } 168 169 template <typename T> 170 bool ArrayConstructorValue<T>::operator==( 171 const ArrayConstructorValue<T> &that) const { 172 return u == that.u; 173 } 174 175 template <typename R> 176 bool ArrayConstructorValues<R>::operator==( 177 const ArrayConstructorValues<R> &that) const { 178 return values_ == that.values_; 179 } 180 181 template <int KIND> 182 auto ArrayConstructor<Type<TypeCategory::Character, KIND>>::set_LEN( 183 Expr<SubscriptInteger> &&len) -> ArrayConstructor & { 184 length_.emplace(std::move(len)); 185 return *this; 186 } 187 188 template <int KIND> 189 bool ArrayConstructor<Type<TypeCategory::Character, KIND>>::operator==( 190 const ArrayConstructor &that) const { 191 return length_ == that.length_ && 192 static_cast<const Base &>(*this) == static_cast<const Base &>(that); 193 } 194 195 bool ArrayConstructor<SomeDerived>::operator==( 196 const ArrayConstructor &that) const { 197 return result_ == that.result_ && 198 static_cast<const Base &>(*this) == static_cast<const Base &>(that); 199 ; 200 } 201 202 StructureConstructor::StructureConstructor( 203 const semantics::DerivedTypeSpec &spec, 204 const StructureConstructorValues &values) 205 : result_{spec}, values_{values} {} 206 StructureConstructor::StructureConstructor( 207 const semantics::DerivedTypeSpec &spec, StructureConstructorValues &&values) 208 : result_{spec}, values_{std::move(values)} {} 209 210 bool StructureConstructor::operator==(const StructureConstructor &that) const { 211 return result_ == that.result_ && values_ == that.values_; 212 } 213 214 template <int KIND> 215 bool Expr<Type<TypeCategory::Integer, KIND>>::operator==( 216 const Expr<Type<TypeCategory::Integer, KIND>> &that) const { 217 return u == that.u; 218 } 219 220 template <int KIND> 221 bool Expr<Type<TypeCategory::Real, KIND>>::operator==( 222 const Expr<Type<TypeCategory::Real, KIND>> &that) const { 223 return u == that.u; 224 } 225 226 template <int KIND> 227 bool Expr<Type<TypeCategory::Complex, KIND>>::operator==( 228 const Expr<Type<TypeCategory::Complex, KIND>> &that) const { 229 return u == that.u; 230 } 231 232 template <int KIND> 233 bool Expr<Type<TypeCategory::Logical, KIND>>::operator==( 234 const Expr<Type<TypeCategory::Logical, KIND>> &that) const { 235 return u == that.u; 236 } 237 238 template <int KIND> 239 bool Expr<Type<TypeCategory::Character, KIND>>::operator==( 240 const Expr<Type<TypeCategory::Character, KIND>> &that) const { 241 return u == that.u; 242 } 243 244 template <int KIND> 245 bool Expr<Type<TypeCategory::Unsigned, KIND>>::operator==( 246 const Expr<Type<TypeCategory::Unsigned, KIND>> &that) const { 247 return u == that.u; 248 } 249 250 template <TypeCategory CAT> 251 bool Expr<SomeKind<CAT>>::operator==(const Expr<SomeKind<CAT>> &that) const { 252 return u == that.u; 253 } 254 255 bool Expr<SomeDerived>::operator==(const Expr<SomeDerived> &that) const { 256 return u == that.u; 257 } 258 259 bool Expr<SomeCharacter>::operator==(const Expr<SomeCharacter> &that) const { 260 return u == that.u; 261 } 262 263 bool Expr<SomeType>::operator==(const Expr<SomeType> &that) const { 264 return u == that.u; 265 } 266 267 DynamicType StructureConstructor::GetType() const { return result_.GetType(); } 268 269 std::optional<Expr<SomeType>> StructureConstructor::CreateParentComponent( 270 const Symbol &component) const { 271 if (const semantics::DerivedTypeSpec * 272 parentSpec{GetParentTypeSpec(derivedTypeSpec())}) { 273 StructureConstructor structureConstructor{*parentSpec}; 274 if (const auto *parentDetails{ 275 component.detailsIf<semantics::DerivedTypeDetails>()}) { 276 auto parentIter{parentDetails->componentNames().begin()}; 277 for (const auto &childIter : values_) { 278 if (parentIter == parentDetails->componentNames().end()) { 279 break; // There are more components in the child 280 } 281 SymbolRef componentSymbol{childIter.first}; 282 structureConstructor.Add( 283 *componentSymbol, common::Clone(childIter.second.value())); 284 ++parentIter; 285 } 286 Constant<SomeDerived> constResult{std::move(structureConstructor)}; 287 Expr<SomeDerived> result{std::move(constResult)}; 288 return std::optional<Expr<SomeType>>{result}; 289 } 290 } 291 return std::nullopt; 292 } 293 294 static const Symbol *GetParentComponentSymbol(const Symbol &symbol) { 295 if (symbol.test(Symbol::Flag::ParentComp)) { 296 // we have a created parent component 297 const auto &compObject{symbol.get<semantics::ObjectEntityDetails>()}; 298 if (const semantics::DeclTypeSpec * compType{compObject.type()}) { 299 const semantics::DerivedTypeSpec &dtSpec{compType->derivedTypeSpec()}; 300 const semantics::Symbol &compTypeSymbol{dtSpec.typeSymbol()}; 301 return &compTypeSymbol; 302 } 303 } 304 if (symbol.detailsIf<semantics::DerivedTypeDetails>()) { 305 // we have an implicit parent type component 306 return &symbol; 307 } 308 return nullptr; 309 } 310 311 std::optional<Expr<SomeType>> StructureConstructor::Find( 312 const Symbol &component) const { 313 if (auto iter{values_.find(component)}; iter != values_.end()) { 314 return iter->second.value(); 315 } 316 // The component wasn't there directly, see if we're looking for the parent 317 // component of an extended type 318 if (const Symbol * typeSymbol{GetParentComponentSymbol(component)}) { 319 return CreateParentComponent(*typeSymbol); 320 } 321 // Look for the component in the parent type component. The parent type 322 // component is always the first one 323 if (!values_.empty()) { 324 const Expr<SomeType> *parentExpr{&values_.begin()->second.value()}; 325 if (const Expr<SomeDerived> *derivedExpr{ 326 std::get_if<Expr<SomeDerived>>(&parentExpr->u)}) { 327 if (const Constant<SomeDerived> *constExpr{ 328 std::get_if<Constant<SomeDerived>>(&derivedExpr->u)}) { 329 if (std::optional<StructureConstructor> parentComponentValue{ 330 constExpr->GetScalarValue()}) { 331 // Try to find the component in the parent structure constructor 332 return parentComponentValue->Find(component); 333 } 334 } 335 } 336 } 337 return std::nullopt; 338 } 339 340 StructureConstructor &StructureConstructor::Add( 341 const Symbol &symbol, Expr<SomeType> &&expr) { 342 values_.emplace(symbol, std::move(expr)); 343 return *this; 344 } 345 346 GenericExprWrapper::~GenericExprWrapper() {} 347 348 void GenericExprWrapper::Deleter(GenericExprWrapper *p) { delete p; } 349 350 GenericAssignmentWrapper::~GenericAssignmentWrapper() {} 351 352 void GenericAssignmentWrapper::Deleter(GenericAssignmentWrapper *p) { 353 delete p; 354 } 355 356 template <TypeCategory CAT> int Expr<SomeKind<CAT>>::GetKind() const { 357 return common::visit( 358 [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; }, 359 u); 360 } 361 362 int Expr<SomeCharacter>::GetKind() const { 363 return common::visit( 364 [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; }, 365 u); 366 } 367 368 std::optional<Expr<SubscriptInteger>> Expr<SomeCharacter>::LEN() const { 369 return common::visit([](const auto &kx) { return kx.LEN(); }, u); 370 } 371 372 #ifdef _MSC_VER // disable bogus warning about missing definitions 373 #pragma warning(disable : 4661) 374 #endif 375 INSTANTIATE_EXPRESSION_TEMPLATES 376 } // namespace Fortran::evaluate 377