logging.f90

Go to the documentation of this file.

!> @file
!! @defgroup group_logging Logging
!! Global logging, ANSI-colored diagnostics, and pretty error/warning reporting for fpx
!!
!! This module is the central place for all human-readable output in the fpx preprocessor.
!! It provides:
!! - Full ANSI color and style support (bold, underline, colors, etc.)
!! - Structured diagnostic messages with source context, line numbers, and caret markers
!! - Pretty-printed multi-line error/warning/help/note/info reports
!! - Label-based highlighting of specific code ranges (like rustc-style diagnostics)
!! - Recursive sub-diagnostic support for nested explanations
!!
!! Designed to produce modern, readable, IDE-friendly output similar to rustc, clang, or cargo.
!! When `nocolor = .true.` (or terminal does not support ANSI), falls back to plain text.
!!
!! @section logging_examples Examples
!!
!! 1. Simple error message
!! @code{.f90}
!! print '(A)', render(diagnostic_report( &
!!     LEVEL_ERROR, &
!!     message='unexpected token', &
!!     label=label_type('expected expression', 8, 3)), &
!!     'a = +')
!! ...
!! @endcode
!!
!! 2. Colored message (used internally for verbose logging):
!! @code{.f90}
!!    use fpx_logging
!!
!!    verbose = .true.
!!    print '(A)', render('Macro expanded: PI = 3.14159')
!! ..
!! @endcode
!!
!! 3. Full diagnostic report (like a compiler error):
!! @code{.f90}
!!  character(*), parameter :: input = &
!!  '# This is a TOML document.' // nl // &
!!  'title = "TOML Example"' // nl // &
!!  '[owner]' // nl // &
!!  'name = "Tom Preston-Werner"' // nl // &
!!  'dob = 1979-05-27T07:32:00-08:00 # First class dates' // nl // &
!!  '[database]' // nl // &
!!  'server = "192.168.1.1"' // nl // &
!!  'ports = [ 8001, 8001, 8002 ]' // nl // &
!!  'connection_max = 5000' // nl // &
!!  'enabled = true' // nl // &
!!  '[servers]' // nl // &
!!  '  # Indentation (tabs and/or spaces) is allowed but not required' // nl // &
!!  '  [servers.alpha]' // nl // &
!!  '  ip = "10.0.0.1"' // nl // &
!!  '  dc = "eqdc10"' // nl // &
!!  '  [servers.beta]' // nl // &
!!  '  ip = "10.0.0.2"' // nl // &
!!  '  dc = "eqdc10"' // nl // &
!!  '[title]' // nl // &
!!  'data = [ ["gamma", "delta"], [1, 2] ]' // nl // &
!!  '# Line breaks are OK when inside arrays' // nl // &
!!  'hosts = [' // nl // &
!!  '  "alpha",' // nl // &
!!  '  "omega"' // nl // &
!!  ']'
!!
!!    print '(A)', render(diagnostic_report(level_error, &
!!       message="duplicated key 'title' found", &
!!       source="example.toml", &
!!       label=[label_type("table 'title' redefined here", 19, 2, 5, .true.), &
!!              label_type("first defined here", 2, 1, 5)]), &
!!              input)
!!    end
!! ...
!! @endcode
!!
!!    Output might look like (colored in terminal):
!! @code
!! error: duplicated key 'title' found
!!  --> example.toml:19:2-6
!!    |
!!  1 | # This is a TOML document.
!!  2 | title = "TOML Example"
!!    | ----- first defined here
!!  3 | [owner]
!!    :
!! 18 |   dc = "eqdc10"
!! 19 | [title]
!!    |  ^^^^^ table 'title' redefined here
!! 20 | data = [ ["gamma", "delta"], [1, 2] ]
!!    |
!! @endcode
!!
!! @par ANSI style & color reference (used internally)
!! - Styles: BOLD_ON, UNDERLINE_ON, INVERSE_ON, STRIKETHROUGH_ON, ...
!! - Foreground: RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN, WHITE, ...
!! - Background: same as foreground but prefixed with BG_
!!
!! @note This code is adapted from [pretty-diagnostics](https://github.com/awvwgk/pretty-diagnostics).
!! The visual presentation is inspired by modern compiler diagnostics
!! such as rustc and clang, while being adapted for Fortran workflows.
module fpx_logging
    use iso_c_binding
 
    implicit none; private
 
    public :: render, &
            printf, &
            diagnostic_report, &
            label_type, &
            level_error, &
            level_warning, &
            level_help, &
            level_note, &
            level_info
 
    !> @brief Master switch for verbose diagnostic output
    !! Default value is `.false.` (quiet mode).
    !! Set to `.true.` to get detailed step-by-step information about
    !! preprocessing actions. Safe to modify at any time � the change takes
    !! effect immediately for all subsequent operations.
    !! @ingroup group_logging
    logical, public :: verbose = .false.
 
    !> @brief Switch for controling the ANSI color output
    !! Default value is `.true.` (color mode on).
    !! Set to `.false.` to get raw string output.
    !! @ingroup group_logging
    logical, public :: nocolor = .false.
 
    !! @cond
    character(1), parameter :: nl = new_line('a')  !< New line character.
    character(1), parameter :: escape = achar(27)  !< '\' character.
    character(2), parameter :: code_start = escape // '['  !< Start ansi code, "\‍[".
    character(1), parameter :: code_end = 'm'  !< End ansi code, "m".
    character(4), parameter :: code_clear = code_start // '0' // code_end  !< Clear all styles, "\‍[0m".
 
    character(17), parameter :: styles(1:2, 1:16) = reshape([ &
            'BOLD_ON          ', '1                ', &
            'ITALICS_ON       ', '3                ', &
            'UNDERLINE_ON     ', '4                ', &
            'INVERSE_ON       ', '7                ', &
            'STRIKETHROUGH_ON ', '9                ', &
            'BOLD_OFF         ', '22               ', &
            'ITALICS_OFF      ', '23               ', &
            'UNDERLINE_OFF    ', '24               ', &
            'INVERSE_OFF      ', '27               ', &
            'STRIKETHROUGH_OFF', '29               ', &
            'FRAMED_ON        ', '51               ', &
            'ENCIRCLED_ON     ', '52               ', &
            'OVERLINED_ON     ', '53               ', &
            'FRAMED_OFF       ', '54               ', &
            'ENCIRCLED_OFF    ', '54               ', &
            'OVERLINED_OFF    ', '55               ' &
            ], [2, 16])  !< Styles.
    
    character(15), parameter :: colors_fg(1:2, 1:17) = reshape([ &
            'BLACK          ', '30             ', &
            'RED            ', '31             ', &
            'GREEN          ', '32             ', &
            'YELLOW         ', '33             ', &
            'BLUE           ', '34             ', &
            'MAGENTA        ', '35             ', &
            'CYAN           ', '36             ', &
            'WHITE          ', '37             ', &
            'DEFAULT        ', '39             ', &
            'BLACK_INTENSE  ', '90             ', &
            'RED_INTENSE    ', '91             ', &
            'GREEN_INTENSE  ', '92             ', &
            'YELLOW_INTENSE ', '93             ', &
            'BLUE_INTENSE   ', '94             ', &
            'MAGENTA_INTENSE', '95             ', &
            'CYAN_INTENSE   ', '96             ', &
            'WHITE_INTENSE  ', '97             ' & 
            ], [2, 17])  !< Foreground colors.
 
    character(15), parameter :: colors_bg(1:2, 1:17) = reshape([ &
            'BLACK          ', '40             ', &
            'RED            ', '41             ', &
            'GREEN          ', '42             ', &
            'YELLOW         ', '43             ', &
            'BLUE           ', '44             ', &
            'MAGENTA        ', '45             ', &
            'CYAN           ', '46             ', &
            'WHITE          ', '47             ', &
            'DEFAULT        ', '49             ', &
            'BLACK_INTENSE  ', '100            ', &
            'RED_INTENSE    ', '101            ', &
            'GREEN_INTENSE  ', '102            ', &
            'YELLOW_INTENSE ', '103            ', &
            'BLUE_INTENSE   ', '104            ', &
            'MAGENTA_INTENSE', '105            ', &
            'CYAN_INTENSE   ', '106            ', &
            'WHITE_INTENSE  ', '107            ' &
            ], [2, 17])  !< Background colors.
    !! @endcond
 
    !> Generic renderer for diagnostics and source excerpts.
    !!
    !! Supported overloads:
    !! - render(diagnostic_report, source)
    !! - render(character)
    !! - render(character, label_type)
    !! - render(character, label_type(:))
    !!
    !! Returns a formatted character string suitable for printing.
    !!
    !! @ingroup group_logging
    interface render
        module procedure :: render_diagnostic
        module procedure :: render_text
        module procedure :: render_text_with_label
        module procedure :: render_text_with_labels
    end interface
 
    enum, bind(c)
        enumerator :: LEVEL_ERROR = 0
        enumerator :: LEVEL_WARNING = 1
        enumerator :: LEVEL_HELP = 2
        enumerator :: LEVEL_NOTE = 3
        enumerator :: LEVEL_INFO = 4
    end enum
 
    !> Diagnostic label identifying a region of source text.
    !!
    !! A label highlights a specific character range within a source line
    !! and may carry an explanatory message. Labels are used to produce
    !! compiler-style diagnostics similar to those of rustc or clang.
    !!
    !! Labels may be primary or secondary:
    !! - Primary labels identify the principal cause of the diagnostic.
    !! - Secondary labels provide additional context.
    !!
    !! Primary labels determine the source location shown in the
    !! diagnostic header and are rendered using '^' markers.
    !!
    !! Secondary labels are rendered using '-' markers and provide
    !! supplementary context.
    !! @note
    !! Character positions are 1-based.
    !! The highlighted range spans:
    !!
    !!    first <= position < finish
    !!
    !! where `finish` is exclusive.
    !!
    !! @section label_type_examples Examples
    !! @code{.f90}
    !! type(string) :: s
    !! s = 'foo'
    !! ...
    !! @endcode
    !!
    !! @section label_type_constructor Constructors
    !! Initializes a new instance of the label_type class
    !! @b Constructor
    !! @code{.f90} 
    !! type(label_type) function string(character(*) text, integer first, integer length, (optional) integer level) 
    !! @endcode
    !!
    !! @param[in] text 
    !!   Text displayed next to the label
    !! @param[in] first 
    !!   Position of the label
    !! @param[in] length 
    !!   Length of the label
    !! @param[in] level 
    !!   (optional) Level of the label
    !!
    !! @b Examples
    !! @code{.f90}
    !! type(label_type) :: label
    !! label = label_type('Syntax error', 5, 7)
    !! ...
    !! @endcode
    !! @return The constructed label_type object.
    !!
    !! @b Constructor
    !! @code{.f90} 
    !! type(label_type) function label_type(integer line, character(*) text, integer first, integer length, (optional) integer level, (optional) logical primary) 
    !! @endcode
    !!
    !! @param[in] line 
    !!   line number for the label
    !! @param[in] text 
    !!   Text displayed next to the label
    !! @param[in] first 
    !!   Position of the label
    !! @param[in] length 
    !!   Length of the label
    !! @param[in] level 
    !!   (optional) Level of the label
    !! @param[in] primary 
    !!   .true. if the label is the primary one
    !!
    !! @b Examples
    !! @code{.f90}
    !! type(label_type) :: label
    !! label = label_type(1, 'Syntax error', 5, 7, LEVEL_ERROR, .true.)
    !! ...
    !! @endcode
    !! @return The constructed label_type object.
    !!
    !! @ingroup group_logging
    type label_type
        !> Level of message
        integer, allocatable        :: level
        !> Primary message
        logical                     :: primary
        !> Line number of message
        integer                     :: line
        !> First character of message
        integer                     :: first
        !> Last character of message
        integer                     :: finish
        !> Message text
        character(:), allocatable   :: text
    end type
 
    interface label_type
        module procedure :: label_new
        module procedure :: label_new_with_line
    end interface
 
    !> Structured compiler diagnostic.
    !!
    !! A diagnostic report consists of:
    !!
    !! - a severity level,
    !! - a primary message,
    !! - one or more source labels,
    !! - optional nested diagnostics.
    !!
    !! Reports can be rendered using the generic interface
    !! `render(...)` to produce human-readable output.
    !!
    !! @ingroup group_logging
    type :: diagnostic_report
        !> Level of message
        integer :: level
        !> Primary message
        character(:), allocatable :: message
        !> Context of the diagnostic source
        character(:), allocatable :: source
        !> Messages associated with this diagnostic
        type(label_type), allocatable :: label(:)
        !> Additional diagnostic information
        type(diagnostic_report), allocatable :: sub(:)
    end type
 
    interface diagnostic_report
        module procedure diagnostic_new
    end interface
 
    !! @private
    type :: line_token
        integer :: first, finish
    end type
 
contains
 
    !> Colorize and stylize strings, DEFAULT kind.
    !! @param[in] string Input string.
    !! @param[in] foreground Foreground color definition.
    !! @param[in] background Background color definition.
    !! @param[in] style Style definition.
    pure function colorize(string, foreground, background, style) result(res)
        character(*), intent(in)           :: string
        character(*), intent(in), optional :: foreground
        character(*), intent(in), optional :: background
        character(*), intent(in), optional :: style
        character(:), allocatable :: res
        !private
        integer :: i
 
        res = string
        if (nocolor) return
        if (present(foreground)) then
            i = color_index(upper(foreground))
            if (i > 0) res = code_start // trim(colors_fg(2, i)) // code_end // res // code_clear
        end if
        if (present(background)) then
            i = color_index(upper(background))
            if (i > 0) res = code_start // trim(colors_bg(2, i)) // code_end // res // code_clear
        end if
        if (present(style)) then
            i = style_index(upper(style))
            if (i > 0) res = code_start // trim(styles(2, i)) // code_end // res // code_clear
        end if
    end function
 
    !> Return the array-index corresponding to the queried color.
    !! @note Because Foreground and backround colors lists share the same name,
    !! no matter what array is used to find the color index.
    !! Thus, the foreground array is used.
    elemental integer function color_index(color) result(res)
        character(*), intent(in) :: color  !< Color definition.
        !private
        integer :: i
 
        res = 0
        do i = 1, size(colors_fg, dim=2)
            if (trim(colors_fg(1, i)) == trim(adjustl(color))) then
                res = i
                exit
            end if
        end do
    end function
 
    !> Return the array-index corresponding to the queried style.
    elemental integer function style_index(style) result(res)
        character(*), intent(in) :: style  !< Style definition.
        !private
        integer :: i
 
        res = 0
        do i = 1, size(styles, dim=2)
            if (trim(styles(1, i)) == trim(adjustl(style))) then
                res = i
                exit
            end if
        end do
    end function
 
    !> Return a string with all uppercase characters.
    elemental function upper(string)
        character(*), intent(in) :: string  !< Input string.
        character(len(string)) :: upper  !< Upper case string.
        !private
        integer, parameter :: a = iachar('a'), z = iachar('z'), case_diff = iachar('a') - iachar('A')
        integer :: i, ichar
 
        do i = 1, len(string)
            ichar = iachar(string(i:i))
            if (ichar >= a .and. ichar <= z) ichar = ichar - case_diff
            upper(i:i) = achar(ichar)
        end do
    end function
 
    type(label_type) pure function label_new(text, first, length, level) result(that)
        character(*), intent(in)            :: text
        integer, intent(in)                 :: first
        integer, intent(in)                 :: length
        integer, intent(in), optional      :: level
 
        that%text = text
        that%line = 1
        that%first = max(1, first)
        that%finish = that%first + length
        that%primary = .true.
        if (present(level)) that%level = level
    end function
 
    type(label_type) pure function label_new_with_line(line, text, first, length, primary, level) result(that)
        integer, intent(in)                 :: line
        character(*), intent(in)            :: text
        integer, intent(in)                 :: first
        integer, intent(in)                 :: length
        logical, intent(in), optional       :: primary
        integer, intent(in), optional      :: level
 
        that%text = text
        that%line = line
        that%first = max(1, first)
        that%finish = that%first + length
        if (present(primary)) then
            that%primary = primary
        else
            that%primary = .true.
        end if
        if (present(level)) that%level = level
    end function
 
    !> Create new diagnostic message
    !! @param[in] level Level of message
    !! @param[in] message Primary message
    !! @param[in] source Context of the diagnostic source
    !! @param[in] label Messages associated with this diagnostic
    !! @param[in] diagnostic Additional diagnostic information
    type(diagnostic_report) function diagnostic_new(level, message, source, label, diagnostic) result(that)
        integer, intent(in)                             :: level
        character(*), intent(in), optional              :: message
        character(*), intent(in), optional              :: source
        type(label_type), intent(in), optional          :: label(..)
        type(diagnostic_report), intent(in), optional   :: diagnostic(:)
        !private
        integer :: i
 
        that%level = level
        if (present(message)) that%message = message
        if (present(source)) that%source = source
        if (present(label)) then
            if (allocated(that%label)) deallocate(that%label)
            select rank (label)
            rank(0)
                allocate(that%label(1))
                that%label(1) = label
                if (.not. allocated(that%label(1)%level)) that%label(1)%level = level
            rank(1)
                allocate(that%label, source=label)
                do i = 1, size(label)
                    if (.not. allocated(that%label(i)%level)) that%label(i)%level = level
                end do
            end select
        end if
        if (present(diagnostic)) that%sub = diagnostic
 
        if (allocated(that%label)) then
            if (.not. any(that%label(:)%primary)) then
                that%label(1)%primary = .true.
            end if
        end if
    end function
 
    pure function line_tokens(input) result(res)
        character(*), intent(in)        :: input
        type(line_token), allocatable :: res(:)
        !private
        integer :: first, finish
 
        if (len(input) == 0) then
            allocate(res(1))
            res(1)=line_token(1,0)
            return
        end if
 
        first = 1; finish = 0
        allocate(res(0))
        do while (first <= len(input))
            finish = index(input(first + 1:), nl) + first - 1
            if (finish < first) then
                finish = len(input)
            end if
 
            res = [res, line_token(first, finish)]
 
            first = finish + (1 + len(nl))
        end do
    end function
 
    pure recursive function render_diagnostic(diag, input, linemum) result(res)
        type(diagnostic_report), intent(in)     :: diag
        character(*), intent(in)                :: input
        integer, intent(in), optional           :: linemum
        character(:), allocatable :: res
        !private
        integer :: i
 
        res = render_message(diag%level, diag%message)
 
        if (allocated(diag%label)) then
            res = res // nl // render_text_with_labels(input, diag%label, source=diag%source, linemum=linemum)
        else
            res = res // nl // render_text_with_labels(input, [label_type('', 1, len_trim(input))], source=diag%source, linemum=&
                    linemum)
        end if
 
        if (allocated(diag%sub)) then
            do i = 1, size(diag%sub)
                res = res // nl // render_diagnostic(diag%sub(i), input, linemum)
            end do
        end if
    end function
 
    pure function render_message(level, message) result(res)
        integer, intent(in) :: level
        character(*), intent(in), optional :: message
        character(:), allocatable :: res
 
        if (present(message)) then
            res = level_name(level) // colorize(': ' // message, style='bold_on')
        else
            res = level_name(level)
        end if
    end function
 
    pure function level_name(level) result(res)
        integer, intent(in) :: level
        character(:), allocatable :: res
        !private
        character(:), allocatable :: name, fg
 
        select case(level)
        case (level_error)
            name='error';   fg='red'
        case (level_warning)
            name='warning'; fg='yellow'
        case (level_help)
            name='help';    fg='cyan'
        case (level_note)
            name='note';    fg='blue'
        case (level_info)
            name='info';    fg='magenta'
        case default
            name='unknown'; fg='blue'
        end select
 
        res = colorize(name, foreground=fg, style='bold_on')
    end function
 
    pure function render_source(source, offset) result(res)
        character(*), intent(in)    :: source
        integer, intent(in)         :: offset
        character(:), allocatable :: res
 
        res = repeat(' ', offset) // colorize('-->', foreground='blue') // ' ' // source
    end function
 
    pure function render_text(input, source, linenum) result(res)
        character(*), intent(in)            :: input
        character(*), intent(in), optional  :: source
        integer, intent(in), optional       :: linenum
        character(:), allocatable :: res
        !private
        integer :: i, offset, iline
        type(line_token), allocatable :: token(:)
 
        iline = 1; if (present(linenum)) iline = linenum
        token = line_tokens(input)
        offset = integer_width(iline)
 
        if (present(source)) then
            res = render_source(source, offset) // nl // &
                    repeat(' ', offset + 1) // colorize('|', foreground='blue')
        else
            res = repeat(' ', offset + 1) // colorize('|', foreground='blue')
        end if
 
        do i = 1, size(token)
            res = res // nl // render_line(input(token(i)%first:token(i)%finish), to_string(iline + i - 1, offset))
        end do
        res = res // nl // repeat(' ', offset + 1) // colorize('|', foreground='blue')
    end function
 
    pure function render_text_with_label(input, label, source, linenum) result(res)
        character(*), intent(in)            :: input
        type(label_type), intent(in)        :: label
        character(*), intent(in), optional  :: source
        integer, intent(in), optional       :: linenum
        character(:), allocatable :: res
 
        res = render_text_with_labels(input, [label], source, linenum)
    end function
 
    pure function render_text_with_labels(input, labels, source, linemum) result(res)
        character(*), intent(in)            :: input
        type(label_type), intent(in)        :: labels(:)
        character(*), intent(in), optional  :: source
        integer, intent(in), optional       :: linemum
        character(:), allocatable :: res
        !private
        integer :: i, j, offset, first, finish, iline
        type(line_token), allocatable :: token(:)
        logical, allocatable :: display(:)
 
        token = line_tokens(input)
        first = max(1, minval(labels%line) - 1)
        finish = min(size(token), maxval(labels%line) + 1)
        iline = 1; if (present(linemum)) iline = linemum
        offset = integer_width(iline)
 
        i = 1  ! Without a primary we use the first label
        do j = 1, size(labels)
            if (labels(j)%primary) then
                i = j
                exit
            end if
        end do
 
        if (present(source)) then
            res = render_source(source, offset) // ':' // &
                    to_string(labels(i)%line) // ':' // &
                    to_string(labels(i)%first) // '-' // to_string(labels(i)%finish) // nl // &
                    repeat(' ', offset + 1) // colorize('|', foreground='blue')
        else
            res = repeat(' ', offset + 1) // colorize('|', foreground='blue')
        end if
 
        allocate(display(first:finish), source=.false.)
        do j = 1, size(labels)
            display(max(first, labels(j)%line - 1):min(finish, labels(j)%line + 1)) = .true.
        end do
 
        do i = first, finish
            if (.not. display(i)) then
                if (i > first) then
                    if (display(i - 1)) then
                        res = res // nl //&
                                repeat(' ', offset + 1) // colorize(':', foreground='blue')
                    end if
                end if
                cycle
            end if
 
            res = res // nl //&
                    & render_line(input(token(i)%first:token(i)%finish), &
                    &             to_string(iline + i - 1, offset))
            if (any(i == labels%line)) then
                do j = 1, size(labels)
                    if (labels(j)%line /= i) cycle
                    res = res // nl //&
                            & repeat(' ', offset + 1) // colorize('|', foreground='blue') // &
                            & render_label(labels(j))
                end do
            end if
        end do
        res = res // nl // repeat(' ', offset + 1) // colorize('|', foreground='blue')
    end function
 
    pure function render_label(label) result(res)
        type(label_type), intent(in) :: label
        character(:), allocatable :: res
        !private
        integer :: width
        character(1) :: marker
        character(:), allocatable :: this_color, fg
 
        marker = merge('^', '-', label%primary)
        width = label%finish - label%first
        fg = 'blue'
 
        if (allocated(label%level)) then
            select case (label%level)
            case (level_error)
                fg = 'red'
            case (level_warning)
                fg = 'yellow'
            case (level_help)
                fg = 'cyan'
            case (level_info)
                fg = 'magenta'
            end select
            res = repeat(' ', label%first) // colorize(repeat(marker, width), foreground=fg)
            if (allocated(label%text)) then
                res = res // ' ' // colorize(label%text, foreground=fg)
            end if
        else
            res = repeat(' ', label%first) // repeat(marker, width)
            if (allocated(label%text)) then
                res = res // ' ' // colorize(label%text, foreground='blue')
            end if
        end if
    end function
 
    pure function render_line(input, line) result(res)
        character(*), intent(in)    :: input
        character(*), intent(in)    :: line
        character(:), allocatable :: res
 
        res = line // ' ' // colorize('|', foreground='blue') // ' ' // input
    end function
 
    pure integer function integer_width(input) result(res)
        integer, value :: input
 
        if (input == 0) then
            res = 1
            return
        end if
 
        res = 0
        do while (input /= 0)
            input = input / 10
            res = res + 1
        end do
 
    end function
 
    !> Represent an integer as character sequence.
    pure function to_string(val, width) result(res)
        integer, intent(in)             :: val
        integer, intent(in), optional   :: width
        character(:), allocatable :: res
        !private
        integer, parameter :: buffer_len = range(val) + 2
        character(buffer_len) :: buffer
        integer :: n, pos
        character(1), parameter :: numbers(0:9) = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9']
 
        if (val == 0) then
            res = numbers(0)
            return
        end if
 
        n = abs(val)
        buffer = ''
 
        pos = buffer_len + 1
        do while (n > 0)
            pos = pos - 1
            buffer(pos:pos) = numbers(mod(n, 10))
            n = n / 10
        end do
        if (val < 0) then
            pos = pos - 1
            buffer(pos:pos) = '-'
        end if
 
        if (present(width)) then
            res = repeat(' ', max(width - (buffer_len + 1 - pos), 0)) // buffer(pos:)
        else
            res = buffer(pos:)
        end if
    end function
 
    !> Conditionally print a message when verbose logging is enabled.
    !!
    !! This routine is intended for internal tracing and debugging output.
    !! Compiler diagnostics should instead be constructed using
    !! `diagnostic_report` and rendered explicitly.
    !! @param[in] str Input string.
    !! @param[in] fmt (optional) print format.
    subroutine printf(str, fmt, unit)
        character(*), intent(in)            :: str
        character(*), intent(in), optional  :: fmt
        integer, intent(in), optional       :: unit
 
        if (verbose) then
            if (present(fmt)) then
                if (present(unit)) then
                    write(unit, fmt) str
                else
                    write(*, fmt) str
                end if
            else
                if (present(unit)) then
                    write(unit, '(A)') str
                else
                    write(*, '(A)') str
                end if
            end if
        end if
    end subroutine
 
end module