Line data Source code
1 : !> Lexer (tokenizer) for HSD files
2 : !>
3 : !> This module provides the lexer that converts a character stream into
4 : !> a sequence of tokens for the HSD parser.
5 : module hsd_lexer
6 : use hsd_constants, only: hsd_max_line_length, &
7 : & CHAR_TAB, CHAR_BACKSLASH, CHAR_SPACE, CHAR_NEWLINE, CHAR_LBRACE, &
8 : & CHAR_RBRACE, CHAR_LBRACKET, CHAR_RBRACKET, CHAR_EQUAL, CHAR_SEMICOLON, &
9 : & CHAR_HASH, CHAR_DQUOTE, CHAR_SQUOTE, CHAR_LESS
10 : use hsd_utils, only: to_lower, string_buffer_t
11 : use hsd_token, only: hsd_token_t, TOKEN_EOF, TOKEN_NAME, TOKEN_STRING, &
12 : TOKEN_LBRACE, TOKEN_RBRACE, TOKEN_EQUAL, TOKEN_LBRACKET, TOKEN_RBRACKET, &
13 : TOKEN_INCLUDE_TXT, TOKEN_INCLUDE_HSD, TOKEN_SEMICOLON, TOKEN_COMMENT, &
14 : TOKEN_NEWLINE, TOKEN_TEXT
15 : use hsd_error, only: hsd_error_t, make_error, &
16 : HSD_STAT_OK, HSD_STAT_IO_ERROR, HSD_STAT_UNCLOSED_QUOTE, HSD_STAT_UNCLOSED_ATTRIB, &
17 : HSD_STAT_FILE_NOT_FOUND
18 : implicit none (type, external)
19 : private
20 :
21 : public :: hsd_lexer_t, new_lexer_from_file, new_lexer_from_string
22 :
23 : !> Lexer state
24 : type :: hsd_lexer_t
25 : !> Source filename (for error reporting)
26 : character(len=:), allocatable :: filename
27 : !> Source content
28 : character(len=:), allocatable :: source
29 : !> Current position in source
30 : integer :: pos = 1
31 : !> Current line number (1-based)
32 : integer :: line = 1
33 : !> Current column number (1-based)
34 : integer :: column = 1
35 : !> Length of source
36 : integer :: source_len = 0
37 : !> Whether we're inside an attribute context
38 : logical :: in_attrib = .false.
39 : !> Whether we're inside a quoted string
40 : logical :: in_quote = .false.
41 : !> Quote character being used
42 : character(len=1) :: quote_char = ''
43 : contains
44 : procedure :: next_token => lexer_next_token
45 : procedure :: peek_char => lexer_peek_char
46 : procedure :: advance => lexer_advance
47 : procedure :: skip_whitespace => lexer_skip_whitespace
48 : procedure :: read_string => lexer_read_string
49 : procedure :: read_text => lexer_read_text
50 : procedure :: read_comment => lexer_read_comment
51 : procedure :: is_eof => lexer_is_eof
52 : end type hsd_lexer_t
53 :
54 : contains
55 :
56 : !> Create a new lexer from a file
57 72 : subroutine new_lexer_from_file(lexer, filename, error)
58 : type(hsd_lexer_t), intent(out) :: lexer
59 : character(len=*), intent(in) :: filename
60 : type(hsd_error_t), allocatable, intent(out), optional :: error
61 :
62 36 : integer :: unit_num, io_stat
63 36 : integer :: file_size
64 : character(len=256) :: io_msg
65 36 : logical :: file_exists
66 :
67 : ! Check if file exists
68 36 : inquire(file=filename, exist=file_exists)
69 36 : if (.not. file_exists) then
70 5 : if (present(error)) then
71 : call make_error(error, HSD_STAT_FILE_NOT_FOUND, &
72 5 : "File not found: " // trim(filename), filename)
73 : end if
74 5 : return
75 : end if
76 :
77 : ! Get file size
78 31 : inquire(file=filename, size=file_size)
79 :
80 : ! Open and read file
81 : open(newunit=unit_num, file=filename, status='old', action='read', &
82 31 : access='stream', form='unformatted', iostat=io_stat, iomsg=io_msg)
83 31 : if (io_stat /= 0) then
84 0 : if (present(error)) then
85 0 : call make_error(error, HSD_STAT_IO_ERROR, trim(io_msg), filename)
86 : end if
87 0 : return
88 : end if
89 :
90 : ! Allocate and read content
91 31 : allocate(character(len=file_size) :: lexer%source)
92 31 : read(unit_num, iostat=io_stat) lexer%source
93 31 : close(unit_num)
94 :
95 31 : if (io_stat /= 0 .and. io_stat /= -1) then ! -1 is EOF, which is okay
96 0 : if (present(error)) then
97 0 : call make_error(error, HSD_STAT_IO_ERROR, "Error reading file", filename)
98 : end if
99 0 : return
100 : end if
101 :
102 31 : lexer%filename = filename
103 31 : lexer%source_len = len(lexer%source)
104 31 : lexer%pos = 1
105 31 : lexer%line = 1
106 31 : lexer%column = 1
107 :
108 36 : end subroutine new_lexer_from_file
109 :
110 : !> Create a new lexer from a string
111 3152 : subroutine new_lexer_from_string(lexer, source, filename)
112 : type(hsd_lexer_t), intent(out) :: lexer
113 : character(len=*), intent(in) :: source
114 : character(len=*), intent(in), optional :: filename
115 :
116 1576 : lexer%source = source
117 1576 : lexer%source_len = len(source)
118 1576 : lexer%pos = 1
119 1576 : lexer%line = 1
120 1576 : lexer%column = 1
121 :
122 1576 : if (present(filename)) then
123 4 : lexer%filename = filename
124 : else
125 1572 : lexer%filename = "<string>"
126 : end if
127 :
128 36 : end subroutine new_lexer_from_string
129 :
130 : !> Check if lexer is at end of file
131 1150815 : pure function lexer_is_eof(self) result(is_eof)
132 : class(hsd_lexer_t), intent(in) :: self
133 : logical :: is_eof
134 1150815 : is_eof = self%pos > self%source_len
135 1576 : end function lexer_is_eof
136 :
137 : !> Peek at current character without advancing
138 1154644 : pure function lexer_peek_char(self, offset) result(ch)
139 : class(hsd_lexer_t), intent(in) :: self
140 : integer, intent(in), optional :: offset
141 : character(len=1) :: ch
142 1154644 : integer :: peek_pos
143 :
144 1154644 : if (present(offset)) then
145 76 : peek_pos = self%pos + offset
146 : else
147 1154568 : peek_pos = self%pos
148 : end if
149 :
150 1154644 : if (peek_pos > 0 .and. peek_pos <= self%source_len) then
151 1154639 : ch = self%source(peek_pos:peek_pos)
152 : else
153 5 : ch = char(0) ! NUL for EOF
154 : end if
155 :
156 1150815 : end function lexer_peek_char
157 :
158 : !> Advance position by n characters
159 1007455 : subroutine lexer_advance(self, n)
160 : class(hsd_lexer_t), intent(inout) :: self
161 : integer, intent(in), optional :: n
162 :
163 1007455 : integer :: i, steps
164 : character(len=1) :: ch
165 :
166 1007455 : if (present(n)) then
167 31 : steps = n
168 : else
169 1007424 : steps = 1
170 : end if
171 :
172 2014972 : do i = 1, steps
173 2014972 : if (self%pos <= self%source_len) then
174 1007517 : ch = self%source(self%pos:self%pos)
175 1007517 : if (ch == CHAR_NEWLINE) then
176 20328 : self%line = self%line + 1
177 20328 : self%column = 1
178 : else
179 987189 : self%column = self%column + 1
180 : end if
181 1007517 : self%pos = self%pos + 1
182 : end if
183 : end do
184 :
185 1154644 : end subroutine lexer_advance
186 :
187 : !> Skip whitespace characters (not newlines)
188 86405 : subroutine lexer_skip_whitespace(self)
189 : class(hsd_lexer_t), intent(inout) :: self
190 : character(len=1) :: ch
191 :
192 146986 : do while (.not. self%is_eof())
193 145407 : ch = self%peek_char()
194 145407 : if (ch == CHAR_SPACE .or. ch == CHAR_TAB) then
195 60581 : call self%advance()
196 : else
197 84826 : exit
198 : end if
199 : end do
200 :
201 1007455 : end subroutine lexer_skip_whitespace
202 :
203 : !> Read a quoted string
204 7112 : subroutine lexer_read_string(self, token)
205 : class(hsd_lexer_t), intent(inout) :: self
206 : type(hsd_token_t), intent(out) :: token
207 :
208 : character(len=1) :: quote_char, ch
209 7112 : type(string_buffer_t) :: buf
210 7112 : integer :: start_line, start_col
211 7112 : logical :: escaped
212 :
213 7112 : start_line = self%line
214 7112 : start_col = self%column
215 7112 : quote_char = self%peek_char()
216 7112 : call self%advance() ! Skip opening quote
217 :
218 7112 : call buf%init()
219 7112 : escaped = .false.
220 :
221 32157 : do while (.not. self%is_eof())
222 32152 : ch = self%peek_char()
223 :
224 32152 : if (escaped) then
225 : ! Handle escape sequences
226 2 : select case (ch)
227 : case ('n')
228 2 : call buf%append_char(CHAR_NEWLINE)
229 : case ('t')
230 2 : call buf%append_char(CHAR_TAB)
231 : case ('\')
232 4 : call buf%append_char(CHAR_BACKSLASH)
233 : case ('"')
234 1 : call buf%append_char(CHAR_DQUOTE)
235 : case ("'")
236 0 : call buf%append_char(CHAR_SQUOTE)
237 : case default
238 10 : call buf%append_char(ch)
239 : end select
240 10 : escaped = .false.
241 10 : call self%advance()
242 32142 : else if (ch == CHAR_BACKSLASH) then
243 10 : escaped = .true.
244 10 : call self%advance()
245 32132 : else if (ch == quote_char) then
246 7107 : call self%advance() ! Skip closing quote
247 7107 : exit
248 : else
249 25025 : call buf%append_char(ch)
250 25025 : call self%advance()
251 : end if
252 : end do
253 :
254 7112 : token%kind = TOKEN_STRING
255 7112 : token%value = buf%get_string()
256 7112 : token%line = start_line
257 7112 : token%column = start_col
258 :
259 93517 : end subroutine lexer_read_string
260 :
261 : !> Read unquoted text (identifier or value)
262 27698 : subroutine lexer_read_text(self, token, stop_chars)
263 : class(hsd_lexer_t), intent(inout) :: self
264 : type(hsd_token_t), intent(out) :: token
265 : character(len=*), intent(in) :: stop_chars
266 :
267 : character(len=1) :: ch, prev_ch
268 27698 : type(string_buffer_t) :: buf
269 27698 : integer :: start_line, start_col
270 :
271 27698 : start_line = self%line
272 27698 : start_col = self%column
273 27698 : call buf%init()
274 27698 : prev_ch = ''
275 :
276 875153 : do while (.not. self%is_eof())
277 874895 : ch = self%peek_char()
278 :
279 : ! Check for escape
280 874895 : if (prev_ch == CHAR_BACKSLASH .and. prev_ch /= CHAR_BACKSLASH) then
281 0 : call buf%append_char(ch)
282 0 : prev_ch = ch
283 0 : call self%advance()
284 0 : cycle
285 : end if
286 :
287 : ! Check for stop characters
288 874895 : if (index(stop_chars, ch) > 0) then
289 21276 : exit
290 : end if
291 :
292 : ! Check for newline
293 853619 : if (ch == CHAR_NEWLINE .or. ch == char(13)) then
294 6164 : exit
295 : end if
296 :
297 847455 : call buf%append_char(ch)
298 847455 : prev_ch = ch
299 847455 : call self%advance()
300 : end do
301 :
302 27698 : token%kind = TOKEN_TEXT
303 27698 : token%value = buf%get_string()
304 27698 : token%line = start_line
305 27698 : token%column = start_col
306 :
307 34810 : end subroutine lexer_read_text
308 :
309 : !> Read a comment (from # to end of line)
310 10 : subroutine lexer_read_comment(self, token)
311 : class(hsd_lexer_t), intent(inout) :: self
312 : type(hsd_token_t), intent(out) :: token
313 :
314 : character(len=1) :: ch
315 10 : type(string_buffer_t) :: buf
316 10 : integer :: start_line, start_col
317 :
318 10 : start_line = self%line
319 10 : start_col = self%column
320 10 : call self%advance() ! Skip #
321 :
322 10 : call buf%init()
323 10145 : do while (.not. self%is_eof())
324 10139 : ch = self%peek_char()
325 10139 : if (ch == CHAR_NEWLINE) then
326 4 : exit
327 : end if
328 10135 : call buf%append_char(ch)
329 10135 : call self%advance()
330 : end do
331 :
332 10 : token%kind = TOKEN_COMMENT
333 10 : token%value = buf%get_string()
334 10 : token%line = start_line
335 10 : token%column = start_col
336 :
337 27708 : end subroutine lexer_read_comment
338 :
339 : !> Get the next token from the source
340 121191 : subroutine lexer_next_token(self, token, in_attrib)
341 : class(hsd_lexer_t), intent(inout) :: self
342 : type(hsd_token_t), intent(out) :: token
343 : logical, intent(in), optional :: in_attrib
344 :
345 : character(len=1) :: ch, ch2, ch3
346 : character(len=*), parameter :: general_stop = "{}[]<=""'#;"
347 : character(len=*), parameter :: attrib_stop = "]""'"
348 86374 : character(len=:), allocatable :: stop_chars
349 86374 : logical :: inside_attrib
350 :
351 86374 : if (present(in_attrib)) then
352 0 : inside_attrib = in_attrib
353 : else
354 86374 : inside_attrib = self%in_attrib
355 : end if
356 :
357 86374 : if (inside_attrib) then
358 0 : stop_chars = attrib_stop
359 : else
360 86374 : stop_chars = general_stop
361 : end if
362 :
363 : ! Skip whitespace
364 86374 : call self%skip_whitespace()
365 :
366 : ! Check for EOF
367 86374 : if (self%is_eof()) then
368 1577 : token%kind = TOKEN_EOF
369 1577 : token%line = self%line
370 1577 : token%column = self%column
371 1577 : return
372 : end if
373 :
374 84797 : ch = self%peek_char()
375 :
376 : ! Single character tokens
377 20326 : select case (ch)
378 : case (CHAR_NEWLINE)
379 20326 : token%kind = TOKEN_NEWLINE
380 20326 : token%line = self%line
381 20326 : token%column = self%column
382 20326 : call self%advance()
383 20326 : return
384 :
385 : case (char(13)) ! Carriage return
386 3 : call self%advance()
387 3 : if (self%peek_char() == CHAR_NEWLINE) then
388 5 : call self%advance()
389 : end if
390 3 : token%kind = TOKEN_NEWLINE
391 3 : token%line = self%line
392 3 : token%column = self%column
393 3 : return
394 :
395 : case (CHAR_LBRACE)
396 6414 : token%kind = TOKEN_LBRACE
397 6414 : token%line = self%line
398 6414 : token%column = self%column
399 6414 : call self%advance()
400 6414 : return
401 :
402 : case (CHAR_RBRACE)
403 6409 : token%kind = TOKEN_RBRACE
404 6409 : token%line = self%line
405 6409 : token%column = self%column
406 6409 : call self%advance()
407 6409 : return
408 :
409 : case (CHAR_LBRACKET)
410 1032 : token%kind = TOKEN_LBRACKET
411 1032 : token%line = self%line
412 1032 : token%column = self%column
413 1032 : call self%advance()
414 1032 : return
415 :
416 : case (CHAR_RBRACKET)
417 1031 : token%kind = TOKEN_RBRACKET
418 1031 : token%line = self%line
419 1031 : token%column = self%column
420 1031 : call self%advance()
421 1031 : return
422 :
423 : case (CHAR_EQUAL)
424 14711 : token%kind = TOKEN_EQUAL
425 14711 : token%line = self%line
426 14711 : token%column = self%column
427 14711 : call self%advance()
428 14711 : return
429 :
430 : case (CHAR_SEMICOLON)
431 45 : token%kind = TOKEN_SEMICOLON
432 45 : token%line = self%line
433 45 : token%column = self%column
434 45 : call self%advance()
435 45 : return
436 :
437 : case (CHAR_HASH)
438 10 : call self%read_comment(token)
439 10 : return
440 :
441 : case (CHAR_DQUOTE, CHAR_SQUOTE)
442 7091 : call self%read_string(token)
443 7091 : return
444 :
445 : case (CHAR_LESS)
446 : ! Check for include directives
447 37 : ch2 = self%peek_char(1)
448 37 : ch3 = self%peek_char(2)
449 84834 : if (ch2 == CHAR_LESS .and. ch3 == CHAR_LESS) then
450 : ! <<< text include
451 7 : token%kind = TOKEN_INCLUDE_TXT
452 7 : token%line = self%line
453 7 : token%column = self%column
454 7 : call self%advance(3)
455 : ! Read the filename
456 7 : call self%skip_whitespace()
457 7 : if (self%peek_char() == CHAR_DQUOTE .or. self%peek_char() == CHAR_SQUOTE) then
458 4 : call self%read_string(token)
459 4 : token%kind = TOKEN_INCLUDE_TXT
460 : else
461 3 : call self%read_text(token, general_stop)
462 10 : token%kind = TOKEN_INCLUDE_TXT
463 : end if
464 7 : return
465 30 : else if (ch2 == CHAR_LESS .and. ch3 == '+') then
466 : ! <<+ HSD include
467 24 : token%kind = TOKEN_INCLUDE_HSD
468 24 : token%line = self%line
469 24 : token%column = self%column
470 24 : call self%advance(3)
471 : ! Read the filename
472 24 : call self%skip_whitespace()
473 24 : if (self%peek_char() == CHAR_DQUOTE .or. self%peek_char() == CHAR_SQUOTE) then
474 17 : call self%read_string(token)
475 17 : token%kind = TOKEN_INCLUDE_HSD
476 : else
477 7 : call self%read_text(token, general_stop)
478 31 : token%kind = TOKEN_INCLUDE_HSD
479 : end if
480 24 : return
481 : else
482 : ! Standalone '<' - treat as single-character text token
483 6 : token%kind = TOKEN_TEXT
484 6 : token%value = "<"
485 6 : token%line = self%line
486 6 : token%column = self%column
487 6 : call self%advance()
488 6 : return
489 : end if
490 :
491 : case default
492 : ! Fall through to read as text
493 :
494 : end select
495 :
496 : ! Default: read as text
497 27688 : call self%read_text(token, stop_chars)
498 :
499 86384 : end subroutine lexer_next_token
500 :
501 86374 : end module hsd_lexer
|
