stdlib_ascii.fypp

#:include "common.fypp"

!> The `stdlib_ascii` module provides procedures for handling and manipulating
!> intrinsic character variables and constants.
!>
!> The specification of this module is available [here](../page/specs/stdlib_ascii.html).
module stdlib_ascii
    use stdlib_kinds, only : int8, int16, int32, int64, lk, c_bool

    implicit none
    private

    ! Character validation functions
    public :: is_alpha, is_alphanum
    public :: is_digit, is_hex_digit, is_octal_digit
    public :: is_control, is_white, is_blank
    public :: is_ascii, is_punctuation
    public :: is_graphical, is_printable
    public :: is_lower, is_upper

    ! Character conversion functions
    public :: to_lower, to_upper, to_title, to_sentence, reverse

    ! All control characters in the ASCII table (see www.asciitable.com).
    character(len=1), public, parameter :: NUL = achar(int(z'00')) !! Null
    character(len=1), public, parameter :: SOH = achar(int(z'01')) !! Start of heading
    character(len=1), public, parameter :: STX = achar(int(z'02')) !! Start of text
    character(len=1), public, parameter :: ETX = achar(int(z'03')) !! End of text
    character(len=1), public, parameter :: EOT = achar(int(z'04')) !! End of transmission
    character(len=1), public, parameter :: ENQ = achar(int(z'05')) !! Enquiry
    character(len=1), public, parameter :: ACK = achar(int(z'06')) !! Acknowledge
    character(len=1), public, parameter :: BEL = achar(int(z'07')) !! Bell
    character(len=1), public, parameter :: BS  = achar(int(z'08')) !! Backspace
    character(len=1), public, parameter :: TAB = achar(int(z'09')) !! Horizontal tab
    character(len=1), public, parameter :: LF  = achar(int(z'0A')) !! NL line feed, new line
    character(len=1), public, parameter :: VT  = achar(int(z'0B')) !! Vertical tab
    character(len=1), public, parameter :: FF  = achar(int(z'0C')) !! NP form feed, new page
    character(len=1), public, parameter :: CR  = achar(int(z'0D')) !! Carriage return
    character(len=1), public, parameter :: SO  = achar(int(z'0E')) !! Shift out
    character(len=1), public, parameter :: SI  = achar(int(z'0F')) !! Shift in
    character(len=1), public, parameter :: DLE = achar(int(z'10')) !! Data link escape
    character(len=1), public, parameter :: DC1 = achar(int(z'11')) !! Device control 1
    character(len=1), public, parameter :: DC2 = achar(int(z'12')) !! Device control 2
    character(len=1), public, parameter :: DC3 = achar(int(z'13')) !! Device control 3
    character(len=1), public, parameter :: DC4 = achar(int(z'14')) !! Device control 4
    character(len=1), public, parameter :: NAK = achar(int(z'15')) !! Negative acknowledge
    character(len=1), public, parameter :: SYN = achar(int(z'16')) !! Synchronous idle
    character(len=1), public, parameter :: ETB = achar(int(z'17')) !! End of transmission block
    character(len=1), public, parameter :: CAN = achar(int(z'18')) !! Cancel
    character(len=1), public, parameter :: EM  = achar(int(z'19')) !! End of medium
    character(len=1), public, parameter :: SUB = achar(int(z'1A')) !! Substitute
    character(len=1), public, parameter :: ESC = achar(int(z'1B')) !! Escape
    character(len=1), public, parameter :: FS  = achar(int(z'1C')) !! File separator
    character(len=1), public, parameter :: GS  = achar(int(z'1D')) !! Group separator
    character(len=1), public, parameter :: RS  = achar(int(z'1E')) !! Record separator
    character(len=1), public, parameter :: US  = achar(int(z'1F')) !! Unit separator
    character(len=1), public, parameter :: DEL = achar(int(z'7F')) !! Delete

    ! Constant character sequences
    character(len=*), public, parameter :: fullhex_digits = "0123456789ABCDEFabcdef" !! 0 .. 9A .. Fa .. f
    character(len=*), public, parameter :: hex_digits = fullhex_digits(1:16) !! 0 .. 9A .. F
    character(len=*), public, parameter :: lowerhex_digits = "0123456789abcdef" !! 0 .. 9a .. f
    character(len=*), public, parameter :: digits = hex_digits(1:10) !! 0 .. 9
    character(len=*), public, parameter :: octal_digits = digits(1:8) !! 0 .. 7
    character(len=*), public, parameter :: letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" !! A .. Za .. z
    character(len=*), public, parameter :: uppercase = letters(1:26) !! A .. Z
    character(len=*), public, parameter :: lowercase = letters(27:) !! a .. z
    character(len=*), public, parameter :: whitespace = " "//TAB//VT//CR//LF//FF !! ASCII _whitespace


    !> Returns a new character sequence which is the lower case 
    !> version of the input character sequence
    !> This method is pure and returns a character sequence
    interface to_lower
        module procedure :: to_lower
    end interface to_lower

    !> Returns a new character sequence which is the upper case
    !> version of the input character sequence
    !> This method is pure and returns a character sequence
    interface to_upper
        module procedure :: to_upper
    end interface to_upper

    !> Returns a new character sequence which is the title case
    !> version of the input character sequence
    !> This method is pure and returns a character sequence
    interface to_title
        module procedure :: to_title
    end interface to_title

    !> Returns a new character sequence which is the sentence case
    !> version of the input character sequence
    !> This method is pure and returns a character sequence
    interface to_sentence
        module procedure :: to_sentence
    end interface to_sentence

    !> Returns a new character sequence which is reverse of
    !> the input charater sequence
    !> This method is pure and returns a character sequence
    interface reverse
        module procedure :: reverse
    end interface reverse
    

