• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1 //===-- lib/Evaluate/character.h --------------------------------*- C++ -*-===//
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 #ifndef FORTRAN_EVALUATE_CHARACTER_H_
10 #define FORTRAN_EVALUATE_CHARACTER_H_
11 
12 #include "flang/Evaluate/type.h"
13 #include <string>
14 
15 // Provides implementations of intrinsic functions operating on character
16 // scalars. No assumption is made regarding character encodings other than they
17 // must be compatible with ASCII (else, NEW_LINE, ACHAR and IACHAR need to be
18 // adapted).
19 
20 namespace Fortran::evaluate {
21 
22 template <int KIND> class CharacterUtils {
23   using Character = Scalar<Type<TypeCategory::Character, KIND>>;
24   using CharT = typename Character::value_type;
25 
26 public:
27   // CHAR also implements ACHAR under assumption that character encodings
28   // contain ASCII
CHAR(std::uint64_t code)29   static Character CHAR(std::uint64_t code) {
30     return Character{{static_cast<CharT>(code)}};
31   }
32 
33   // ICHAR also implements IACHAR under assumption that character encodings
34   // contain ASCII
ICHAR(const Character & c)35   static std::int64_t ICHAR(const Character &c) {
36     CHECK(c.length() == 1);
37     if constexpr (std::is_same_v<CharT, char>) {
38       // char may be signed, so cast it first to unsigned to avoid having
39       // ichar(char(128_4)) returning -128
40       return static_cast<unsigned char>(c[0]);
41     } else {
42       return c[0];
43     }
44   }
45 
NEW_LINE()46   static Character NEW_LINE() { return Character{{NewLine()}}; }
47 
ADJUSTL(const Character & str)48   static Character ADJUSTL(const Character &str) {
49     auto pos{str.find_first_not_of(Space())};
50     if (pos != Character::npos && pos != 0) {
51       return Character{str.substr(pos) + Character(pos, Space())};
52     }
53     // else empty or only spaces, or no leading spaces
54     return str;
55   }
56 
ADJUSTR(const Character & str)57   static Character ADJUSTR(const Character &str) {
58     auto pos{str.find_last_not_of(Space())};
59     if (pos != Character::npos && pos != str.length() - 1) {
60       auto delta{str.length() - 1 - pos};
61       return Character{Character(delta, Space()) + str.substr(0, pos + 1)};
62     }
63     // else empty or only spaces, or no trailing spaces
64     return str;
65   }
66 
67   static ConstantSubscript INDEX(
68       const Character &str, const Character &substr, bool back = false) {
69     auto pos{back ? str.rfind(substr) : str.find(substr)};
70     return static_cast<ConstantSubscript>(pos == str.npos ? 0 : pos + 1);
71   }
72 
73   static ConstantSubscript SCAN(
74       const Character &str, const Character &set, bool back = false) {
75     auto pos{back ? str.find_last_of(set) : str.find_first_of(set)};
76     return static_cast<ConstantSubscript>(pos == str.npos ? 0 : pos + 1);
77   }
78 
79   static ConstantSubscript VERIFY(
80       const Character &str, const Character &set, bool back = false) {
81     auto pos{back ? str.find_last_not_of(set) : str.find_first_not_of(set)};
82     return static_cast<ConstantSubscript>(pos == str.npos ? 0 : pos + 1);
83   }
84 
85   // Resize adds spaces on the right if the new size is bigger than the
86   // original, or by trimming the rightmost characters otherwise.
Resize(const Character & str,std::size_t newLength)87   static Character Resize(const Character &str, std::size_t newLength) {
88     auto oldLength{str.length()};
89     if (newLength > oldLength) {
90       return str + Character(newLength - oldLength, Space());
91     } else {
92       return str.substr(0, newLength);
93     }
94   }
95 
LEN_TRIM(const Character & str)96   static ConstantSubscript LEN_TRIM(const Character &str) {
97     return VERIFY(str, Character{' '}, true);
98   }
99 
REPEAT(const Character & str,ConstantSubscript ncopies)100   static Character REPEAT(const Character &str, ConstantSubscript ncopies) {
101     Character result;
102     if (!str.empty()) {
103       while (ncopies-- > 0) {
104         result += str;
105       }
106     }
107     return result;
108   }
109 
TRIM(const Character & str)110   static Character TRIM(const Character &str) {
111     return str.substr(0, LEN_TRIM(str));
112   }
113 
114 private:
115   // Following helpers assume that character encodings contain ASCII
Space()116   static constexpr CharT Space() { return 0x20; }
NewLine()117   static constexpr CharT NewLine() { return 0x0a; }
118 };
119 
120 } // namespace Fortran::evaluate
121 
122 #endif // FORTRAN_EVALUATE_CHARACTER_H_
123