//===-- lib/Evaluate/fold-character.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 "fold-implementation.h" #include "fold-reduction.h" namespace Fortran::evaluate { static std::optional GetConstantLength( FoldingContext &context, Expr &&expr) { expr = Fold(context, std::move(expr)); if (auto *chExpr{UnwrapExpr>(expr)}) { if (auto len{chExpr->LEN()}) { return ToInt64(*len); } } return std::nullopt; } template static std::optional GetConstantLength( FoldingContext &context, FunctionRef &funcRef, int zeroBasedArg) { if (auto *expr{funcRef.UnwrapArgExpr(zeroBasedArg)}) { return GetConstantLength(context, std::move(*expr)); } else { return std::nullopt; } } template static std::optional> Identity( Scalar str, std::optional len) { if (len) { return CharacterUtils::REPEAT( str, std::max(*len, 0)); } else { return std::nullopt; } } template Expr> FoldIntrinsicFunction( FoldingContext &context, FunctionRef> &&funcRef) { using T = Type; using StringType = Scalar; // std::string or larger using SingleCharType = typename StringType::value_type; // char &c. auto *intrinsic{std::get_if(&funcRef.proc().u)}; CHECK(intrinsic); std::string name{intrinsic->name}; if (name == "achar" || name == "char") { using IntT = SubscriptInteger; return FoldElementalIntrinsic(context, std::move(funcRef), ScalarFunc([&](const Scalar &i) { if (i.IsNegative() || i.BGE(Scalar{0}.IBSET(8 * KIND))) { context.messages().Say( "%s(I=%jd) is out of range for CHARACTER(KIND=%d)"_warn_en_US, parser::ToUpperCaseLetters(name), static_cast(i.ToInt64()), KIND); } return CharacterUtils::CHAR(i.ToUInt64()); })); } else if (name == "adjustl") { return FoldElementalIntrinsic( context, std::move(funcRef), CharacterUtils::ADJUSTL); } else if (name == "adjustr") { return FoldElementalIntrinsic( context, std::move(funcRef), CharacterUtils::ADJUSTR); } else if (name == "max") { return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater); } else if (name == "maxval") { SingleCharType least{0}; if (auto identity{Identity( StringType{least}, GetConstantLength(context, funcRef, 0))}) { return FoldMaxvalMinval( context, std::move(funcRef), RelationalOperator::GT, *identity); } } else if (name == "min") { return FoldMINorMAX(context, std::move(funcRef), Ordering::Less); } else if (name == "minval") { // Collating sequences correspond to positive integers (3.31) auto most{static_cast(0xffffffff >> (8 * (4 - KIND)))}; if (auto identity{Identity( StringType{most}, GetConstantLength(context, funcRef, 0))}) { return FoldMaxvalMinval( context, std::move(funcRef), RelationalOperator::LT, *identity); } } else if (name == "new_line") { return Expr{Constant{CharacterUtils::NEW_LINE()}}; } else if (name == "repeat") { // not elemental if (auto scalars{GetScalarConstantArguments( context, funcRef.arguments())}) { auto str{std::get>(*scalars)}; auto n{std::get>(*scalars).ToInt64()}; if (n < 0) { context.messages().Say( "NCOPIES= argument to REPEAT() should be nonnegative, but is %jd"_err_en_US, static_cast(n)); } else if (static_cast(n) * str.size() > (1 << 20)) { // sanity limit of 1MiB context.messages().Say( "Result of REPEAT() is too large to compute at compilation time (%g characters)"_port_en_US, static_cast(n) * str.size()); } else { return Expr{Constant{CharacterUtils::REPEAT(str, n)}}; } } } else if (name == "trim") { // not elemental if (auto scalar{ GetScalarConstantArguments(context, funcRef.arguments())}) { return Expr{Constant{ CharacterUtils::TRIM(std::get>(*scalar))}}; } } else if (name == "__builtin_compiler_options") { auto &o = context.targetCharacteristics().compilerOptionsString(); return Expr{Constant{StringType(o.begin(), o.end())}}; } else if (name == "__builtin_compiler_version") { auto &v = context.targetCharacteristics().compilerVersionString(); return Expr{Constant{StringType(v.begin(), v.end())}}; } return Expr{std::move(funcRef)}; } template Expr> FoldOperation( FoldingContext &context, Concat &&x) { if (auto array{ApplyElementwise(context, x)}) { return *array; } using Result = Type; if (auto folded{OperandsAreConstants(x)}) { return Expr{Constant{folded->first + folded->second}}; } return Expr{std::move(x)}; } template Expr> FoldOperation( FoldingContext &context, SetLength &&x) { if (auto array{ApplyElementwise(context, x)}) { return *array; } using Result = Type; if (auto folded{OperandsAreConstants(x)}) { auto oldLength{static_cast(folded->first.size())}; auto newLength{folded->second.ToInt64()}; if (newLength < oldLength) { folded->first.erase(newLength); } else { folded->first.append(newLength - oldLength, ' '); } CHECK(static_cast(folded->first.size()) == newLength); return Expr{Constant{std::move(folded->first)}}; } return Expr{std::move(x)}; } #ifdef _MSC_VER // disable bogus warning about missing definitions #pragma warning(disable : 4661) #endif FOR_EACH_CHARACTER_KIND(template class ExpressionBase, ) template class ExpressionBase; } // namespace Fortran::evaluate