1 //===-- lib/Evaluate/fold-character.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-exception 6 // 7 //===----------------------------------------------------------------------===// 8 9 #include "fold-implementation.h" 10 #include "fold-reduction.h" 11 12 namespace Fortran::evaluate { 13 14 static std::optional<ConstantSubscript> GetConstantLength( 15 FoldingContext &context, Expr<SomeType> &&expr) { 16 expr = Fold(context, std::move(expr)); 17 if (auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(expr)}) { 18 if (auto len{chExpr->LEN()}) { 19 return ToInt64(*len); 20 } 21 } 22 return std::nullopt; 23 } 24 25 template <typename T> 26 static std::optional<ConstantSubscript> GetConstantLength( 27 FoldingContext &context, FunctionRef<T> &funcRef, int zeroBasedArg) { 28 if (auto *expr{funcRef.UnwrapArgExpr(zeroBasedArg)}) { 29 return GetConstantLength(context, std::move(*expr)); 30 } else { 31 return std::nullopt; 32 } 33 } 34 35 template <typename T> 36 static std::optional<Scalar<T>> Identity( 37 Scalar<T> str, std::optional<ConstantSubscript> len) { 38 if (len) { 39 return CharacterUtils<T::kind>::REPEAT( 40 str, std::max<ConstantSubscript>(*len, 0)); 41 } else { 42 return std::nullopt; 43 } 44 } 45 46 template <int KIND> 47 Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction( 48 FoldingContext &context, 49 FunctionRef<Type<TypeCategory::Character, KIND>> &&funcRef) { 50 using T = Type<TypeCategory::Character, KIND>; 51 using StringType = Scalar<T>; // std::string or larger 52 using SingleCharType = typename StringType::value_type; // char &c. 53 auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)}; 54 CHECK(intrinsic); 55 std::string name{intrinsic->name}; 56 if (name == "achar" || name == "char") { 57 using IntT = SubscriptInteger; 58 return FoldElementalIntrinsic<T, IntT>(context, std::move(funcRef), 59 ScalarFunc<T, IntT>([&](const Scalar<IntT> &i) { 60 if (i.IsNegative() || i.BGE(Scalar<IntT>{0}.IBSET(8 * KIND))) { 61 if (context.languageFeatures().ShouldWarn( 62 common::UsageWarning::FoldingValueChecks)) { 63 context.messages().Say(common::UsageWarning::FoldingValueChecks, 64 "%s(I=%jd) is out of range for CHARACTER(KIND=%d)"_warn_en_US, 65 parser::ToUpperCaseLetters(name), 66 static_cast<std::intmax_t>(i.ToInt64()), KIND); 67 } 68 } 69 return CharacterUtils<KIND>::CHAR(i.ToUInt64()); 70 })); 71 } else if (name == "adjustl") { 72 return FoldElementalIntrinsic<T, T>( 73 context, std::move(funcRef), CharacterUtils<KIND>::ADJUSTL); 74 } else if (name == "adjustr") { 75 return FoldElementalIntrinsic<T, T>( 76 context, std::move(funcRef), CharacterUtils<KIND>::ADJUSTR); 77 } else if (name == "max") { 78 return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater); 79 } else if (name == "maxval") { 80 SingleCharType least{0}; 81 if (auto identity{Identity<T>( 82 StringType{least}, GetConstantLength(context, funcRef, 0))}) { 83 return FoldMaxvalMinval<T>( 84 context, std::move(funcRef), RelationalOperator::GT, *identity); 85 } 86 } else if (name == "min") { 87 return FoldMINorMAX(context, std::move(funcRef), Ordering::Less); 88 } else if (name == "minval") { 89 // Collating sequences correspond to positive integers (3.31) 90 auto most{static_cast<SingleCharType>(0xffffffff >> (8 * (4 - KIND)))}; 91 if (auto identity{Identity<T>( 92 StringType{most}, GetConstantLength(context, funcRef, 0))}) { 93 return FoldMaxvalMinval<T>( 94 context, std::move(funcRef), RelationalOperator::LT, *identity); 95 } 96 } else if (name == "new_line") { 97 return Expr<T>{Constant<T>{CharacterUtils<KIND>::NEW_LINE()}}; 98 } else if (name == "repeat") { // not elemental 99 if (auto scalars{GetScalarConstantArguments<T, SubscriptInteger>( 100 context, funcRef.arguments(), /*hasOptionalArgument=*/false)}) { 101 auto str{std::get<Scalar<T>>(*scalars)}; 102 auto n{std::get<Scalar<SubscriptInteger>>(*scalars).ToInt64()}; 103 if (n < 0) { 104 context.messages().Say( 105 "NCOPIES= argument to REPEAT() should be nonnegative, but is %jd"_err_en_US, 106 static_cast<std::intmax_t>(n)); 107 } else if (static_cast<double>(n) * str.size() > 108 (1 << 20)) { // sanity limit of 1MiB 109 if (context.languageFeatures().ShouldWarn( 110 common::UsageWarning::FoldingLimit)) { 111 context.messages().Say(common::UsageWarning::FoldingLimit, 112 "Result of REPEAT() is too large to compute at compilation time (%g characters)"_port_en_US, 113 static_cast<double>(n) * str.size()); 114 } 115 } else { 116 return Expr<T>{Constant<T>{CharacterUtils<KIND>::REPEAT(str, n)}}; 117 } 118 } 119 } else if (name == "trim") { // not elemental 120 if (auto scalar{GetScalarConstantArguments<T>( 121 context, funcRef.arguments(), /*hasOptionalArgument=*/false)}) { 122 return Expr<T>{Constant<T>{ 123 CharacterUtils<KIND>::TRIM(std::get<Scalar<T>>(*scalar))}}; 124 } 125 } else if (name == "__builtin_compiler_options") { 126 auto &o = context.targetCharacteristics().compilerOptionsString(); 127 return Expr<T>{Constant<T>{StringType(o.begin(), o.end())}}; 128 } else if (name == "__builtin_compiler_version") { 129 auto &v = context.targetCharacteristics().compilerVersionString(); 130 return Expr<T>{Constant<T>{StringType(v.begin(), v.end())}}; 131 } 132 return Expr<T>{std::move(funcRef)}; 133 } 134 135 template <int KIND> 136 Expr<Type<TypeCategory::Character, KIND>> FoldOperation( 137 FoldingContext &context, Concat<KIND> &&x) { 138 if (auto array{ApplyElementwise(context, x)}) { 139 return *array; 140 } 141 using Result = Type<TypeCategory::Character, KIND>; 142 if (auto folded{OperandsAreConstants(x)}) { 143 return Expr<Result>{Constant<Result>{folded->first + folded->second}}; 144 } 145 return Expr<Result>{std::move(x)}; 146 } 147 148 template <int KIND> 149 Expr<Type<TypeCategory::Character, KIND>> FoldOperation( 150 FoldingContext &context, SetLength<KIND> &&x) { 151 if (auto array{ApplyElementwise(context, x)}) { 152 return *array; 153 } 154 using Result = Type<TypeCategory::Character, KIND>; 155 if (auto folded{OperandsAreConstants(x)}) { 156 auto oldLength{static_cast<ConstantSubscript>(folded->first.size())}; 157 auto newLength{folded->second.ToInt64()}; 158 if (newLength < oldLength) { 159 folded->first.erase(newLength); 160 } else { 161 folded->first.append(newLength - oldLength, ' '); 162 } 163 CHECK(static_cast<ConstantSubscript>(folded->first.size()) == newLength); 164 return Expr<Result>{Constant<Result>{std::move(folded->first)}}; 165 } 166 return Expr<Result>{std::move(x)}; 167 } 168 169 #ifdef _MSC_VER // disable bogus warning about missing definitions 170 #pragma warning(disable : 4661) 171 #endif 172 FOR_EACH_CHARACTER_KIND(template class ExpressionBase, ) 173 template class ExpressionBase<SomeCharacter>; 174 } // namespace Fortran::evaluate 175