conditional.f90

Go to the documentation of this file.

!> @file
!! @defgroup group_conditional Conditional
!! Full-featured conditional compilation (#if / #ifdef / #else / #endif) for the fpx preprocessor
!! This module implements standard-conforming conditional compilation with support for:
!! - `#if` with arbitrary constant expressions (using `evaluate_expression`)
!! - `#ifdef` / `#ifndef` and `#elifdef` / `#elifndef` for testing macro existence
!! - `#elif` chains (multiple alternative branches)
!! - `#else` as final fallback
!! - Proper nesting up to `MAX_COND_DEPTH` levels
!! - Correct "first-match" semantics — once a branch is taken, later `#elif`/`#else` are skipped
!! - Integration with macro expansion via `is_defined()` and expression evaluator
!!
!! The state is maintained in a global stack (`cond_stack`) with `cond_depth` tracking nesting.
!! The function `is_active()` is used throughout the preprocessor to decide whether a line
!! should be emitted or skipped.
!!
!! <h2  class="groupheader">Examples</h2>
!!
!! 1. Classic include guard pattern:
!! @code{.f90}
!!  #ifndef MY_HEADER_H
!!  #define MY_HEADER_H
!!
!!  ! ... header content ...
!!
!!  #endif
!!  ...
!! @endcode
!!
!! 2. Feature selection with #if and #elif:
!! @code{.f90}
!!  #if DEBUG >= 2
!!     print *, 'Extra verbose debugging enabled'
!!  #elif DEBUG == 1
!!     print *, 'Standard debugging'
!!  #else
!!     ! Silent mode
!!  #endif
!!  !..
!! @endcode
!!
!! 3. Cross-platform code selection:
!! @code{.f90}
!!  #ifdef _OPENMP
!!     use omp_lib
!!  #else
!!     integer, parameter :: omp_get_thread_num = 0
!!  #endif
!!  ...
!! @endcode
!!
!! 4. Complex expression in #if (requires `evaluate_expression` support):
!! @code{.f90}
!!  #if defined(USE_MPI) && (MPI_VERSION >= 3)
!!     use mpi_f08
!!  #endif
!!  ...
!! @endcode
module fpx_conditional
    use fpx_constants
    use fpx_logging
    use fpx_string
    use fpx_macro, only: macro, is_defined
    use fpx_operators, only: evaluate_expression
    use fpx_context
 
    implicit none; private
 
    public :: handle_if, &
            handle_ifdef, &
            handle_ifndef, &
            handle_elif, &
            handle_else, &
            handle_endif, &
            handle_elifdef, &
            handle_elifndef, &
            is_active
 
    !> State of a single conditional block
    !! <h2  class="groupheader">Constructors</h2>
    !! Initializes a new instance of the @ref cond_state type
    !! <h3>cond_state(logical, logical)</h3>
    !! @verbatim type(cond_state) function cond_state(logical active, logical has_met) @endverbatim
    !!
    !! @param[in] active whether code in this block should be emitted
    !! @param[in] has_met whether a true branch has already been taken at this nesting level
    !!
    !! @return The constructed @ref cond_state object.
    !!
    !! <h2  class="groupheader">Remarks</h2>
    !! @ingroup group_conditional
    type, public :: cond_state
        logical, public :: active  !< Indicate whether the condition is active
        logical, public :: has_met  !< Indicates whether the condition has been met
    end type
 
    !> @brief Global stack of conditional states (depth-limited)
    !! @ingroup group_conditional
    type(cond_state), public :: cond_stack(max_cond_depth)
 
    !> @brief Current nesting depth of conditional directives (0 = outside any #if)
    !! @ingroup group_conditional
    integer, public :: cond_depth = 0
 
contains
 
    !> Determine if current line is inside an active conditional block
    !! @return .true. if all enclosing #if/#elif/#else branches are active
    !!
    !! @b Remarks
    !! @ingroup group_conditional
    logical function is_active() result(res)
        integer :: i
        res = .true.
        do i = 1, cond_depth + 1
            if (.not. cond_stack(i)%active) then
                res = .false.
                exit
            end if
        end do
    end function
 
    !> Process a #if directive with constant expression evaluation
    !! Evaluates the expression after #if using `evaluate_expression()` and pushes
    !! a new state onto the conditional stack.
    !! @param[in] ctx       Context source line containing the directive
    !! @param[in] macros    Current macro table
    !! @param[in] token     Usually 'if'
    !!
    !! @b Remarks
    !! @ingroup group_conditional
    subroutine handle_if(ctx, macros, token)
        type(context), intent(in)   :: ctx
        type(macro), intent(in)     :: macros(:)
        character(*), intent(in)    :: token
        !private
        character(:), allocatable :: expr
        logical :: result, parent_active
        integer :: pos
 
        if (cond_depth + 1 > max_cond_depth) then
            call printf(render(diagnostic_report(level_error, &
                    message='Conditional nesting too deep', &
                    source=trim(ctx%path)), &
                    ctx%content, ctx%line))
            return
        end if
 
        pos = index(lowercase(ctx%content), token) + len(token)
        expr = trim(adjustl(ctx%content(pos:)))
        result = evaluate_expression(expr, macros, ctx)
        parent_active = is_active()
        cond_depth = cond_depth + 1
        cond_stack(cond_depth + 1)%active = result .and. parent_active
        cond_stack(cond_depth + 1)%has_met = result
    end subroutine
 
    !> Process #ifdef – test if a macro is defined
    !! @param[in] ctx       Context source line containing the directive
    !! @param[in] macros    Current macro table
    !! @param[in] token     Usually 'ifdef'
    !!
    !! @b Remarks
    !! @ingroup group_conditional
    subroutine handle_ifdef(ctx, macros, token)
        type(context), intent(in)       :: ctx
        type(macro), intent(in)         :: macros(:)
        character(*), intent(in)        :: token
        !private
        character(:), allocatable :: name
        logical :: defined, parent_active
        integer :: pos
 
        if (cond_depth + 1 > max_cond_depth) then
            call printf(render(diagnostic_report(level_error, &
                    message='Conditional nesting too deep', &
                    source=trim(ctx%path)), &
                    ctx%content, ctx%line))
            return
        end if
 
        pos = index(lowercase(ctx%content), token) + len(token)
        name = trim(adjustl(ctx%content(pos:)))
        defined = is_defined(name, macros)
        parent_active = is_active()
        cond_depth = cond_depth + 1
        cond_stack(cond_depth + 1)%active = defined .and. parent_active
        cond_stack(cond_depth + 1)%has_met = defined
    end subroutine
 
    !> Process #ifndef – test if a macro is NOT defined
    !! @param[in] ctx       Context source line containing the directive
    !! @param[in] macros    Current macro table
    !! @param[in] token     Usually 'ifndef'
    !!
    !! @b Remarks
    !! @ingroup group_conditional
    subroutine handle_ifndef(ctx, macros, token)
        type(context), intent(in)       :: ctx
        type(macro), intent(in)         :: macros(:)
        character(*), intent(in)        :: token
        !private
        character(:), allocatable :: name
        logical :: defined, parent_active
        integer :: pos
 
        if (cond_depth + 1 > max_cond_depth) then
            call printf(render(diagnostic_report(level_error, &
                    message='Conditional nesting too deep', &
                    source=trim(ctx%path)), &
                    ctx%content, ctx%line))
            return
        end if
 
        pos = index(lowercase(ctx%content), token) + len(token)
        name = trim(adjustl(ctx%content(pos:)))
        defined = is_defined(name, macros)
        parent_active = is_active()
        cond_depth = cond_depth + 1
        cond_stack(cond_depth + 1)%active = (.not. defined) .and. parent_active
        cond_stack(cond_depth + 1)%has_met = .not. defined
    end subroutine
 
    !> Process #elif – alternative branch after #if/#elif
    !! Only activates if no previous branch in the group was taken.
    !! @param[in] ctx       Context source line containing the directive
    !! @param[in] macros    Current macro table
    !! @param[in] token     Usually 'elif'
    !!
    !! @b Remarks
    !! @ingroup group_conditional
    subroutine handle_elif(ctx, macros, token)
        type(context), intent(in)   :: ctx
        type(macro), intent(in)     :: macros(:)
        character(*), intent(in)    :: token
        !private
        character(:), allocatable :: expr
        logical :: result, parent_active
        integer :: pos
 
        if (cond_depth == 0) then
            call printf(render(diagnostic_report(level_error, &
                    message='Synthax error', &
                    label=label_type('#elif without matching #if', 1, len_trim(ctx%content)), &
                    source=trim(ctx%path)), &
                    ctx%content, ctx%line))
            return
        end if
 
        pos = index(lowercase(ctx%content), token) + len(token)
        expr = trim(adjustl(ctx%content(pos:)))
        result = evaluate_expression(expr, macros, ctx)
        parent_active = cond_depth == 0 .or. cond_stack(cond_depth)%active
        if (.not. cond_stack(cond_depth + 1)%has_met) then
            cond_stack(cond_depth + 1)%active = result .and. parent_active
            if (result) cond_stack(cond_depth + 1)%has_met = .true.
        else
            cond_stack(cond_depth + 1)%active = .false.
        end if
    end subroutine
 
    !> Process #elifdef – test if a macro is defined
    !! @param[in] ctx       Context source line containing the directive
    !! @param[in] macros    Current macro table
    !! @param[in] token     Usually 'elifdef'
    !!
    !! @b Remarks
    !! @ingroup group_conditional
    subroutine handle_elifdef(ctx, macros, token)
        type(context), intent(in)       :: ctx
        type(macro), intent(in)         :: macros(:)
        character(*), intent(in)        :: token
        !private
        character(:), allocatable :: name
        logical :: defined, parent_active
        integer :: pos
 
        if (cond_depth == 0) then
            call printf(render(diagnostic_report(level_error, &
                    message='Synthax error', &
                    label=label_type('#elifdef without matching #if', 1, len_trim(ctx%content)), &
                    source=trim(ctx%path)), &
                    ctx%content, ctx%line))
            return
        end if
 
        pos = index(lowercase(ctx%content), token) + len(token)
        name = trim(adjustl(ctx%content(pos:)))
        defined = is_defined(name, macros)
        parent_active = cond_depth == 0 .or. cond_stack(cond_depth)%active
        if (.not. cond_stack(cond_depth + 1)%has_met) then
            cond_stack(cond_depth + 1)%active = defined .and. parent_active
            if (defined) cond_stack(cond_depth + 1)%has_met = .true.
        else
            cond_stack(cond_depth + 1)%active = .false.
        end if
    end subroutine
 
    !> Process #elifndef – test if a macro is not defined
    !! @param[in] ctx       Context source line containing the directive
    !! @param[in] macros    Current macro table
    !! @param[in] token     Usually 'elifndef'
    !!
    !! @b Remarks
    !! @ingroup group_conditional
    subroutine handle_elifndef(ctx, macros, token)
        type(context), intent(in)       :: ctx
        type(macro), intent(in)         :: macros(:)
        character(*), intent(in)        :: token
        !private
        character(:), allocatable :: name
        logical :: defined, parent_active
        integer :: pos
 
        if (cond_depth == 0) then
            call printf(render(diagnostic_report(level_error, &
                    message='Synthax error', &
                    label=label_type('#elifndef without matching #if', 1, len_trim(ctx%content)), &
                    source=trim(ctx%path)), &
                    ctx%content, ctx%line))
            return
        end if
 
        pos = index(lowercase(ctx%content), token) + len(token)
        name = trim(adjustl(ctx%content(pos:)))
        defined = is_defined(name, macros)
        parent_active = cond_depth == 0 .or. cond_stack(cond_depth)%active
        if (.not. cond_stack(cond_depth + 1)%has_met) then
            cond_stack(cond_depth + 1)%active = (.not. defined) .and. parent_active
            if (.not. defined) cond_stack(cond_depth + 1)%has_met = .true.
        else
            cond_stack(cond_depth + 1)%active = .false.
        end if
    end subroutine
 
    !> Process #else – final fallback branch
    !! Activates only if no previous #if/#elif branch was true.
    !! @param[in] ctx  Context (for error messages)
    !!
    !! @b Remarks
    !! @ingroup group_conditional
    subroutine handle_else(ctx)
        type(context), intent(in) :: ctx
        !private
        logical :: parent_active
 
        if (cond_depth == 0) then
            call printf(render(diagnostic_report(level_error, &
                    message='Synthax error', &
                    label=label_type('#else without matching #if', 1, len_trim(ctx%content)), &
                    source=trim(ctx%path)), &
                    ctx%content, ctx%line))
            return
        end if
 
        parent_active = cond_depth == 0 .or. cond_stack(cond_depth)%active
        if (.not. cond_stack(cond_depth + 1)%has_met) then
            cond_stack(cond_depth + 1)%active = parent_active
            cond_stack(cond_depth + 1)%has_met = .true.
        else
            cond_stack(cond_depth + 1)%active = .false.
        end if
    end subroutine
 
    !> Process #endif – end of conditional block
    !! Pops the top state from the stack. Reports error on unmatched #endif.
    !! @param[in] ctx  Context (for error messages)
    !!
    !! @b Remarks
    !! @ingroup group_conditional
    subroutine handle_endif(ctx)
        type(context), intent(in) :: ctx
 
        if (cond_depth == 0) then
            call printf(render(diagnostic_report(level_error, &
                    message='Synthax error', &
                    label=label_type('#endif without matching #if', 1, len_trim(ctx%content)), &
                    source=trim(ctx%path)), &
                    ctx%content, ctx%line))
            return
        end if
        cond_depth = cond_depth - 1
    end subroutine
 
end module