#: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, parameter :: wp= iachar('a')-iachar('A'), BA=iachar('A'), BZ=iachar('Z')
integer :: k
!Check whether the integer equivalent is between BA=65 and BZ=90
k = ichar(c)
if (k>=BA.and.k<=BZ) k = k + wp
t = char(k)
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, parameter :: wp= iachar('a')-iachar('A'), la=iachar('a'), lz=iachar('z')
integer :: k
!Check whether the integer equivalent is between la=97 and lz=122
k = ichar(c)
if (k>=la.and.k<=lz) k = k - wp
t = char(k)
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
