//===-- lib/Evaluate/variable.cpp -----------------------------------------===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// #include "flang/Evaluate/variable.h" #include "flang/Common/idioms.h" #include "flang/Evaluate/check-expression.h" #include "flang/Evaluate/fold.h" #include "flang/Evaluate/tools.h" #include "flang/Parser/char-block.h" #include "flang/Parser/characters.h" #include "flang/Parser/message.h" #include "flang/Semantics/symbol.h" #include using namespace Fortran::parser::literals; namespace Fortran::evaluate { // Constructors, accessors, mutators Triplet::Triplet() : stride_{Expr{1}} {} Triplet::Triplet(std::optional> &&l, std::optional> &&u, std::optional> &&s) : stride_{s ? std::move(*s) : Expr{1}} { if (l) { lower_.emplace(std::move(*l)); } if (u) { upper_.emplace(std::move(*u)); } } std::optional> Triplet::lower() const { if (lower_) { return {lower_.value().value()}; } return std::nullopt; } Triplet &Triplet::set_lower(Expr &&expr) { lower_.emplace(std::move(expr)); return *this; } std::optional> Triplet::upper() const { if (upper_) { return {upper_.value().value()}; } return std::nullopt; } Triplet &Triplet::set_upper(Expr &&expr) { upper_.emplace(std::move(expr)); return *this; } Expr Triplet::stride() const { return stride_.value(); } Triplet &Triplet::set_stride(Expr &&expr) { stride_.value() = std::move(expr); return *this; } bool Triplet::IsStrideOne() const { if (auto stride{ToInt64(stride_.value())}) { return stride == 1; } else { return false; } } CoarrayRef::CoarrayRef(SymbolVector &&base, std::vector &&ss, std::vector> &&css) : base_{std::move(base)}, subscript_(std::move(ss)), cosubscript_(std::move(css)) { CHECK(!base_.empty()); CHECK(!cosubscript_.empty()); } std::optional> CoarrayRef::stat() const { if (stat_) { return stat_.value().value(); } else { return std::nullopt; } } std::optional> CoarrayRef::team() const { if (team_) { return team_.value().value(); } else { return std::nullopt; } } CoarrayRef &CoarrayRef::set_stat(Expr &&v) { CHECK(IsVariable(v)); stat_.emplace(std::move(v)); return *this; } CoarrayRef &CoarrayRef::set_team(Expr &&v, bool isTeamNumber) { CHECK(IsVariable(v)); team_.emplace(std::move(v)); teamIsTeamNumber_ = isTeamNumber; return *this; } const Symbol &CoarrayRef::GetFirstSymbol() const { return base_.front(); } const Symbol &CoarrayRef::GetLastSymbol() const { return base_.back(); } void Substring::SetBounds(std::optional> &lower, std::optional> &upper) { if (lower) { set_lower(std::move(lower.value())); } if (upper) { set_upper(std::move(upper.value())); } } Expr Substring::lower() const { if (lower_) { return lower_.value().value(); } else { return AsExpr(Constant{1}); } } Substring &Substring::set_lower(Expr &&expr) { lower_.emplace(std::move(expr)); return *this; } std::optional> Substring::upper() const { if (upper_) { return upper_.value().value(); } else { return std::visit( common::visitors{ [](const DataRef &dataRef) { return dataRef.LEN(); }, [](const StaticDataObject::Pointer &object) -> std::optional> { return AsExpr(Constant{object->data().size()}); }, }, parent_); } } Substring &Substring::set_upper(Expr &&expr) { upper_.emplace(std::move(expr)); return *this; } std::optional> Substring::Fold(FoldingContext &context) { if (!lower_) { lower_ = AsExpr(Constant{1}); } lower_.value() = evaluate::Fold(context, std::move(lower_.value().value())); std::optional lbi{ToInt64(lower_.value().value())}; if (lbi && *lbi < 1) { context.messages().Say( "Lower bound (%jd) on substring is less than one"_en_US, *lbi); *lbi = 1; lower_ = AsExpr(Constant{1}); } if (!upper_) { upper_ = upper(); if (!upper_) { return std::nullopt; } } upper_.value() = evaluate::Fold(context, std::move(upper_.value().value())); if (std::optional ubi{ToInt64(upper_.value().value())}) { auto *literal{std::get_if(&parent_)}; std::optional length; if (literal) { length = (*literal)->data().size(); } else if (const Symbol * symbol{GetLastSymbol()}) { if (const semantics::DeclTypeSpec * type{symbol->GetType()}) { if (type->category() == semantics::DeclTypeSpec::Character) { length = ToInt64(type->characterTypeSpec().length().GetExplicit()); } } } if (*ubi < 1 || (lbi && *ubi < *lbi)) { // Zero-length string: canonicalize *lbi = 1, *ubi = 0; lower_ = AsExpr(Constant{*lbi}); upper_ = AsExpr(Constant{*ubi}); } else if (length && *ubi > *length) { context.messages().Say("Upper bound (%jd) on substring is greater " "than character length (%jd)"_en_US, *ubi, *length); *ubi = *length; } if (lbi && literal) { auto newStaticData{StaticDataObject::Create()}; auto items{0}; // If the lower bound is greater, the length is 0 if (*ubi >= *lbi) { items = *ubi - *lbi + 1; } auto width{(*literal)->itemBytes()}; auto bytes{items * width}; auto startByte{(*lbi - 1) * width}; const auto *from{&(*literal)->data()[0] + startByte}; for (auto j{0}; j < bytes; ++j) { newStaticData->data().push_back(from[j]); } parent_ = newStaticData; lower_ = AsExpr(Constant{1}); ConstantSubscript length = newStaticData->data().size(); upper_ = AsExpr(Constant{length}); switch (width) { case 1: return { AsCategoryExpr(AsExpr(Constant>{ *newStaticData->AsString()}))}; case 2: return {AsCategoryExpr(Constant>{ *newStaticData->AsU16String()})}; case 4: return {AsCategoryExpr(Constant>{ *newStaticData->AsU32String()})}; default: CRASH_NO_CASE; } } } return std::nullopt; } DescriptorInquiry::DescriptorInquiry( const NamedEntity &base, Field field, int dim) : base_{base}, field_{field}, dimension_{dim} { const Symbol &last{base_.GetLastSymbol()}; CHECK(IsDescriptor(last)); CHECK((field == Field::Len && dim == 0) || (field != Field::Len && dim >= 0 && dim < last.Rank())); } DescriptorInquiry::DescriptorInquiry(NamedEntity &&base, Field field, int dim) : base_{std::move(base)}, field_{field}, dimension_{dim} { const Symbol &last{base_.GetLastSymbol()}; CHECK(IsDescriptor(last)); CHECK((field == Field::Len && dim == 0) || (field != Field::Len && dim >= 0 && dim < last.Rank())); } // LEN() static std::optional> SymbolLEN(const Symbol &sym) { if (auto dyType{DynamicType::From(sym)}) { if (const semantics::ParamValue * len{dyType->charLength()}) { if (len->isExplicit()) { if (auto intExpr{len->GetExplicit()}) { if (IsConstantExpr(*intExpr)) { return ConvertToType(*std::move(intExpr)); } } } return Expr{ DescriptorInquiry{NamedEntity{sym}, DescriptorInquiry::Field::Len}}; } } return std::nullopt; } std::optional> BaseObject::LEN() const { return std::visit( common::visitors{ [](const Symbol &symbol) { return SymbolLEN(symbol); }, [](const StaticDataObject::Pointer &object) -> std::optional> { return AsExpr(Constant{object->data().size()}); }, }, u); } std::optional> Component::LEN() const { return SymbolLEN(GetLastSymbol()); } std::optional> NamedEntity::LEN() const { return SymbolLEN(GetLastSymbol()); } std::optional> ArrayRef::LEN() const { return base_.LEN(); } std::optional> CoarrayRef::LEN() const { return SymbolLEN(GetLastSymbol()); } std::optional> DataRef::LEN() const { return std::visit(common::visitors{ [](SymbolRef symbol) { return SymbolLEN(symbol); }, [](const auto &x) { return x.LEN(); }, }, u); } std::optional> Substring::LEN() const { if (auto top{upper()}) { return AsExpr(Extremum{Ordering::Greater, AsExpr(Constant{0}), *std::move(top) - lower() + AsExpr(Constant{1})}); } else { return std::nullopt; } } template std::optional> Designator::LEN() const { if constexpr (T::category == TypeCategory::Character) { return std::visit(common::visitors{ [](SymbolRef symbol) { return SymbolLEN(symbol); }, [](const auto &x) { return x.LEN(); }, }, u); } else { common::die("Designator::LEN() called"); return std::nullopt; } } std::optional> ProcedureDesignator::LEN() const { using T = std::optional>; return std::visit( common::visitors{ [](SymbolRef symbol) -> T { return SymbolLEN(symbol); }, [](const common::CopyableIndirection &c) -> T { return c.value().LEN(); }, [](const SpecificIntrinsic &i) -> T { if (i.name == "char") { return Expr{1}; } // Some other cases whose results' lengths can be determined // from the lengths of their arguments are handled in // ProcedureRef::LEN(). return std::nullopt; }, }, u); } // Rank() int BaseObject::Rank() const { return std::visit(common::visitors{ [](SymbolRef symbol) { return symbol->Rank(); }, [](const StaticDataObject::Pointer &) { return 0; }, }, u); } int Component::Rank() const { if (int rank{symbol_->Rank()}; rank > 0) { return rank; } return base().Rank(); } int NamedEntity::Rank() const { return std::visit(common::visitors{ [](const SymbolRef s) { return s->Rank(); }, [](const Component &c) { return c.Rank(); }, }, u_); } int Subscript::Rank() const { return std::visit(common::visitors{ [](const IndirectSubscriptIntegerExpr &x) { return x.value().Rank(); }, [](const Triplet &) { return 1; }, }, u); } int ArrayRef::Rank() const { int rank{0}; for (const auto &expr : subscript_) { rank += expr.Rank(); } if (rank > 0) { return rank; } else if (const Component * component{base_.UnwrapComponent()}) { return component->base().Rank(); } else { return 0; } } int CoarrayRef::Rank() const { if (!subscript_.empty()) { int rank{0}; for (const auto &expr : subscript_) { rank += expr.Rank(); } return rank; } else { return base_.back()->Rank(); } } int DataRef::Rank() const { return std::visit(common::visitors{ [](SymbolRef symbol) { return symbol->Rank(); }, [](const auto &x) { return x.Rank(); }, }, u); } int Substring::Rank() const { return std::visit(common::visitors{ [](const DataRef &dataRef) { return dataRef.Rank(); }, [](const StaticDataObject::Pointer &) { return 0; }, }, parent_); } int ComplexPart::Rank() const { return complex_.Rank(); } template int Designator::Rank() const { return std::visit(common::visitors{ [](SymbolRef symbol) { return symbol->Rank(); }, [](const auto &x) { return x.Rank(); }, }, u); } // GetBaseObject(), GetFirstSymbol(), GetLastSymbol(), &c. const Symbol &Component::GetFirstSymbol() const { return base_.value().GetFirstSymbol(); } const Symbol &NamedEntity::GetFirstSymbol() const { return std::visit(common::visitors{ [](SymbolRef s) -> const Symbol & { return s; }, [](const Component &c) -> const Symbol & { return c.GetFirstSymbol(); }, }, u_); } const Symbol &NamedEntity::GetLastSymbol() const { return std::visit(common::visitors{ [](SymbolRef s) -> const Symbol & { return s; }, [](const Component &c) -> const Symbol & { return c.GetLastSymbol(); }, }, u_); } const Component *NamedEntity::UnwrapComponent() const { return std::visit(common::visitors{ [](SymbolRef) -> const Component * { return nullptr; }, [](const Component &c) { return &c; }, }, u_); } Component *NamedEntity::UnwrapComponent() { return std::visit(common::visitors{ [](SymbolRef &) -> Component * { return nullptr; }, [](Component &c) { return &c; }, }, u_); } const Symbol &ArrayRef::GetFirstSymbol() const { return base_.GetFirstSymbol(); } const Symbol &ArrayRef::GetLastSymbol() const { return base_.GetLastSymbol(); } const Symbol &DataRef::GetFirstSymbol() const { return *std::visit(common::visitors{ [](SymbolRef symbol) { return &*symbol; }, [](const auto &x) { return &x.GetFirstSymbol(); }, }, u); } const Symbol &DataRef::GetLastSymbol() const { return *std::visit(common::visitors{ [](SymbolRef symbol) { return &*symbol; }, [](const auto &x) { return &x.GetLastSymbol(); }, }, u); } BaseObject Substring::GetBaseObject() const { return std::visit(common::visitors{ [](const DataRef &dataRef) { return BaseObject{dataRef.GetFirstSymbol()}; }, [](StaticDataObject::Pointer pointer) { return BaseObject{std::move(pointer)}; }, }, parent_); } const Symbol *Substring::GetLastSymbol() const { return std::visit( common::visitors{ [](const DataRef &dataRef) { return &dataRef.GetLastSymbol(); }, [](const auto &) -> const Symbol * { return nullptr; }, }, parent_); } template BaseObject Designator::GetBaseObject() const { return std::visit( common::visitors{ [](SymbolRef symbol) { return BaseObject{symbol}; }, [](const Substring &sstring) { return sstring.GetBaseObject(); }, [](const auto &x) { #if !__clang__ && __GNUC__ == 7 && __GNUC_MINOR__ == 2 if constexpr (std::is_same_v, Substring>) { return x.GetBaseObject(); } else #endif return BaseObject{x.GetFirstSymbol()}; }, }, u); } template const Symbol *Designator::GetLastSymbol() const { return std::visit( common::visitors{ [](SymbolRef symbol) { return &*symbol; }, [](const Substring &sstring) { return sstring.GetLastSymbol(); }, [](const auto &x) { #if !__clang__ && __GNUC__ == 7 && __GNUC_MINOR__ == 2 if constexpr (std::is_same_v, Substring>) { return x.GetLastSymbol(); } else #endif return &x.GetLastSymbol(); }, }, u); } template std::optional Designator::GetType() const { if constexpr (IsLengthlessIntrinsicType) { return Result::GetType(); } else if (const Symbol * symbol{GetLastSymbol()}) { return DynamicType::From(*symbol); } else if constexpr (Result::category == TypeCategory::Character) { if (const Substring * substring{std::get_if(&u)}) { const auto *parent{substring->GetParentIf()}; CHECK(parent); return DynamicType{TypeCategory::Character, (*parent)->itemBytes()}; } } return std::nullopt; } static NamedEntity AsNamedEntity(const SymbolVector &x) { CHECK(!x.empty()); NamedEntity result{x.front()}; int j{0}; for (const Symbol &symbol : x) { if (j++ != 0) { DataRef base{result.IsSymbol() ? DataRef{result.GetLastSymbol()} : DataRef{result.GetComponent()}}; result = NamedEntity{Component{std::move(base), symbol}}; } } return result; } NamedEntity CoarrayRef::GetBase() const { return AsNamedEntity(base_); } // Equality testing // For the purposes of comparing type parameter expressions while // testing the compatibility of procedure characteristics, two // object dummy arguments with the same name are considered equal. static bool AreSameSymbol(const Symbol &x, const Symbol &y) { if (&x == &y) { return true; } if (x.name() == y.name()) { if (const auto *xObject{x.detailsIf()}) { if (const auto *yObject{y.detailsIf()}) { return xObject->isDummy() && yObject->isDummy(); } } } return false; } // Implements operator==() for a union type, using special case handling // for Symbol references. template static bool TestVariableEquality(const A &x, const A &y) { const SymbolRef *xSymbol{std::get_if(&x.u)}; if (const SymbolRef * ySymbol{std::get_if(&y.u)}) { return xSymbol && AreSameSymbol(*xSymbol, *ySymbol); } else { return x.u == y.u; } } bool BaseObject::operator==(const BaseObject &that) const { return TestVariableEquality(*this, that); } bool Component::operator==(const Component &that) const { return base_ == that.base_ && &*symbol_ == &*that.symbol_; } bool NamedEntity::operator==(const NamedEntity &that) const { if (IsSymbol()) { return that.IsSymbol() && AreSameSymbol(GetFirstSymbol(), that.GetFirstSymbol()); } else { return !that.IsSymbol() && GetComponent() == that.GetComponent(); } } bool TypeParamInquiry::operator==(const TypeParamInquiry &that) const { return &*parameter_ == &*that.parameter_ && base_ == that.base_; } bool Triplet::operator==(const Triplet &that) const { return lower_ == that.lower_ && upper_ == that.upper_ && stride_ == that.stride_; } bool Subscript::operator==(const Subscript &that) const { return u == that.u; } bool ArrayRef::operator==(const ArrayRef &that) const { return base_ == that.base_ && subscript_ == that.subscript_; } bool CoarrayRef::operator==(const CoarrayRef &that) const { return base_ == that.base_ && subscript_ == that.subscript_ && cosubscript_ == that.cosubscript_ && stat_ == that.stat_ && team_ == that.team_ && teamIsTeamNumber_ == that.teamIsTeamNumber_; } bool DataRef::operator==(const DataRef &that) const { return TestVariableEquality(*this, that); } bool Substring::operator==(const Substring &that) const { return parent_ == that.parent_ && lower_ == that.lower_ && upper_ == that.upper_; } bool ComplexPart::operator==(const ComplexPart &that) const { return part_ == that.part_ && complex_ == that.complex_; } bool ProcedureRef::operator==(const ProcedureRef &that) const { return proc_ == that.proc_ && arguments_ == that.arguments_; } template bool Designator::operator==(const Designator &that) const { return TestVariableEquality(*this, that); } bool DescriptorInquiry::operator==(const DescriptorInquiry &that) const { return field_ == that.field_ && base_ == that.base_ && dimension_ == that.dimension_; } INSTANTIATE_VARIABLE_TEMPLATES } // namespace Fortran::evaluate template class Fortran::common::Indirection;