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 11 namespace Fortran::evaluate { 12 13 template <int KIND> 14 Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction( 15 FoldingContext &context, 16 FunctionRef<Type<TypeCategory::Character, KIND>> &&funcRef) { 17 using T = Type<TypeCategory::Character, KIND>; 18 auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)}; 19 CHECK(intrinsic); 20 std::string name{intrinsic->name}; 21 if (name == "achar" || name == "char") { 22 using IntT = SubscriptInteger; 23 return FoldElementalIntrinsic<T, IntT>(context, std::move(funcRef), 24 ScalarFunc<T, IntT>([](const Scalar<IntT> &i) { 25 return CharacterUtils<KIND>::CHAR(i.ToUInt64()); 26 })); 27 } else if (name == "adjustl") { 28 return FoldElementalIntrinsic<T, T>( 29 context, std::move(funcRef), CharacterUtils<KIND>::ADJUSTL); 30 } else if (name == "adjustr") { 31 return FoldElementalIntrinsic<T, T>( 32 context, std::move(funcRef), CharacterUtils<KIND>::ADJUSTR); 33 } else if (name == "max") { 34 return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater); 35 } else if (name == "merge") { 36 return FoldMerge<T>(context, std::move(funcRef)); 37 } else if (name == "min") { 38 return FoldMINorMAX(context, std::move(funcRef), Ordering::Less); 39 } else if (name == "new_line") { 40 return Expr<T>{Constant<T>{CharacterUtils<KIND>::NEW_LINE()}}; 41 } else if (name == "repeat") { // not elemental 42 if (auto scalars{GetScalarConstantArguments<T, SubscriptInteger>( 43 context, funcRef.arguments())}) { 44 return Expr<T>{Constant<T>{ 45 CharacterUtils<KIND>::REPEAT(std::get<Scalar<T>>(*scalars), 46 std::get<Scalar<SubscriptInteger>>(*scalars).ToInt64())}}; 47 } 48 } else if (name == "trim") { // not elemental 49 if (auto scalar{ 50 GetScalarConstantArguments<T>(context, funcRef.arguments())}) { 51 return Expr<T>{Constant<T>{ 52 CharacterUtils<KIND>::TRIM(std::get<Scalar<T>>(*scalar))}}; 53 } 54 } 55 // TODO: cshift, eoshift, maxval, minval, pack, reduce, 56 // spread, transfer, transpose, unpack 57 return Expr<T>{std::move(funcRef)}; 58 } 59 60 template <int KIND> 61 Expr<Type<TypeCategory::Character, KIND>> FoldOperation( 62 FoldingContext &context, Concat<KIND> &&x) { 63 if (auto array{ApplyElementwise(context, x)}) { 64 return *array; 65 } 66 using Result = Type<TypeCategory::Character, KIND>; 67 if (auto folded{OperandsAreConstants(x)}) { 68 return Expr<Result>{Constant<Result>{folded->first + folded->second}}; 69 } 70 return Expr<Result>{std::move(x)}; 71 } 72 73 template <int KIND> 74 Expr<Type<TypeCategory::Character, KIND>> FoldOperation( 75 FoldingContext &context, SetLength<KIND> &&x) { 76 if (auto array{ApplyElementwise(context, x)}) { 77 return *array; 78 } 79 using Result = Type<TypeCategory::Character, KIND>; 80 if (auto folded{OperandsAreConstants(x)}) { 81 auto oldLength{static_cast<ConstantSubscript>(folded->first.size())}; 82 auto newLength{folded->second.ToInt64()}; 83 if (newLength < oldLength) { 84 folded->first.erase(newLength); 85 } else { 86 folded->first.append(newLength - oldLength, ' '); 87 } 88 CHECK(static_cast<ConstantSubscript>(folded->first.size()) == newLength); 89 return Expr<Result>{Constant<Result>{std::move(folded->first)}}; 90 } 91 return Expr<Result>{std::move(x)}; 92 } 93 94 FOR_EACH_CHARACTER_KIND(template class ExpressionBase, ) 95 template class ExpressionBase<SomeCharacter>; 96 } // namespace Fortran::evaluate 97