Peter Klausler 9e855a6cb8 [flang] Map symbols in expressions when copying interface symbols
Given a MODULE SUBROUTINE or MODULE FUNCTION interface followed
later by a corresponding separate module subprogram definition in a
MODULE PROCEDURE, the copies of the interface's dummy argument and
function result symbols that populate the initial scope of that
MODULE PROCEDURE need to have any symbol references in their types
or bounds adjusted to point to their new counterparts.

Differential Revision: https://reviews.llvm.org/D139200
2022-12-05 07:33:57 -08:00

709 lines
22 KiB
C++

//===-- 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/scope.h"
#include "flang/Semantics/symbol.h"
#include <type_traits>
using namespace Fortran::parser::literals;
namespace Fortran::evaluate {
// Constructors, accessors, mutators
Triplet::Triplet() : stride_{Expr<SubscriptInteger>{1}} {}
Triplet::Triplet(std::optional<Expr<SubscriptInteger>> &&l,
std::optional<Expr<SubscriptInteger>> &&u,
std::optional<Expr<SubscriptInteger>> &&s)
: stride_{s ? std::move(*s) : Expr<SubscriptInteger>{1}} {
if (l) {
lower_.emplace(std::move(*l));
}
if (u) {
upper_.emplace(std::move(*u));
}
}
std::optional<Expr<SubscriptInteger>> Triplet::lower() const {
if (lower_) {
return {lower_.value().value()};
}
return std::nullopt;
}
Triplet &Triplet::set_lower(Expr<SubscriptInteger> &&expr) {
lower_.emplace(std::move(expr));
return *this;
}
std::optional<Expr<SubscriptInteger>> Triplet::upper() const {
if (upper_) {
return {upper_.value().value()};
}
return std::nullopt;
}
Triplet &Triplet::set_upper(Expr<SubscriptInteger> &&expr) {
upper_.emplace(std::move(expr));
return *this;
}
Expr<SubscriptInteger> Triplet::stride() const { return stride_.value(); }
Triplet &Triplet::set_stride(Expr<SubscriptInteger> &&expr) {
stride_.value() = std::move(expr);
return *this;
}
CoarrayRef::CoarrayRef(SymbolVector &&base, std::vector<Subscript> &&ss,
std::vector<Expr<SubscriptInteger>> &&css)
: base_{std::move(base)}, subscript_(std::move(ss)),
cosubscript_(std::move(css)) {
CHECK(!base_.empty());
CHECK(!cosubscript_.empty());
}
std::optional<Expr<SomeInteger>> CoarrayRef::stat() const {
if (stat_) {
return stat_.value().value();
} else {
return std::nullopt;
}
}
std::optional<Expr<SomeInteger>> CoarrayRef::team() const {
if (team_) {
return team_.value().value();
} else {
return std::nullopt;
}
}
CoarrayRef &CoarrayRef::set_stat(Expr<SomeInteger> &&v) {
CHECK(IsVariable(v));
stat_.emplace(std::move(v));
return *this;
}
CoarrayRef &CoarrayRef::set_team(Expr<SomeInteger> &&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<Expr<SubscriptInteger>> &lower,
std::optional<Expr<SubscriptInteger>> &upper) {
if (lower) {
set_lower(std::move(lower.value()));
}
if (upper) {
set_upper(std::move(upper.value()));
}
}
Expr<SubscriptInteger> Substring::lower() const {
if (lower_) {
return lower_.value().value();
} else {
return AsExpr(Constant<SubscriptInteger>{1});
}
}
Substring &Substring::set_lower(Expr<SubscriptInteger> &&expr) {
lower_.emplace(std::move(expr));
return *this;
}
std::optional<Expr<SubscriptInteger>> Substring::upper() const {
if (upper_) {
return upper_.value().value();
} else {
return common::visit(
common::visitors{
[](const DataRef &dataRef) { return dataRef.LEN(); },
[](const StaticDataObject::Pointer &object)
-> std::optional<Expr<SubscriptInteger>> {
return AsExpr(Constant<SubscriptInteger>{object->data().size()});
},
},
parent_);
}
}
Substring &Substring::set_upper(Expr<SubscriptInteger> &&expr) {
upper_.emplace(std::move(expr));
return *this;
}
std::optional<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) {
if (!upper_) {
upper_ = upper();
if (!upper_) {
return std::nullopt;
}
}
upper_.value() = evaluate::Fold(context, std::move(upper_.value().value()));
std::optional<ConstantSubscript> ubi{ToInt64(upper_.value().value())};
if (!ubi) {
return std::nullopt;
}
if (!lower_) {
lower_ = AsExpr(Constant<SubscriptInteger>{1});
}
lower_.value() = evaluate::Fold(context, std::move(lower_.value().value()));
std::optional<ConstantSubscript> lbi{ToInt64(lower_.value().value())};
if (!lbi) {
return std::nullopt;
}
if (*lbi > *ubi) { // empty result; canonicalize
*lbi = 1;
*ubi = 0;
lower_ = AsExpr(Constant<SubscriptInteger>{*lbi});
upper_ = AsExpr(Constant<SubscriptInteger>{*ubi});
}
std::optional<ConstantSubscript> length;
std::optional<Expr<SomeCharacter>> strings; // a Constant<Character>
if (const auto *literal{std::get_if<StaticDataObject::Pointer>(&parent_)}) {
length = (*literal)->data().size();
if (auto str{(*literal)->AsString()}) {
strings =
Expr<SomeCharacter>(Expr<Ascii>(Constant<Ascii>{std::move(*str)}));
}
} else if (const auto *dataRef{std::get_if<DataRef>(&parent_)}) {
if (auto expr{AsGenericExpr(DataRef{*dataRef})}) {
auto folded{evaluate::Fold(context, std::move(*expr))};
if (IsActuallyConstant(folded)) {
if (const auto *value{UnwrapExpr<Expr<SomeCharacter>>(folded)}) {
strings = *value;
}
}
}
}
std::optional<Expr<SomeCharacter>> result;
if (strings) {
result = common::visit(
[&](const auto &expr) -> std::optional<Expr<SomeCharacter>> {
using Type = typename std::decay_t<decltype(expr)>::Result;
if (const auto *cc{std::get_if<Constant<Type>>(&expr.u)}) {
if (auto substr{cc->Substring(*lbi, *ubi)}) {
return Expr<SomeCharacter>{Expr<Type>{*substr}};
}
}
return std::nullopt;
},
strings->u);
}
if (!result) { // error cases
if (*lbi < 1) {
context.messages().Say(
"Lower bound (%jd) on substring is less than one"_warn_en_US,
static_cast<std::intmax_t>(*lbi));
*lbi = 1;
lower_ = AsExpr(Constant<SubscriptInteger>{1});
}
if (length && *ubi > *length) {
context.messages().Say(
"Upper bound (%jd) on substring is greater than character length (%jd)"_warn_en_US,
static_cast<std::intmax_t>(*ubi),
static_cast<std::intmax_t>(*length));
*ubi = *length;
upper_ = AsExpr(Constant<SubscriptInteger>{*ubi});
}
}
return result;
}
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 || field == Field::Rank) && 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<Expr<SubscriptInteger>> SymbolLEN(const Symbol &symbol) {
const Symbol &ultimate{symbol.GetUltimate()};
if (const auto *assoc{ultimate.detailsIf<semantics::AssocEntityDetails>()}) {
if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(assoc->expr())}) {
return chExpr->LEN();
}
}
if (auto dyType{DynamicType::From(ultimate)}) {
if (auto len{dyType->GetCharLength()}) {
if (auto constLen{ToInt64(*len)}) {
return Expr<SubscriptInteger>{std::max<std::int64_t>(*constLen, 0)};
} else if (ultimate.owner().IsDerivedType() ||
IsScopeInvariantExpr(*len)) {
return AsExpr(Extremum<SubscriptInteger>{
Ordering::Greater, Expr<SubscriptInteger>{0}, std::move(*len)});
}
}
}
if (IsDescriptor(ultimate) && !ultimate.owner().IsDerivedType()) {
return Expr<SubscriptInteger>{
DescriptorInquiry{NamedEntity{symbol}, DescriptorInquiry::Field::Len}};
}
return std::nullopt;
}
std::optional<Expr<SubscriptInteger>> BaseObject::LEN() const {
return common::visit(
common::visitors{
[](const Symbol &symbol) { return SymbolLEN(symbol); },
[](const StaticDataObject::Pointer &object)
-> std::optional<Expr<SubscriptInteger>> {
return AsExpr(Constant<SubscriptInteger>{object->data().size()});
},
},
u);
}
std::optional<Expr<SubscriptInteger>> Component::LEN() const {
return SymbolLEN(GetLastSymbol());
}
std::optional<Expr<SubscriptInteger>> NamedEntity::LEN() const {
return SymbolLEN(GetLastSymbol());
}
std::optional<Expr<SubscriptInteger>> ArrayRef::LEN() const {
return base_.LEN();
}
std::optional<Expr<SubscriptInteger>> CoarrayRef::LEN() const {
return SymbolLEN(GetLastSymbol());
}
std::optional<Expr<SubscriptInteger>> DataRef::LEN() const {
return common::visit(common::visitors{
[](SymbolRef symbol) { return SymbolLEN(symbol); },
[](const auto &x) { return x.LEN(); },
},
u);
}
std::optional<Expr<SubscriptInteger>> Substring::LEN() const {
if (auto top{upper()}) {
return AsExpr(Extremum<SubscriptInteger>{Ordering::Greater,
AsExpr(Constant<SubscriptInteger>{0}),
*std::move(top) - lower() + AsExpr(Constant<SubscriptInteger>{1})});
} else {
return std::nullopt;
}
}
template <typename T>
std::optional<Expr<SubscriptInteger>> Designator<T>::LEN() const {
if constexpr (T::category == TypeCategory::Character) {
return common::visit(common::visitors{
[](SymbolRef symbol) { return SymbolLEN(symbol); },
[](const auto &x) { return x.LEN(); },
},
u);
} else {
common::die("Designator<non-char>::LEN() called");
return std::nullopt;
}
}
std::optional<Expr<SubscriptInteger>> ProcedureDesignator::LEN() const {
using T = std::optional<Expr<SubscriptInteger>>;
return common::visit(
common::visitors{
[](SymbolRef symbol) -> T { return SymbolLEN(symbol); },
[](const common::CopyableIndirection<Component> &c) -> T {
return c.value().LEN();
},
[](const SpecificIntrinsic &i) -> T {
// Some cases whose results' lengths can be determined
// from the lengths of their arguments are handled in
// ProcedureRef::LEN() before coming here.
if (const auto &result{i.characteristics.value().functionResult}) {
if (const auto *type{result->GetTypeAndShape()}) {
if (auto length{type->type().GetCharLength()}) {
return std::move(*length);
}
}
}
return std::nullopt;
},
},
u);
}
// Rank()
int BaseObject::Rank() const {
return common::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 common::visit(common::visitors{
[](const SymbolRef s) { return s->Rank(); },
[](const Component &c) { return c.Rank(); },
},
u_);
}
int Subscript::Rank() const {
return common::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 common::visit(common::visitors{
[](SymbolRef symbol) { return symbol->Rank(); },
[](const auto &x) { return x.Rank(); },
},
u);
}
int Substring::Rank() const {
return common::visit(
common::visitors{
[](const DataRef &dataRef) { return dataRef.Rank(); },
[](const StaticDataObject::Pointer &) { return 0; },
},
parent_);
}
int ComplexPart::Rank() const { return complex_.Rank(); }
template <typename T> int Designator<T>::Rank() const {
return common::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 common::visit(common::visitors{
[](SymbolRef s) -> const Symbol & { return s; },
[](const Component &c) -> const Symbol & {
return c.GetFirstSymbol();
},
},
u_);
}
const Symbol &NamedEntity::GetLastSymbol() const {
return common::visit(common::visitors{
[](SymbolRef s) -> const Symbol & { return s; },
[](const Component &c) -> const Symbol & {
return c.GetLastSymbol();
},
},
u_);
}
const SymbolRef *NamedEntity::UnwrapSymbolRef() const {
return common::visit(
common::visitors{
[](const SymbolRef &s) { return &s; },
[](const Component &) -> const SymbolRef * { return nullptr; },
},
u_);
}
SymbolRef *NamedEntity::UnwrapSymbolRef() {
return common::visit(common::visitors{
[](SymbolRef &s) { return &s; },
[](Component &) -> SymbolRef * { return nullptr; },
},
u_);
}
const Component *NamedEntity::UnwrapComponent() const {
return common::visit(
common::visitors{
[](SymbolRef) -> const Component * { return nullptr; },
[](const Component &c) { return &c; },
},
u_);
}
Component *NamedEntity::UnwrapComponent() {
return common::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 *common::visit(common::visitors{
[](SymbolRef symbol) { return &*symbol; },
[](const auto &x) { return &x.GetFirstSymbol(); },
},
u);
}
const Symbol &DataRef::GetLastSymbol() const {
return *common::visit(common::visitors{
[](SymbolRef symbol) { return &*symbol; },
[](const auto &x) { return &x.GetLastSymbol(); },
},
u);
}
BaseObject Substring::GetBaseObject() const {
return common::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 common::visit(
common::visitors{
[](const DataRef &dataRef) { return &dataRef.GetLastSymbol(); },
[](const auto &) -> const Symbol * { return nullptr; },
},
parent_);
}
template <typename T> BaseObject Designator<T>::GetBaseObject() const {
return common::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<std::decay_t<decltype(x)>,
Substring>) {
return x.GetBaseObject();
} else
#endif
return BaseObject{x.GetFirstSymbol()};
},
},
u);
}
template <typename T> const Symbol *Designator<T>::GetLastSymbol() const {
return common::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<std::decay_t<decltype(x)>,
Substring>) {
return x.GetLastSymbol();
} else
#endif
return &x.GetLastSymbol();
},
},
u);
}
template <typename T>
std::optional<DynamicType> Designator<T>::GetType() const {
if constexpr (IsLengthlessIntrinsicType<Result>) {
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<Substring>(&u)}) {
const auto *parent{substring->GetParentIf<StaticDataObject::Pointer>()};
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<semantics::ObjectEntityDetails>()}) {
if (const auto *yObject{y.detailsIf<semantics::ObjectEntityDetails>()}) {
return xObject->isDummy() && yObject->isDummy();
}
}
}
return false;
}
// Implements operator==() for a union type, using special case handling
// for Symbol references.
template <typename A> static bool TestVariableEquality(const A &x, const A &y) {
const SymbolRef *xSymbol{std::get_if<SymbolRef>(&x.u)};
if (const SymbolRef * ySymbol{std::get_if<SymbolRef>(&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 <typename T>
bool Designator<T>::operator==(const Designator<T> &that) const {
return TestVariableEquality(*this, that);
}
bool DescriptorInquiry::operator==(const DescriptorInquiry &that) const {
return field_ == that.field_ && base_ == that.base_ &&
dimension_ == that.dimension_;
}
#ifdef _MSC_VER // disable bogus warning about missing definitions
#pragma warning(disable : 4661)
#endif
INSTANTIATE_VARIABLE_TEMPLATES
} // namespace Fortran::evaluate
template class Fortran::common::Indirection<Fortran::evaluate::Component, true>;