76 implicit none;
private
106 module procedure :: evaluate_expression_default
107 module procedure :: evaluate_expression_with_context
124 logical function evaluate_expression_default(expr, macros, val)
result(res)
125 character(*),
intent(in) :: expr
126 type(
macro),
allocatable,
intent(inout) :: macros(:)
127 integer,
intent(out),
optional :: val
148 logical function evaluate_expression_with_context(expr, macros, ctx, val)
result(res)
149 character(*),
intent(in) :: expr
150 type(
macro),
allocatable,
intent(inout) :: macros(:)
151 type(
context),
intent(in) :: ctx
152 integer,
intent(out),
optional :: val
154 type(
token),
allocatable :: tokens(:)
155 integer :: ntokens, pos, result
157 call tokenize(expr, tokens, ntokens)
158 if (ntokens == 0)
then
160 message=
'Tokenization failed', &
162 source=
trim(ctx%path)), &
170 if (pos <= ntokens)
then
172 message=
'Tokenization failed', &
173 label=
label_type(
'Extra tokens found', tokens(pos)%start,
len_trim(tokens(pos)%value)), &
174 source=
trim(ctx%path)), &
180 if (
present(val)) val = result
195 recursive integer function parse_expression(expr, tokens, ntokens, pos, macros, ctx)
result(val)
196 character(*),
intent(in) :: expr
197 type(
token),
intent(in) :: tokens(:)
198 integer,
intent(in) :: ntokens
199 integer,
intent(inout) :: pos
200 type(
macro),
allocatable,
intent(inout) :: macros(:)
201 type(
context),
intent(in) :: ctx
203 val = parse_conditional(expr, tokens, ntokens, pos, macros, ctx)
217 recursive integer function parse_conditional(expr, tokens, ntokens, pos, macros, ctx)
result(val)
218 character(*),
intent(in) :: expr
219 type(
token),
intent(in) :: tokens(:)
220 integer,
intent(in) :: ntokens
221 integer,
intent(inout) :: pos
222 type(
macro),
allocatable,
intent(inout) :: macros(:)
223 type(
context),
intent(in) :: ctx
225 integer :: condition, true_val, false_val
228 condition = parse_or(expr, tokens, ntokens, pos, macros, ctx)
229 if (pos > ntokens)
then
234 if (pos <= ntokens .and. tokens(pos)%value ==
'?')
then
240 if (pos > ntokens .or. tokens(pos)%value /=
':')
then
242 message=
'Syntax error', &
243 label=
label_type(
'Expected ":" in conditional expression', 1,
len(expr)), &
244 source=
trim(ctx%path)), &
253 false_val = parse_conditional(expr, tokens, ntokens, pos, macros, ctx)
256 val = merge(true_val, false_val, condition /= 0)
274 recursive integer function parse_or(expr, tokens, ntokens, pos, macros, ctx)
result(val)
275 character(*),
intent(in) :: expr
276 type(
token),
intent(in) :: tokens(:)
277 integer,
intent(in) :: ntokens
278 integer,
intent(inout) :: pos
279 type(
macro),
allocatable,
intent(inout) :: macros(:)
280 type(
context),
intent(in) :: ctx
284 left = parse_and(expr, tokens, ntokens, pos, macros, ctx)
285 if (pos > ntokens)
then
289 do while (pos <= ntokens .and. tokens(pos)%value ==
'||')
291 val = merge(1, 0, left /= 0 .or. parse_and(expr, tokens, ntokens, pos, macros, ctx) /= 0)
308 recursive integer function parse_and(expr, tokens, ntokens, pos, macros, ctx)
result(val)
309 character(*),
intent(in) :: expr
310 type(
token),
intent(in) :: tokens(:)
311 integer,
intent(in) :: ntokens
312 integer,
intent(inout) :: pos
313 type(
macro),
allocatable,
intent(inout) :: macros(:)
314 type(
context),
intent(in) :: ctx
318 left = parse_bitwise_or(expr, tokens, ntokens, pos, macros, ctx)
319 if (pos > ntokens)
then
323 do while (pos <= ntokens .and. tokens(pos)%value ==
'&&')
325 val = merge(1, 0, left /= 0 .and. parse_bitwise_or(expr, tokens, ntokens, pos, macros, ctx) /= 0)
342 recursive integer function parse_bitwise_or(expr, tokens, ntokens, pos, macros, ctx)
result(val)
343 character(*),
intent(in) :: expr
344 type(
token),
intent(in) :: tokens(:)
345 integer,
intent(in) :: ntokens
346 integer,
intent(inout) :: pos
347 type(
macro),
allocatable,
intent(inout) :: macros(:)
348 type(
context),
intent(in) :: ctx
352 left = parse_bitwise_xor(expr, tokens, ntokens, pos, macros, ctx)
353 if (pos > ntokens)
then
357 do while (pos <= ntokens .and. tokens(pos)%value ==
'|')
359 val = parse_bitwise_xor(expr, tokens, ntokens, pos, macros, ctx)
360 left = ior(left, val)
376 recursive integer function parse_bitwise_xor(expr, tokens, ntokens, pos, macros, ctx)
result(val)
377 character(*),
intent(in) :: expr
378 type(
token),
intent(in) :: tokens(:)
379 integer,
intent(in) :: ntokens
380 integer,
intent(inout) :: pos
381 type(
macro),
allocatable,
intent(inout) :: macros(:)
382 type(
context),
intent(in) :: ctx
386 left = parse_bitwise_and(expr, tokens, ntokens, pos, macros, ctx)
387 if (pos > ntokens)
then
391 do while (pos <= ntokens .and. tokens(pos)%value ==
'^')
393 val = parse_bitwise_and(expr, tokens, ntokens, pos, macros, ctx)
394 left = ieor(left, val)
410 recursive integer function parse_bitwise_and(expr, tokens, ntokens, pos, macros, ctx)
result(val)
411 character(*),
intent(in) :: expr
412 type(
token),
intent(in) :: tokens(:)
413 integer,
intent(in) :: ntokens
414 integer,
intent(inout) :: pos
415 type(
macro),
allocatable,
intent(inout) :: macros(:)
416 type(
context),
intent(in) :: ctx
420 left = parse_equality(expr, tokens, ntokens, pos, macros, ctx)
421 if (pos > ntokens)
then
425 do while (pos <= ntokens .and. tokens(pos)%value ==
'&')
427 val = parse_equality(expr, tokens, ntokens, pos, macros, ctx)
428 left = iand(left, val)
444 recursive integer function parse_equality(expr, tokens, ntokens, pos, macros, ctx)
result(val)
445 character(*),
intent(in) :: expr
446 type(
token),
intent(in) :: tokens(:)
447 integer,
intent(in) :: ntokens
448 integer,
intent(inout) :: pos
449 type(
macro),
allocatable,
intent(inout) :: macros(:)
450 type(
context),
intent(in) :: ctx
452 integer :: left, right
454 left = parse_relational(expr, tokens, ntokens, pos, macros, ctx)
455 if (pos > ntokens)
then
459 do while (pos <= ntokens .and. (tokens(pos)%value ==
'==' .or. tokens(pos)%value ==
'!='))
460 if (tokens(pos)%value ==
'==')
then
462 right = parse_relational(expr, tokens, ntokens, pos, macros, ctx)
463 val = merge(1, 0, left == right)
466 right = parse_relational(expr, tokens, ntokens, pos, macros, ctx)
467 val = merge(1, 0, left /= right)
485 recursive integer function parse_relational(expr, tokens, ntokens, pos, macros, ctx)
result(val)
486 character(*),
intent(in) :: expr
487 type(
token),
intent(in) :: tokens(:)
488 integer,
intent(in) :: ntokens
489 integer,
intent(inout) :: pos
490 type(
macro),
allocatable,
intent(inout) :: macros(:)
491 type(
context),
intent(in) :: ctx
493 integer :: left, right
495 left = parse_shifting(expr, tokens, ntokens, pos, macros, ctx)
496 if (pos > ntokens)
then
500 do while (pos <= ntokens .and. (tokens(pos)%value ==
'<' .or. tokens(pos)%value ==
'>' .or. &
501 tokens(pos)%value ==
'<=' .or. tokens(pos)%value ==
'>='))
502 if (tokens(pos)%value ==
'<')
then
504 right = parse_shifting(expr, tokens, ntokens, pos, macros, ctx)
505 val = merge(1, 0, left < right)
506 else if (tokens(pos)%value ==
'>')
then
508 right = parse_shifting(expr, tokens, ntokens, pos, macros, ctx)
509 val = merge(1, 0, left > right)
510 else if (tokens(pos)%value ==
'<=')
then
512 right = parse_shifting(expr, tokens, ntokens, pos, macros, ctx)
513 val = merge(1, 0, left <= right)
516 right = parse_shifting(expr, tokens, ntokens, pos, macros, ctx)
517 val = merge(1, 0, left >= right)
535 recursive integer function parse_shifting(expr, tokens, ntokens, pos, macros, ctx)
result(val)
536 character(*),
intent(in) :: expr
537 type(
token),
intent(in) :: tokens(:)
538 integer,
intent(in) :: ntokens
539 integer,
intent(inout) :: pos
540 type(
macro),
allocatable,
intent(inout) :: macros(:)
541 type(
context),
intent(in) :: ctx
543 integer :: left, right
545 left = parse_additive(expr, tokens, ntokens, pos, macros, ctx)
546 if (pos > ntokens)
then
550 do while (pos <= ntokens .and. (tokens(pos)%value ==
'<<' .or. tokens(pos)%value ==
'>>'))
551 if (tokens(pos)%value ==
'<<')
then
553 right = parse_additive(expr, tokens, ntokens, pos, macros, ctx)
554 val = lshift(left, right)
557 right = parse_additive(expr, tokens, ntokens, pos, macros, ctx)
558 val = rshift(left, right)
576 recursive integer function parse_additive(expr, tokens, ntokens, pos, macros, ctx)
result(val)
577 character(*),
intent(in) :: expr
578 type(
token),
intent(in) :: tokens(:)
579 integer,
intent(in) :: ntokens
580 integer,
intent(inout) :: pos
581 type(
macro),
allocatable,
intent(inout) :: macros(:)
582 type(
context),
intent(in) :: ctx
584 integer :: left, right
586 left = parse_multiplicative(expr, tokens, ntokens, pos, macros, ctx)
587 if (pos > ntokens)
then
591 do while (pos <= ntokens .and. (tokens(pos)%value ==
'+' .or. tokens(pos)%value ==
'-'))
592 if (tokens(pos)%value ==
'+')
then
594 right = parse_multiplicative(expr, tokens, ntokens, pos, macros, ctx)
598 right = parse_multiplicative(expr, tokens, ntokens, pos, macros, ctx)
617 recursive integer function parse_multiplicative(expr, tokens, ntokens, pos, macros, ctx)
result(val)
618 character(*),
intent(in) :: expr
619 type(
token),
intent(in) :: tokens(:)
620 integer,
intent(in) :: ntokens
621 integer,
intent(inout) :: pos
622 type(
macro),
allocatable,
intent(inout) :: macros(:)
623 type(
context),
intent(in) :: ctx
625 integer :: left, right
627 left = parse_unary(expr, tokens, ntokens, pos, macros, ctx)
628 if (pos > ntokens)
then
632 do while (pos <= ntokens .and. (tokens(pos)%value ==
'*' .or. tokens(pos)%value ==
'/' .or. tokens(pos)%value ==
'%'))
633 if (tokens(pos)%value ==
'*')
then
635 right = parse_unary(expr, tokens, ntokens, pos, macros, ctx)
637 else if (tokens(pos)%value ==
'/')
then
639 right = parse_unary(expr, tokens, ntokens, pos, macros, ctx)
643 right = parse_unary(expr, tokens, ntokens, pos, macros, ctx)
644 val = modulo(left, right)
662 recursive integer function parse_power(expr, tokens, ntokens, pos, macros, ctx)
result(val)
663 character(*),
intent(in) :: expr
664 type(
token),
intent(in) :: tokens(:)
665 integer,
intent(in) :: ntokens
666 integer,
intent(inout) :: pos
667 type(
macro),
allocatable,
intent(inout) :: macros(:)
668 type(
context),
intent(in) :: ctx
670 integer :: left, right
672 left = parse_atom(expr, tokens, ntokens, pos, macros, ctx)
673 if (pos > ntokens)
then
677 if (pos <= ntokens .and. tokens(pos)%value ==
'**')
then
680 right = parse_power(expr, tokens, ntokens, pos, macros, ctx)
698 recursive integer function parse_unary(expr, tokens, ntokens, pos, macros, ctx)
result(val)
699 character(*),
intent(in) :: expr
700 type(
token),
intent(in) :: tokens(:)
701 integer,
intent(in) :: ntokens
702 integer,
intent(inout) :: pos
703 type(
macro),
allocatable,
intent(inout) :: macros(:)
704 type(
context),
intent(in) :: ctx
706 if (pos <= ntokens .and. tokens(pos)%value ==
'!')
then
708 val = merge(0, 1, parse_unary(expr, tokens, ntokens, pos, macros, ctx) /= 0)
709 else if (pos <= ntokens .and. tokens(pos)%value ==
'-')
then
711 val = -parse_unary(expr, tokens, ntokens, pos, macros, ctx)
712 else if (pos <= ntokens .and. tokens(pos)%value ==
'+')
then
714 val = parse_unary(expr, tokens, ntokens, pos, macros, ctx)
715 else if (pos <= ntokens .and. tokens(pos)%value ==
'~')
then
717 val = not(parse_unary(expr, tokens, ntokens, pos, macros, ctx))
719 val = parse_power(expr, tokens, ntokens, pos, macros, ctx)
734 recursive integer function parse_atom(expr, tokens, ntokens, pos, macros, ctx)
result(val)
735 character(*),
intent(in) :: expr
736 type(
token),
intent(in) :: tokens(:)
737 integer,
intent(in) :: ntokens
738 integer,
intent(inout) :: pos
739 type(
macro),
allocatable,
intent(inout) :: macros(:)
740 type(
context),
intent(in) :: ctx
743 character(:),
allocatable :: expanded
746 if (pos > ntokens)
then
748 message=
'Syntax error', &
749 label=
label_type(
'Unexpected end of expression', pos, 1), &
750 source=
trim(ctx%path)), &
756 if (tokens(pos)%type == 0)
then
757 val =
strtol(tokens(pos)%value)
759 else if (tokens(pos)%type == 2)
then
760 if (
is_defined(tokens(pos)%value, macros))
then
761 expanded =
expand_macros(tokens(pos)%value, macros, stitch,
global%implicit_continuation, &
762 global%support_dollar_insert, ctx)
768 else if (tokens(pos)%value ==
'(')
then
771 if (pos > ntokens .or. tokens(pos)%value /=
')')
then
773 message=
'Syntax error', &
774 label=
label_type(
'Missing closing parenthesis in expression',
len(expr), 1), &
775 source=
trim(ctx%path)), &
781 else if (tokens(pos)%type == 4)
then
782 expanded =
trim(tokens(pos)%value)
783 val = merge(1, 0,
is_defined(expanded, macros))
787 message=
'Invalid expression', &
789 source=
trim(ctx%path)), &
type(global_settings), public global
The single global instance used throughout fpx Initialized automatically with sensible defaults value...
character(:) function, allocatable, public expand_macros(line, macros, stitch, implicit_conti, dollar_insert, ctx)
Core recursive macro expander (handles function-like, variadic, #, ##).
logical function, public is_defined(name, macros, idx)
Check if a macro with given name exists in table.
recursive integer function, public parse_expression(expr, tokens, ntokens, pos, macros, ctx)
Parses a sequence of tokens starting at position pos as a full expression. Entry point for the recurs...
subroutine, public tokenize(expr, tokens, ntokens)
Tokenizes a preprocessor expression into an array of token structures. Handles whitespace,...
Interface to render diagnostic messages and labels.
Evaluates a preprocessor-style expression with macro substitution. Tokenizes the input expression,...
Return the trimmed length of a string.
Return the length of a string.
Return the trimmed string.
Converts a string to integer.
Source location and content snapshot for precise diagnostics Instances of this type are created for e...
Definition of diagnostic message.
Represents text as a sequence of ASCII code units. The derived type wraps an allocatable character ar...
Derived type representing a single preprocessor macro Extends string with macro-specific fields: rep...
Represents a single token in a parsed expression. Holds the string value of the token and its classif...