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 | |