Line data Source code
1 : !> Utility functions and types for the HSD parser
2 : module hsd_utils
3 : use hsd_constants, only: dp
4 : implicit none (type, external)
5 : private
6 :
7 : public :: string_buffer_t
8 : public :: to_lower
9 :
10 : !> Initial buffer capacity
11 : integer, parameter :: BUFFER_INITIAL_CAPACITY = 256
12 :
13 : !> String buffer for efficient string building
14 : !>
15 : !> Avoids O(n²) string concatenation by pre-allocating buffer space
16 : !> and growing geometrically when needed.
17 : type :: string_buffer_t
18 : character(len=:), allocatable :: buffer
19 : integer :: length = 0
20 : integer :: capacity = 0
21 : contains
22 : procedure :: init => buffer_init
23 : procedure :: append_char => buffer_append_char
24 : procedure :: append_str => buffer_append_str
25 : procedure :: get_string => buffer_get_string
26 : procedure :: clear => buffer_clear
27 : end type string_buffer_t
28 :
29 : contains
30 :
31 : !> Initialize the string buffer with given or default capacity
32 2801 : subroutine buffer_init(self)
33 : class(string_buffer_t), intent(inout) :: self
34 :
35 2801 : self%capacity = BUFFER_INITIAL_CAPACITY
36 4 : if (allocated(self%buffer)) deallocate(self%buffer)
37 2801 : allocate(character(len=self%capacity) :: self%buffer)
38 2801 : self%length = 0
39 :
40 2801 : end subroutine buffer_init
41 :
42 : !> Append a single character to the buffer
43 28758 : subroutine buffer_append_char(self, ch)
44 : class(string_buffer_t), intent(inout) :: self
45 : character(len=1), intent(in) :: ch
46 :
47 28758 : character(len=:), allocatable :: new_buffer
48 28758 : integer :: new_capacity
49 :
50 : ! Initialize if needed
51 28758 : if (self%capacity == 0) call self%init()
52 :
53 : ! Grow buffer if needed (double capacity)
54 28758 : if (self%length >= self%capacity) then
55 5 : new_capacity = self%capacity * 2
56 5 : allocate(character(len=new_capacity) :: new_buffer)
57 5 : new_buffer(1:self%length) = self%buffer(1:self%length)
58 5 : call move_alloc(new_buffer, self%buffer)
59 5 : self%capacity = new_capacity
60 : end if
61 :
62 28758 : self%length = self%length + 1
63 28758 : self%buffer(self%length:self%length) = ch
64 :
65 31559 : end subroutine buffer_append_char
66 :
67 : !> Append a string to the buffer
68 2334 : subroutine buffer_append_str(self, str)
69 : class(string_buffer_t), intent(inout) :: self
70 : character(len=*), intent(in) :: str
71 :
72 2334 : character(len=:), allocatable :: new_buffer
73 2334 : integer :: new_capacity, str_len
74 :
75 2334 : str_len = len(str)
76 0 : if (str_len == 0) return
77 :
78 : ! Initialize if needed
79 2334 : if (self%capacity == 0) call self%init()
80 :
81 : ! Grow buffer if needed
82 2334 : if (self%length + str_len > self%capacity) then
83 7 : new_capacity = max(self%capacity * 2, self%length + str_len)
84 7 : allocate(character(len=new_capacity) :: new_buffer)
85 7 : new_buffer(1:self%length) = self%buffer(1:self%length)
86 7 : call move_alloc(new_buffer, self%buffer)
87 7 : self%capacity = new_capacity
88 : end if
89 :
90 2334 : self%buffer(self%length+1:self%length+str_len) = str
91 2334 : self%length = self%length + str_len
92 :
93 31092 : end subroutine buffer_append_str
94 :
95 : !> Get the accumulated string
96 2801 : function buffer_get_string(self) result(str)
97 : class(string_buffer_t), intent(in) :: self
98 : character(len=:), allocatable :: str
99 :
100 2801 : if (self%length > 0) then
101 2797 : str = self%buffer(1:self%length)
102 : else
103 4 : str = ""
104 : end if
105 :
106 2334 : end function buffer_get_string
107 :
108 : !> Clear the buffer for reuse (keeps capacity)
109 3 : subroutine buffer_clear(self)
110 : class(string_buffer_t), intent(inout) :: self
111 3 : self%length = 0
112 2801 : end subroutine buffer_clear
113 :
114 : !> Convert a string to lowercase
115 552203 : pure function to_lower(str) result(lower)
116 : character(len=*), intent(in) :: str
117 : character(len=len(str)) :: lower
118 552203 : integer :: i, ic
119 :
120 5383248 : do i = 1, len(str)
121 4831045 : ic = ichar(str(i:i))
122 5383248 : if (ic >= 65 .and. ic <= 90) then
123 3036 : lower(i:i) = char(ic + 32)
124 : else
125 4828009 : lower(i:i) = str(i:i)
126 : end if
127 : end do
128 1104409 : end function to_lower
129 :
130 552203 : end module hsd_utils
|