377 lines · cpp
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-exception6//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 25using namespace Fortran::parser::literals;26 27namespace Fortran::evaluate {28 29template <int KIND>30std::optional<Expr<SubscriptInteger>>31Expr<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 74Expr<SomeType>::~Expr() = default;75 76#if defined(__APPLE__) && defined(__GNUC__)77template <typename A>78typename ExpressionBase<A>::Derived &ExpressionBase<A>::derived() {79 return *static_cast<Derived *>(this);80}81 82template <typename A>83const typename ExpressionBase<A>::Derived &ExpressionBase<A>::derived() const {84 return *static_cast<const Derived *>(this);85}86#endif87 88template <typename A>89std::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 warning99 },100 derived().u);101 }102}103 104template <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 116template <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 128DynamicType Parentheses<SomeDerived>::GetType() const {129 return left().GetType().value();130}131 132#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)133template <typename A> LLVM_DUMP_METHOD void ExpressionBase<A>::dump() const {134 llvm::errs() << "Expr is <{" << AsFortran() << "}>\n";135}136#endif137 138// Equality testing139 140template <typename A> bool Extremum<A>::operator==(const Extremum &that) const {141 return ordering == that.ordering && Base::operator==(that);142}143 144template <int KIND>145bool LogicalOperation<KIND>::operator==(const LogicalOperation &that) const {146 return logicalOperator == that.logicalOperator && Base::operator==(that);147}148 149template <typename A>150bool Relational<A>::operator==(const Relational &that) const {151 return opr == that.opr && Base::operator==(that);152}153 154bool Relational<SomeType>::operator==(const Relational &that) const {155 return u == that.u;156}157 158bool ImpliedDoIndex::operator==(const ImpliedDoIndex &that) const {159 return name == that.name;160}161 162template <typename T>163bool 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 169template <typename T>170bool ArrayConstructorValue<T>::operator==(171 const ArrayConstructorValue<T> &that) const {172 return u == that.u;173}174 175template <typename R>176bool ArrayConstructorValues<R>::operator==(177 const ArrayConstructorValues<R> &that) const {178 return values_ == that.values_;179}180 181template <int KIND>182auto ArrayConstructor<Type<TypeCategory::Character, KIND>>::set_LEN(183 Expr<SubscriptInteger> &&len) -> ArrayConstructor & {184 length_.emplace(std::move(len));185 return *this;186}187 188template <int KIND>189bool 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 195bool 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 202StructureConstructor::StructureConstructor(203 const semantics::DerivedTypeSpec &spec,204 const StructureConstructorValues &values)205 : result_{spec}, values_{values} {}206StructureConstructor::StructureConstructor(207 const semantics::DerivedTypeSpec &spec, StructureConstructorValues &&values)208 : result_{spec}, values_{std::move(values)} {}209 210bool StructureConstructor::operator==(const StructureConstructor &that) const {211 return result_ == that.result_ && values_ == that.values_;212}213 214template <int KIND>215bool Expr<Type<TypeCategory::Integer, KIND>>::operator==(216 const Expr<Type<TypeCategory::Integer, KIND>> &that) const {217 return u == that.u;218}219 220template <int KIND>221bool Expr<Type<TypeCategory::Real, KIND>>::operator==(222 const Expr<Type<TypeCategory::Real, KIND>> &that) const {223 return u == that.u;224}225 226template <int KIND>227bool Expr<Type<TypeCategory::Complex, KIND>>::operator==(228 const Expr<Type<TypeCategory::Complex, KIND>> &that) const {229 return u == that.u;230}231 232template <int KIND>233bool Expr<Type<TypeCategory::Logical, KIND>>::operator==(234 const Expr<Type<TypeCategory::Logical, KIND>> &that) const {235 return u == that.u;236}237 238template <int KIND>239bool Expr<Type<TypeCategory::Character, KIND>>::operator==(240 const Expr<Type<TypeCategory::Character, KIND>> &that) const {241 return u == that.u;242}243 244template <int KIND>245bool Expr<Type<TypeCategory::Unsigned, KIND>>::operator==(246 const Expr<Type<TypeCategory::Unsigned, KIND>> &that) const {247 return u == that.u;248}249 250template <TypeCategory CAT>251bool Expr<SomeKind<CAT>>::operator==(const Expr<SomeKind<CAT>> &that) const {252 return u == that.u;253}254 255bool Expr<SomeDerived>::operator==(const Expr<SomeDerived> &that) const {256 return u == that.u;257}258 259bool Expr<SomeCharacter>::operator==(const Expr<SomeCharacter> &that) const {260 return u == that.u;261}262 263bool Expr<SomeType>::operator==(const Expr<SomeType> &that) const {264 return u == that.u;265}266 267DynamicType StructureConstructor::GetType() const { return result_.GetType(); }268 269std::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 child280 }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 294static const Symbol *GetParentComponentSymbol(const Symbol &symbol) {295 if (symbol.test(Symbol::Flag::ParentComp)) {296 // we have a created parent component297 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 component306 return &symbol;307 }308 return nullptr;309}310 311std::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 parent317 // component of an extended type318 if (const Symbol * typeSymbol{GetParentComponentSymbol(component)}) {319 return CreateParentComponent(*typeSymbol);320 }321 // Look for the component in the parent type component. The parent type322 // component is always the first one323 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 constructor332 return parentComponentValue->Find(component);333 }334 }335 }336 }337 return std::nullopt;338}339 340StructureConstructor &StructureConstructor::Add(341 const Symbol &symbol, Expr<SomeType> &&expr) {342 values_.emplace(symbol, std::move(expr));343 return *this;344}345 346GenericExprWrapper::~GenericExprWrapper() {}347 348void GenericExprWrapper::Deleter(GenericExprWrapper *p) { delete p; }349 350GenericAssignmentWrapper::~GenericAssignmentWrapper() {}351 352void GenericAssignmentWrapper::Deleter(GenericAssignmentWrapper *p) {353 delete p;354}355 356template <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 362int Expr<SomeCharacter>::GetKind() const {363 return common::visit(364 [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; },365 u);366}367 368std::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 definitions373#pragma warning(disable : 4661)374#endif375INSTANTIATE_EXPRESSION_TEMPLATES376} // namespace Fortran::evaluate377