contains

    !> Checks whether `c` is an ASCII letter (A .. Z, a .. z).
    pure logical function is_alpha(c)
        character(len=1), intent(in) :: c !! The character to test.
        is_alpha = (c >= 'A' .and. c <= 'Z') .or. (c >= 'a' .and. c <= 'z')
    end function

    !> Checks whether `c` is a letter or a number (0 .. 9, a .. z, A .. Z).
    pure logical function is_alphanum(c)
        character(len=1), intent(in) :: c !! The character to test.
        is_alphanum = (c >= '0' .and. c <= '9') .or. (c >= 'a' .and. c <= 'z') &
            .or. (c >= 'A' .and. c <= 'Z')
    end function

    !> Checks whether or not `c` is in the ASCII character set -
    !> i.e. in the range 0 .. 0x7F.
    pure logical function is_ascii(c)
        character(len=1), intent(in) :: c !! The character to test.
        is_ascii = iachar(c) <= int(z'7F')
    end function

    !> Checks whether `c` is a control character.
    pure logical function is_control(c)
        character(len=1), intent(in) :: c !! The character to test.
        integer :: ic
        ic = iachar(c)
        is_control = ic < int(z'20') .or. ic == int(z'7F')
    end function

    !> Checks whether `c` is a digit (0 .. 9).
    pure logical function is_digit(c)
        character(len=1), intent(in) :: c !! The character to test.
        is_digit = ('0' <= c) .and. (c <= '9')
    end function

    !> Checks whether `c` is a digit in base 8 (0 .. 7).
    pure logical function is_octal_digit(c)
        character(len=1), intent(in) :: c !! The character to test.
        is_octal_digit = (c >= '0') .and. (c <= '7');
    end function

    !> Checks whether `c` is a digit in base 16 (0 .. 9, A .. F, a .. f).
    pure logical function is_hex_digit(c)
        character(len=1), intent(in) :: c !! The character to test.
        is_hex_digit = (c >= '0' .and. c <= '9') .or. (c >= 'a' .and. c <= 'f') &
            .or. (c >= 'A' .and. c <= 'F')
    end function

    !> Checks whether or not `c` is a punctuation character. That includes
    !> all ASCII characters which are not control characters, letters,
    !> digits, or whitespace.
    pure logical function is_punctuation(c)
        character(len=1), intent(in) :: c !! The character to test.
        integer :: ic
        ic = iachar(c) !       '~'                 '!'
        is_punctuation = (ic <= int(z'7E')) .and. (ic >= int(z'21')) .and. &
            (.not. is_alphanum(c))
    end function

    !> Checks whether or not `c` is a printable character other than the
    !> space character.
    pure logical function is_graphical(c)
        character(len=1), intent(in) :: c !! The character to test.
        integer :: ic
        ic = iachar(c)
        !The character is graphical if it's between '!' and '~' in the ASCII table,
        !that is: printable but not a space
        is_graphical = (int(z'21') <= ic) .and. (ic <= int(z'7E'))
    end function

    !> Checks whether or not `c` is a printable character - including the
    !> space character.
    pure logical function is_printable(c)
        character(len=1), intent(in) :: c !! The character to test.
        integer :: ic
        ic = iachar(c)
        !The character is printable if it's between ' ' and '~' in the ASCII table
        is_printable = ic >= iachar(' ') .and. ic <= int(z'7E')
    end function

    !> Checks whether `c` is a lowercase ASCII letter (a .. z).
    pure logical function is_lower(c)
        character(len=1), intent(in) :: c !! The character to test.
        integer :: ic
        ic = iachar(c)
        is_lower = ic >= iachar('a') .and. ic <= iachar('z')
    end function

    !> Checks whether `c` is an uppercase ASCII letter (A .. Z).
    pure logical function is_upper(c)
        character(len=1), intent(in) :: c !! The character to test.
        is_upper = (c >= 'A') .and. (c <= 'Z')
    end function

    !> Checks whether or not `c` is a whitespace character. That includes the
    !> space, tab, vertical tab, form feed, carriage return, and linefeed
    !> characters.
    pure logical function is_white(c)
        character(len=1), intent(in) :: c !! The character to test.
        integer :: ic
        ic = iachar(c)             ! TAB, LF, VT, FF, CR
        is_white = (c == ' ') .or. (ic >= int(z'09') .and. ic <= int(z'0D'));
    end function

    !> Checks whether or not `c` is a blank character. That includes the
    !> only the space and tab characters
    pure logical function is_blank(c)
        character(len=1), intent(in) :: c !! The character to test.
        integer :: ic
        ic = iachar(c)             ! TAB
        is_blank = (c == ' ') .or. (ic == int(z'09'));
    end function

    !> Returns the corresponding lowercase letter, if `c` is an uppercase
    !> ASCII character, otherwise `c` itself.
    pure function char_to_lower(c) result(t)
        character(len=1), intent(in) :: c !! A character.
        character(len=1)             :: t
        integer :: k

        k = index( uppercase, c )

        if ( k > 0 ) then
            t = lowercase(k:k)
        else
            t = c
        endif
    end function char_to_lower

    !> Returns the corresponding uppercase letter, if `c` is a lowercase
    !> ASCII character, otherwise `c` itself.
    pure function char_to_upper(c) result(t)
        character(len=1), intent(in) :: c !! A character.
        character(len=1)             :: t
        integer :: k

        k = index( lowercase, c )

        if ( k > 0 ) then
            t = uppercase(k:k)
        else
            t = c
        endif
    end function char_to_upper

    !> Convert character variable to lower case
    !> ([Specification](../page/specs/stdlib_ascii.html#to_lower))
    !>
    !> Version: experimental
    pure function to_lower(string) result(lower_string)
        character(len=*), intent(in) :: string
        character(len=len(string)) :: lower_string
        integer :: i

        do i = 1, len(string)
            lower_string(i:i) = char_to_lower(string(i:i))
        end do

    end function to_lower

    !> Convert character variable to upper case
    !> ([Specification](../page/specs/stdlib_ascii.html#to_upper))
    !>
    !> Version: experimental
    pure function to_upper(string) result(upper_string)
        character(len=*), intent(in) :: string
        character(len=len(string)) :: upper_string
        integer :: i

        do i = 1, len(string)
            upper_string(i:i) = char_to_upper(string(i:i))
        end do

    end function to_upper

    !> Converts character sequence to title case
    !> ([Specification](../page/specs/stdlib_ascii.html#to_title))
    !>
    !> Version: experimental
    pure function to_title(string) result(title_string)
        character(len=*), intent(in) :: string
        character(len=len(string)) :: title_string
        integer :: i
        logical :: capitalize_switch

        capitalize_switch = .true.
        do i = 1, len(string)
            if (is_alphanum(string(i:i))) then
                if (capitalize_switch) then
                    title_string(i:i) = char_to_upper(string(i:i))
                    capitalize_switch = .false.
                else
                    title_string(i:i) = char_to_lower(string(i:i))
                end if
            else
                title_string(i:i) = string(i:i)
                capitalize_switch = .true.
            end if
        end do

    end function to_title

    !> Converts character sequence to sentence case
    !> ([Specification](../page/specs/stdlib_ascii.html#to_sentence))
    !>
    !> Version: experimental
    pure function to_sentence(string) result(sentence_string)
        character(len=*), intent(in) :: string
        character(len=len(string)) :: sentence_string
        integer :: i, n

        n = len(string)
        do i = 1, len(string)
            if (is_alphanum(string(i:i))) then
                sentence_string(i:i) = char_to_upper(string(i:i))
                n = i
                exit
            else
                sentence_string(i:i) = string(i:i)
            end if
        end do

        do i = n + 1, len(string)
            sentence_string(i:i) = char_to_lower(string(i:i))
        end do

    end function to_sentence

    !> Reverse the character order in the input character variable
    !> ([Specification](../page/specs/stdlib_ascii.html#reverse))
    !>
    !> Version: experimental
    pure function reverse(string) result(reverse_string)
        character(len=*), intent(in) :: string
        character(len=len(string)) :: reverse_string
        integer :: i, n

        n = len(string)
        do i = 1, n
            reverse_string(n-i+1:n-i+1) = string(i:i)
        end do

    end function reverse

end module stdlib_ascii