//===-- lib/Evaluate/designate.cpp ------------------------------*- C++ -*-===//
//
// 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/fold-designator.h"
#include "flang/Semantics/tools.h"
namespace Fortran::evaluate {
DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(OffsetSymbol)
std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
const Symbol &symbol, ConstantSubscript which) {
if (!getLastComponent_ && IsAllocatableOrPointer(symbol)) {
// A pointer may appear as a DATA statement object if it is the
// rightmost symbol in a designator and has no subscripts.
// An allocatable may appear if its initializer is NULL().
if (which > 0) {
isEmpty_ = true;
} else {
return OffsetSymbol{symbol, symbol.size()};
}
} else if (symbol.has<semantics::ObjectEntityDetails>() &&
!IsNamedConstant(symbol)) {
if (auto type{DynamicType::From(symbol)}) {
if (auto extents{GetConstantExtents(context_, symbol)}) {
if (auto bytes{ToInt64(
type->MeasureSizeInBytes(context_, GetRank(*extents) > 0))}) {
OffsetSymbol result{symbol, static_cast<std::size_t>(*bytes)};
if (which < GetSize(*extents)) {
result.Augment(*bytes * which);
return result;
} else {
isEmpty_ = true;
}
}
}
}
}
return std::nullopt;
}
std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
const ArrayRef &x, ConstantSubscript which) {
const Symbol &array{x.base().GetLastSymbol()};
if (auto type{DynamicType::From(array)}) {
if (auto extents{GetConstantExtents(context_, array)}) {
if (auto bytes{ToInt64(type->MeasureSizeInBytes(context_, true))}) {
Shape lbs{GetLBOUNDs(context_, x.base())};
if (auto lowerBounds{AsConstantExtents(context_, lbs)}) {
std::optional<OffsetSymbol> result;
if (!x.base().IsSymbol() &&
x.base().GetComponent().base().Rank() > 0) {
// A(:)%B(1) - apply elementNumber_ to base
result = FoldDesignator(x.base(), which);
which = 0;
} else { // A(1)%B(:) - apply elementNumber_ to subscripts
result = FoldDesignator(x.base(), 0);
}
if (!result) {
return std::nullopt;
}
auto stride{*bytes};
int dim{0};
for (const Subscript &subscript : x.subscript()) {
ConstantSubscript lower{lowerBounds->at(dim)};
ConstantSubscript extent{extents->at(dim)};
ConstantSubscript upper{lower + extent - 1};
if (!common::visit(
common::visitors{
[&](const IndirectSubscriptIntegerExpr &expr) {
auto folded{
Fold(context_, common::Clone(expr.value()))};
if (auto value{UnwrapConstantValue<SubscriptInteger>(
folded)}) {
CHECK(value->Rank() <= 1);
if (value->size() != 0) {
// Apply subscript, possibly vector-valued
auto quotient{which / value->size()};
auto remainder{which - value->size() * quotient};
ConstantSubscript at{
value->values().at(remainder).ToInt64()};
if (at < lower || at > upper) {
isOutOfRange_ = true;
}
result->Augment((at - lower) * stride);
which = quotient;
return true;
} else {
isEmpty_ = true;
}
}
return false;
},
[&](const Triplet &triplet) {
auto start{ToInt64(Fold(context_,
triplet.lower().value_or(ExtentExpr{lower})))};
auto end{ToInt64(Fold(context_,
triplet.upper().value_or(ExtentExpr{upper})))};
auto step{ToInt64(Fold(context_, triplet.stride()))};
if (start && end && step) {
if (*step != 0) {
ConstantSubscript range{
(*end - *start + *step) / *step};
if (range > 0) {
auto quotient{which / range};
auto remainder{which - range * quotient};
auto j{*start + remainder * *step};
result->Augment((j - lower) * stride);
which = quotient;
return true;
} else {
isEmpty_ = true;
}
}
}
return false;
},
},
subscript.u)) {
return std::nullopt;
}
++dim;
stride *= extent;
}
if (which > 0) {
isEmpty_ = true;
} else {
return result;
}
}
}
}
}
return std::nullopt;
}
std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
const Component &component, ConstantSubscript which) {
const Symbol &comp{component.GetLastSymbol()};
if (getLastComponent_) {
return FoldDesignator(comp, which);
} else {
const DataRef &base{component.base()};
std::optional<OffsetSymbol> baseResult, compResult;
if (base.Rank() == 0) { // A%X(:) - apply "which" to component
baseResult = FoldDesignator(base, 0);
compResult = FoldDesignator(comp, which);
} else { // A(:)%X - apply "which" to base
baseResult = FoldDesignator(base, which);
compResult = FoldDesignator(comp, 0);
}
if (baseResult && compResult) {
OffsetSymbol result{baseResult->symbol(), compResult->size()};
result.Augment(
baseResult->offset() + compResult->offset() + comp.offset());
return {std::move(result)};
} else {
return std::nullopt;
}
}
}
std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
const ComplexPart &z, ConstantSubscript which) {
if (auto result{FoldDesignator(z.complex(), which)}) {
result->set_size(result->size() >> 1);
if (z.part() == ComplexPart::Part::IM) {
result->Augment(result->size());
}
return result;
} else {
return std::nullopt;
}
}
std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
const DataRef &dataRef, ConstantSubscript which) {
return common::visit(
[&](const auto &x) { return FoldDesignator(x, which); }, dataRef.u);
}
std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
const NamedEntity &entity, ConstantSubscript which) {
return entity.IsSymbol() ? FoldDesignator(entity.GetLastSymbol(), which)
: FoldDesignator(entity.GetComponent(), which);
}
std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
const CoarrayRef &, ConstantSubscript) {
return std::nullopt;
}
std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
const ProcedureDesignator &proc, ConstantSubscript which) {
if (const Symbol * symbol{proc.GetSymbol()}) {
if (const Component * component{proc.GetComponent()}) {
return FoldDesignator(*component, which);
} else if (which > 0) {
isEmpty_ = true;
} else {
return FoldDesignator(*symbol, 0);
}
}
return std::nullopt;
}
// Conversions of offset symbols (back) to Designators
// Reconstructs subscripts.
// "offset" is decremented in place to hold remaining component offset.
static std::optional<ArrayRef> OffsetToArrayRef(FoldingContext &context,
NamedEntity &&entity, const Shape &shape, const DynamicType &elementType,
ConstantSubscript &offset) {
auto extents{AsConstantExtents(context, shape)};
Shape lbs{GetRawLowerBounds(context, entity)};
auto lower{AsConstantExtents(context, lbs)};
auto elementBytes{ToInt64(elementType.MeasureSizeInBytes(context, true))};
if (!extents || !lower || !elementBytes || *elementBytes <= 0) {
return std::nullopt;
}
int rank{GetRank(shape)};
CHECK(extents->size() == static_cast<std::size_t>(rank) &&
lower->size() == extents->size());
auto element{offset / static_cast<std::size_t>(*elementBytes)};
std::vector<Subscript> subscripts;
auto at{element};
for (int dim{0}; dim + 1 < rank; ++dim) {
auto extent{(*extents)[dim]};
if (extent <= 0) {
return std::nullopt;
}
auto quotient{at / extent};
auto remainder{at - quotient * extent};
subscripts.emplace_back(ExtentExpr{(*lower)[dim] + remainder});
at = quotient;
}
// This final subscript might be out of range for use in error reporting.
subscripts.emplace_back(ExtentExpr{(*lower)[rank - 1] + at});
offset -= element * static_cast<std::size_t>(*elementBytes);
return ArrayRef{std::move(entity), std::move(subscripts)};
}
// Maps an offset back to a component, when unambiguous.
static const Symbol *OffsetToUniqueComponent(
const semantics::DerivedTypeSpec &spec, ConstantSubscript offset) {
const Symbol *result{nullptr};
if (const semantics::Scope * scope{spec.scope()}) {
for (const auto &pair : *scope) {
const Symbol &component{*pair.second};
if (offset >= static_cast<ConstantSubscript>(component.offset()) &&
offset < static_cast<ConstantSubscript>(
component.offset() + component.size())) {
if (result) {
return nullptr; // MAP overlap or error recovery
}
result = &component;
}
}
}
return result;
}
// Converts an offset into subscripts &/or component references. Recursive.
// Any remaining offset is left in place in the "offset" reference argument.
static std::optional<DataRef> OffsetToDataRef(FoldingContext &context,
NamedEntity &&entity, ConstantSubscript &offset, std::size_t size) {
const Symbol &symbol{entity.GetLastSymbol()};
if (IsAllocatableOrPointer(symbol)) {
return entity.IsSymbol() ? DataRef{symbol}
: DataRef{std::move(entity.GetComponent())};
} else if (std::optional<DynamicType> type{DynamicType::From(symbol)}) {
std::optional<DataRef> result;
if (!type->IsUnlimitedPolymorphic()) {
if (std::optional<Shape> shape{GetShape(context, symbol)}) {
if (GetRank(*shape) > 0) {
if (auto aref{OffsetToArrayRef(
context, std::move(entity), *shape, *type, offset)}) {
result = DataRef{std::move(*aref)};
}
} else {
result = entity.IsSymbol()
? DataRef{symbol}
: DataRef{std::move(entity.GetComponent())};
}
if (result && type->category() == TypeCategory::Derived &&
size <= result->GetLastSymbol().size()) {
if (const Symbol *
component{OffsetToUniqueComponent(
type->GetDerivedTypeSpec(), offset)}) {
offset -= component->offset();
return OffsetToDataRef(context,
NamedEntity{Component{std::move(*result), *component}}, offset,
size);
}
}
}
}
return result;
} else {
return std::nullopt;
}
}
// Reconstructs a Designator from a symbol, an offset, and a size.
// Returns a ProcedureDesignator in the case of a whole procedure pointer.
std::optional<Expr<SomeType>> OffsetToDesignator(FoldingContext &context,
const Symbol &baseSymbol, ConstantSubscript offset, std::size_t size) {
if (offset < 0) {
return std::nullopt;
} else if (std::optional<DataRef> dataRef{OffsetToDataRef(
context, NamedEntity{baseSymbol}, offset, size)}) {
const Symbol &symbol{dataRef->GetLastSymbol()};
if (IsProcedurePointer(symbol)) {
if (std::holds_alternative<SymbolRef>(dataRef->u)) {
return Expr<SomeType>{ProcedureDesignator{symbol}};
} else if (auto *component{std::get_if<Component>(&dataRef->u)}) {
return Expr<SomeType>{ProcedureDesignator{std::move(*component)}};
}
} else if (std::optional<Expr<SomeType>> result{
AsGenericExpr(std::move(*dataRef))}) {
if (IsAllocatableOrPointer(symbol)) {
} else if (auto type{DynamicType::From(symbol)}) {
if (auto elementBytes{
ToInt64(type->MeasureSizeInBytes(context, true))}) {
if (auto *zExpr{std::get_if<Expr<SomeComplex>>(&result->u)}) {
if (size * 2 > static_cast<std::size_t>(*elementBytes)) {
return result;
} else if (offset == 0 || offset * 2 == *elementBytes) {
// Pick a COMPLEX component
auto part{
offset == 0 ? ComplexPart::Part::RE : ComplexPart::Part::IM};
return common::visit(
[&](const auto &z) -> std::optional<Expr<SomeType>> {
using PartType = typename ResultType<decltype(z)>::Part;
return AsGenericExpr(Designator<PartType>{ComplexPart{
ExtractDataRef(std::move(*zExpr)).value(), part}});
},
zExpr->u);
}
} else if (auto *cExpr{
std::get_if<Expr<SomeCharacter>>(&result->u)}) {
if (offset > 0 || size != static_cast<std::size_t>(*elementBytes)) {
// Select a substring
return common::visit(
[&](const auto &x) -> std::optional<Expr<SomeType>> {
using T = typename std::decay_t<decltype(x)>::Result;
return AsGenericExpr(Designator<T>{
Substring{ExtractDataRef(std::move(*cExpr)).value(),
std::optional<Expr<SubscriptInteger>>{
1 + (offset / T::kind)},
std::optional<Expr<SubscriptInteger>>{
1 + ((offset + size - 1) / T::kind)}}});
},
cExpr->u);
}
}
}
}
if (offset == 0) {
return result;
}
}
}
return std::nullopt;
}
std::optional<Expr<SomeType>> OffsetToDesignator(
FoldingContext &context, const OffsetSymbol &offsetSymbol) {
return OffsetToDesignator(context, offsetSymbol.symbol(),
offsetSymbol.offset(), offsetSymbol.size());
}
ConstantObjectPointer ConstantObjectPointer::From(
FoldingContext &context, const Expr<SomeType> &expr) {
auto extents{GetConstantExtents(context, expr)};
CHECK(extents);
std::optional<uint64_t> optElements{TotalElementCount(*extents)};
CHECK(optElements);
uint64_t elements{*optElements};
CHECK(elements > 0);
int rank{GetRank(*extents)};
ConstantSubscripts at(rank, 1);
ConstantObjectPointer::Dimensions dimensions(rank);
for (int j{0}; j < rank; ++j) {
dimensions[j].extent = (*extents)[j];
}
DesignatorFolder designatorFolder{context};
const Symbol *symbol{nullptr};
ConstantSubscript baseOffset{0};
std::size_t elementSize{0};
for (std::size_t j{0}; j < elements; ++j) {
auto folded{designatorFolder.FoldDesignator(expr)};
CHECK(folded);
if (j == 0) {
symbol = &folded->symbol();
baseOffset = folded->offset();
elementSize = folded->size();
} else {
CHECK(symbol == &folded->symbol());
CHECK(elementSize == folded->size());
}
int twoDim{-1};
for (int k{0}; k < rank; ++k) {
if (at[k] == 2 && twoDim == -1) {
twoDim = k;
} else if (at[k] != 1) {
twoDim = -2;
}
}
if (twoDim >= 0) {
// Exactly one subscript is a 2 and the rest are 1.
dimensions[twoDim].byteStride = folded->offset() - baseOffset;
}
ConstantSubscript checkOffset{baseOffset};
for (int k{0}; k < rank; ++k) {
checkOffset += (at[k] - 1) * dimensions[twoDim].byteStride;
}
CHECK(checkOffset == folded->offset());
CHECK(IncrementSubscripts(at, *extents) == (j + 1 < elements));
}
CHECK(!designatorFolder.FoldDesignator(expr));
return ConstantObjectPointer{
DEREF(symbol), elementSize, std::move(dimensions)};
}
} // namespace Fortran::evaluate
Codebase Browser
llvm