305 lines · cpp
1//===-- lib/Evaluate/fold.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/fold.h"10#include "fold-implementation.h"11#include "flang/Evaluate/characteristics.h"12#include "flang/Evaluate/initial-image.h"13#include "flang/Evaluate/tools.h"14 15namespace Fortran::evaluate {16 17characteristics::TypeAndShape Fold(18 FoldingContext &context, characteristics::TypeAndShape &&x) {19 x.Rewrite(context);20 return std::move(x);21}22 23std::optional<Constant<SubscriptInteger>> GetConstantSubscript(24 FoldingContext &context, Subscript &ss, const NamedEntity &base, int dim) {25 ss = FoldOperation(context, std::move(ss));26 return common::visit(27 common::visitors{28 [](IndirectSubscriptIntegerExpr &expr)29 -> std::optional<Constant<SubscriptInteger>> {30 if (const auto *constant{31 UnwrapConstantValue<SubscriptInteger>(expr.value())}) {32 return *constant;33 } else {34 return std::nullopt;35 }36 },37 [&](Triplet &triplet) -> std::optional<Constant<SubscriptInteger>> {38 auto lower{triplet.lower()}, upper{triplet.upper()};39 std::optional<ConstantSubscript> stride{ToInt64(triplet.stride())};40 if (!lower) {41 lower = GetLBOUND(context, base, dim);42 }43 if (!upper) {44 if (auto lb{GetLBOUND(context, base, dim)}) {45 upper = ComputeUpperBound(46 context, std::move(*lb), GetExtent(context, base, dim));47 }48 }49 auto lbi{ToInt64(lower)}, ubi{ToInt64(upper)};50 if (lbi && ubi && stride && *stride != 0) {51 std::vector<SubscriptInteger::Scalar> values;52 while ((*stride > 0 && *lbi <= *ubi) ||53 (*stride < 0 && *lbi >= *ubi)) {54 values.emplace_back(*lbi);55 *lbi += *stride;56 }57 return Constant<SubscriptInteger>{std::move(values),58 ConstantSubscripts{59 static_cast<ConstantSubscript>(values.size())}};60 } else {61 return std::nullopt;62 }63 },64 },65 ss.u);66}67 68Expr<SomeDerived> FoldOperation(69 FoldingContext &context, StructureConstructor &&structure) {70 StructureConstructor ctor{structure.derivedTypeSpec()};71 bool isConstant{true};72 auto restorer{context.WithPDTInstance(structure.derivedTypeSpec())};73 for (auto &&[symbol, value] : std::move(structure)) {74 auto expr{Fold(context, std::move(value.value()))};75 if (IsPointer(symbol)) {76 if (IsNullPointer(&expr)) {77 // Handle x%c when x designates a named constant of derived78 // type and %c is NULL() in that constant.79 expr = Expr<SomeType>{NullPointer{}};80 } else if (IsProcedure(symbol)) {81 isConstant &= IsInitialProcedureTarget(expr);82 } else {83 isConstant &= IsInitialDataTarget(expr);84 }85 } else if (IsAllocatable(symbol)) {86 // F2023: 10.1.12 (3)(a)87 // If comp-spec is not null() for the allocatable component the88 // structure constructor is not a constant expression.89 isConstant &= IsNullAllocatable(&expr) || IsBareNullPointer(&expr);90 } else {91 isConstant &=92 IsActuallyConstant(expr) || IsNullPointerOrAllocatable(&expr);93 if (auto valueShape{GetConstantExtents(context, expr)}) {94 if (auto componentShape{GetConstantExtents(context, symbol)}) {95 if (GetRank(*componentShape) > 0 && GetRank(*valueShape) == 0) {96 expr = ScalarConstantExpander{std::move(*componentShape)}.Expand(97 std::move(expr));98 isConstant &= expr.Rank() > 0;99 } else {100 isConstant &= *valueShape == *componentShape;101 }102 if (*valueShape == *componentShape) {103 if (auto lbounds{AsConstantExtents(104 context, GetLBOUNDs(context, NamedEntity{symbol}))}) {105 expr =106 ArrayConstantBoundChanger{std::move(*lbounds)}.ChangeLbounds(107 std::move(expr));108 }109 }110 }111 }112 }113 ctor.Add(symbol, std::move(expr));114 }115 if (isConstant) {116 return Expr<SomeDerived>{Constant<SomeDerived>{std::move(ctor)}};117 } else {118 return Expr<SomeDerived>{std::move(ctor)};119 }120}121 122Component FoldOperation(FoldingContext &context, Component &&component) {123 return {FoldOperation(context, std::move(component.base())),124 component.GetLastSymbol()};125}126 127NamedEntity FoldOperation(FoldingContext &context, NamedEntity &&x) {128 if (Component * c{x.UnwrapComponent()}) {129 return NamedEntity{FoldOperation(context, std::move(*c))};130 } else {131 return std::move(x);132 }133}134 135Triplet FoldOperation(FoldingContext &context, Triplet &&triplet) {136 MaybeExtentExpr lower{triplet.lower()};137 MaybeExtentExpr upper{triplet.upper()};138 return {Fold(context, std::move(lower)), Fold(context, std::move(upper)),139 Fold(context, triplet.stride())};140}141 142Subscript FoldOperation(FoldingContext &context, Subscript &&subscript) {143 return common::visit(144 common::visitors{145 [&](IndirectSubscriptIntegerExpr &&expr) {146 expr.value() = Fold(context, std::move(expr.value()));147 return Subscript(std::move(expr));148 },149 [&](Triplet &&triplet) {150 return Subscript(FoldOperation(context, std::move(triplet)));151 },152 },153 std::move(subscript.u));154}155 156ArrayRef FoldOperation(FoldingContext &context, ArrayRef &&arrayRef) {157 NamedEntity base{FoldOperation(context, std::move(arrayRef.base()))};158 for (Subscript &subscript : arrayRef.subscript()) {159 subscript = FoldOperation(context, std::move(subscript));160 }161 return ArrayRef{std::move(base), std::move(arrayRef.subscript())};162}163 164CoarrayRef FoldOperation(FoldingContext &context, CoarrayRef &&coarrayRef) {165 DataRef base{FoldOperation(context, std::move(coarrayRef.base()))};166 std::vector<Expr<SubscriptInteger>> cosubscript;167 for (Expr<SubscriptInteger> x : coarrayRef.cosubscript()) {168 cosubscript.emplace_back(Fold(context, std::move(x)));169 }170 CoarrayRef folded{std::move(base), std::move(cosubscript)};171 if (std::optional<Expr<SomeInteger>> stat{coarrayRef.stat()}) {172 folded.set_stat(Fold(context, std::move(*stat)));173 }174 if (std::optional<Expr<SomeType>> team{coarrayRef.team()}) {175 folded.set_team(Fold(context, std::move(*team)));176 }177 return folded;178}179 180DataRef FoldOperation(FoldingContext &context, DataRef &&dataRef) {181 return common::visit(common::visitors{182 [&](SymbolRef symbol) { return DataRef{*symbol}; },183 [&](auto &&x) {184 return DataRef{185 FoldOperation(context, std::move(x))};186 },187 },188 std::move(dataRef.u));189}190 191Substring FoldOperation(FoldingContext &context, Substring &&substring) {192 auto lower{Fold(context, substring.lower())};193 auto upper{Fold(context, substring.upper())};194 if (const DataRef * dataRef{substring.GetParentIf<DataRef>()}) {195 return Substring{FoldOperation(context, DataRef{*dataRef}),196 std::move(lower), std::move(upper)};197 } else {198 auto p{*substring.GetParentIf<StaticDataObject::Pointer>()};199 return Substring{std::move(p), std::move(lower), std::move(upper)};200 }201}202 203ComplexPart FoldOperation(FoldingContext &context, ComplexPart &&complexPart) {204 DataRef complex{complexPart.complex()};205 return ComplexPart{206 FoldOperation(context, std::move(complex)), complexPart.part()};207}208 209std::optional<std::int64_t> GetInt64ArgOr(210 const std::optional<ActualArgument> &arg, std::int64_t defaultValue) {211 return arg ? ToInt64(*arg) : defaultValue;212}213 214Expr<ImpliedDoIndex::Result> FoldOperation(215 FoldingContext &context, ImpliedDoIndex &&iDo) {216 if (std::optional<ConstantSubscript> value{context.GetImpliedDo(iDo.name)}) {217 return Expr<ImpliedDoIndex::Result>{*value};218 } else {219 return Expr<ImpliedDoIndex::Result>{std::move(iDo)};220 }221}222 223// TRANSFER (F'2018 16.9.193)224std::optional<Expr<SomeType>> FoldTransfer(225 FoldingContext &context, const ActualArguments &arguments) {226 CHECK(arguments.size() == 2 || arguments.size() == 3);227 const auto *source{UnwrapExpr<Expr<SomeType>>(arguments[0])};228 std::optional<std::size_t> sourceBytes;229 if (source) {230 if (auto sourceTypeAndShape{231 characteristics::TypeAndShape::Characterize(*source, context)}) {232 if (auto sourceBytesExpr{233 sourceTypeAndShape->MeasureSizeInBytes(context)}) {234 sourceBytes = ToInt64(*sourceBytesExpr);235 }236 }237 }238 std::optional<DynamicType> moldType;239 std::optional<std::int64_t> moldLength;240 if (arguments[1]) { // MOLD=241 moldType = arguments[1]->GetType();242 if (moldType && moldType->category() == TypeCategory::Character) {243 if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(arguments[1])}) {244 moldLength = ToInt64(Fold(context, chExpr->LEN()));245 }246 }247 }248 std::optional<ConstantSubscripts> extents;249 if (arguments.size() == 2) { // no SIZE=250 if (moldType && sourceBytes) {251 if (arguments[1]->Rank() == 0) { // scalar MOLD=252 extents = ConstantSubscripts{}; // empty extents (scalar result)253 } else if (auto moldBytesExpr{254 moldType->MeasureSizeInBytes(context, true)}) {255 if (auto moldBytes{ToInt64(Fold(context, std::move(*moldBytesExpr)))};256 *moldBytes > 0) {257 extents = ConstantSubscripts{258 static_cast<ConstantSubscript>((*sourceBytes) + *moldBytes - 1) /259 *moldBytes};260 }261 }262 }263 } else if (arguments[2]) { // SIZE= is present264 if (const auto *sizeExpr{arguments[2]->UnwrapExpr()}) {265 if (auto sizeValue{ToInt64(*sizeExpr)}) {266 extents = ConstantSubscripts{*sizeValue};267 }268 }269 }270 if (sourceBytes && IsActuallyConstant(*source) && moldType && extents &&271 !moldType->IsPolymorphic() &&272 (moldLength || moldType->category() != TypeCategory::Character)) {273 std::size_t elements{274 extents->empty() ? 1 : static_cast<std::size_t>((*extents)[0])};275 std::size_t totalBytes{*sourceBytes * elements};276 // Don't fold intentional overflow cases from sneaky tests277 if (totalBytes < std::size_t{1000000} &&278 (elements == 0 || totalBytes / elements == *sourceBytes)) {279 InitialImage image{*sourceBytes};280 auto status{image.Add(0, *sourceBytes, *source, context)};281 if (status == InitialImage::Ok) {282 return image.AsConstant(283 context, *moldType, moldLength, *extents, true /*pad with 0*/);284 } else {285 // Can fail due to an allocatable or automatic component;286 // a warning will also have been produced.287 CHECK(status == InitialImage::NotAConstant);288 }289 }290 } else if (source && moldType) {291 if (const auto *boz{std::get_if<BOZLiteralConstant>(&source->u)}) {292 // TRANSFER(BOZ, MOLD=integer or real) extension293 context.Warn(common::LanguageFeature::TransferBOZ,294 "TRANSFER(BOZ literal) is not standard"_port_en_US);295 return Fold(context, ConvertToType(*moldType, Expr<SomeType>{*boz}));296 }297 }298 return std::nullopt;299}300 301template class ExpressionBase<SomeDerived>;302template class ExpressionBase<SomeType>;303 304} // namespace Fortran::evaluate305