stdlib_strings.fypp

! SPDX-Identifier: MIT
#:include "common.fypp"
!> This module implements basic string handling routines.
!>
!> The specification of this module is available [here](../page/specs/stdlib_strings.html).
module stdlib_strings
    use stdlib_ascii, only: whitespace
    use stdlib_string_type, only: string_type, char, verify, repeat, len
    use stdlib_optval, only: optval
    use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64, lk, c_bool
    implicit none
    private

    public :: to_string
    public :: strip, chomp
    public :: starts_with, ends_with
    public :: slice, find, replace_all, padl, padr, count, zfill

    !> Version: experimental
    !>
    !> Format or transfer other types as a string.
    !> ([Specification](../page/specs/stdlib_strings.html#to_string))
    interface to_string
        #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
        #:set IL_KINDS_TYPES = INT_KINDS_TYPES + LOG_KINDS_TYPES
        #:for k1, t1 in RC_KINDS_TYPES
        pure module function to_string_${t1[0]}$_${k1}$(value, format) result(string)
            ${t1}$, intent(in) :: value
            character(len=*), intent(in), optional :: format
            character(len=:), allocatable :: string
        end function to_string_${t1[0]}$_${k1}$
        #:endfor
        #:for k1, t1 in IL_KINDS_TYPES
        pure module function to_string_1_${t1[0]}$_${k1}$(value) result(string)
            ${t1}$, intent(in) :: value
            character(len=#{if t1[0]=="l"}#1)#{else}#:), allocatable#{endif}# :: string 
        end function to_string_1_${t1[0]}$_${k1}$
        pure module function to_string_2_${t1[0]}$_${k1}$(value, format) result(string)
            ${t1}$, intent(in) :: value
            character(len=*), intent(in) :: format
            character(len=:), allocatable :: string
        end function to_string_2_${t1[0]}$_${k1}$
        #:endfor
    end interface to_string

    !> Remove leading and trailing whitespace characters.
    !>
    !> Version: experimental
    interface strip
        module procedure :: strip_string
        module procedure :: strip_char
    end interface strip

    !> Remove trailing characters in set from string.
    !> If no character set is provided trailing whitespace is removed.
    !>
    !> Version: experimental
    interface chomp
        module procedure :: chomp_string
        module procedure :: chomp_char
        module procedure :: chomp_set_string_char
        module procedure :: chomp_set_char_char
        module procedure :: chomp_substring_string_string
        module procedure :: chomp_substring_char_string
        module procedure :: chomp_substring_string_char
        module procedure :: chomp_substring_char_char
    end interface chomp


    !> Check whether a string starts with substring or not
    !>
    !> Version: experimental
    interface starts_with
        module procedure :: starts_with_string_string
        module procedure :: starts_with_string_char
        module procedure :: starts_with_char_string
        module procedure :: starts_with_char_char
    end interface starts_with


    !> Check whether a string ends with substring or not
    !>
    !> Version: experimental
    interface ends_with
        module procedure :: ends_with_string_string
        module procedure :: ends_with_string_char
        module procedure :: ends_with_char_string
        module procedure :: ends_with_char_char
    end interface ends_with
    
    !> Extracts characters from the input string to return a new string
    !> 
    !> Version: experimental
    interface slice
        module procedure :: slice_string
        module procedure :: slice_char
    end interface slice

    !> Finds the starting index of substring 'pattern' in the input 'string'
    !> [Specifications](link to the specs - to be completed)
    !> 
    !> Version: experimental
    interface find
        module procedure :: find_string_string
        module procedure :: find_string_char
        module procedure :: find_char_string
        module procedure :: find_char_char
    end interface find

    !> Replaces all the occurrences of substring 'pattern' in the input 'string'
    !> with the replacement 'replacement'
    !> Version: experimental
    interface replace_all
        module procedure :: replace_all_string_string_string
        module procedure :: replace_all_string_string_char
        module procedure :: replace_all_string_char_string
        module procedure :: replace_all_char_string_string
        module procedure :: replace_all_string_char_char
        module procedure :: replace_all_char_string_char
        module procedure :: replace_all_char_char_string
        module procedure :: replace_all_char_char_char
    end interface replace_all

    !> Version: experimental
    !>
    !> Left pad the input string
    !> [Specifications](../page/specs/stdlib_strings.html#padl)
    interface padl
        module procedure :: padl_string_default
        module procedure :: padl_string_pad_with
        module procedure :: padl_char_default
        module procedure :: padl_char_pad_with
    end interface padl

    !> Version: experimental
    !>
    !> Right pad the input string
    !> [Specifications](../page/specs/stdlib_strings.html#padr)
    interface padr
        module procedure :: padr_string_default
        module procedure :: padr_string_pad_with
        module procedure :: padr_char_default
        module procedure :: padr_char_pad_with
    end interface padr

    !> Version: experimental
    !>
    !> Returns the number of times substring 'pattern' has appeared in the
    !> input string 'string'
    !> [Specifications](../page/specs/stdlib_strings.html#count)
    interface count
        module procedure :: count_string_string
        module procedure :: count_string_char
        module procedure :: count_char_string
        module procedure :: count_char_char
    end interface count

    !> Version: experimental
    !>
    !> Left pad the input string with zeros.
    !> [Specifications](../page/specs/stdlib_strings.html#zfill)
    interface zfill
        module procedure :: zfill_string
        module procedure :: zfill_char
    end interface zfill

contains


    !> Remove leading and trailing whitespace characters.
    pure function strip_string(string) result(stripped_string)
        ! Avoid polluting the module scope and use the assignment only in this scope 
        use stdlib_string_type, only : assignment(=)
        type(string_type), intent(in) :: string
        type(string_type) :: stripped_string

        stripped_string = strip(char(string))
    end function strip_string

    !> Remove leading and trailing whitespace characters.
    pure function strip_char(string) result(stripped_string)
        character(len=*), intent(in) :: string
        character(len=:), allocatable :: stripped_string
        integer :: first, last

        first = verify(string, whitespace)
        if (first == 0) then
           stripped_string = ""
        else
           last = verify(string, whitespace, back=.true.)
           stripped_string = string(first:last)
        end if

    end function strip_char


    !> Remove trailing characters in set from string.
    !> Default character set variant where trailing whitespace is removed.
    pure function chomp_string(string) result(chomped_string)
        ! Avoid polluting the module scope and use the assignment only in this scope 
        use stdlib_string_type, only : assignment(=)
        type(string_type), intent(in) :: string
        type(string_type) :: chomped_string
        integer :: last

        last = verify(string, whitespace, back=.true.)
        chomped_string = char(string, 1, last)
    end function chomp_string

    !> Remove trailing characters in set from string.
    !> Default character set variant where trailing whitespace is removed.
    pure function chomp_char(string) result(chomped_string)
        character(len=*), intent(in) :: string
        character(len=:), allocatable :: chomped_string
        integer :: last

        last = verify(string, whitespace, back=.true.)
        chomped_string = string(1:last)
    end function chomp_char

    !> Remove trailing characters in set from string.
    pure function chomp_set_string_char(string, set) result(chomped_string)
        ! Avoid polluting the module scope and use the assignment only in this scope 
        use stdlib_string_type, only : assignment(=)
        type(string_type), intent(in) :: string
        character(len=1), intent(in) :: set(:)
        type(string_type) :: chomped_string

        chomped_string = chomp(char(string), set)
    end function chomp_set_string_char

    !> Remove trailing characters in set from string.
    pure function chomp_set_char_char(string, set) result(chomped_string)
        character(len=*), intent(in) :: string
        character(len=1), intent(in) :: set(:)
        character(len=:), allocatable :: chomped_string
        integer :: last

        last = verify(string, set_to_string(set), back=.true.)
        chomped_string = string(1:last)

    end function chomp_set_char_char

    !> Remove trailing substrings from string.
    pure function chomp_substring_string_string(string, substring) result(chomped_string)
        ! Avoid polluting the module scope and use the assignment only in this scope 
        use stdlib_string_type, only : assignment(=)
        type(string_type), intent(in) :: string
        type(string_type), intent(in) :: substring
        type(string_type) :: chomped_string

        chomped_string = chomp(char(string), char(substring))
    end function chomp_substring_string_string

    !> Remove trailing substrings from string.
    pure function chomp_substring_string_char(string, substring) result(chomped_string)
        ! Avoid polluting the module scope and use the assignment only in this scope 
        use stdlib_string_type, only : assignment(=)
        type(string_type), intent(in) :: string
        character(len=*), intent(in) :: substring
        type(string_type) :: chomped_string

        chomped_string = chomp(char(string), substring)
    end function chomp_substring_string_char

    !> Remove trailing substrings from string.
    pure function chomp_substring_char_string(string, substring) result(chomped_string)
        character(len=*), intent(in) :: string
        type(string_type), intent(in) :: substring
        character(len=:), allocatable :: chomped_string

        chomped_string = chomp(string, char(substring))
    end function chomp_substring_char_string

    !> Remove trailing substrings from string.
    pure function chomp_substring_char_char(string, substring) result(chomped_string)
        character(len=*), intent(in) :: string
        character(len=*), intent(in) :: substring
        character(len=:), allocatable :: chomped_string
        integer :: last, nsub

        last = len(string)
        nsub = len(substring)
        if (nsub > 0) then
            do while(string(last-nsub+1:last) == substring)
                last = last - nsub
            end do
        end if
        chomped_string = string(1:last)

    end function chomp_substring_char_char

    !> Implementation to transfer a set of characters to a string representing the set.
    !>
    !> This function is internal and not part of the public API.
    pure function set_to_string(set) result(string)
        character(len=1), intent(in) :: set(:)
        character(len=size(set)) :: string

        string = transfer(set, string)
    end function set_to_string


    !> Check whether a string starts with substring or not
    pure function starts_with_char_char(string, substring) result(match)
        character(len=*), intent(in) :: string
        character(len=*), intent(in) :: substring
        logical :: match
        integer :: nsub

        nsub = len(substring)
        if (len(string) < nsub) then
            match = .false.
            return
        end if
        match = string(1:nsub) == substring

    end function starts_with_char_char

    !> Check whether a string starts with substring or not
    elemental function starts_with_string_char(string, substring) result(match)
        type(string_type), intent(in) :: string
        character(len=*), intent(in) :: substring
        logical :: match

        match = starts_with(char(string), substring)

    end function starts_with_string_char

    !> Check whether a string starts with substring or not
    elemental function starts_with_char_string(string, substring) result(match)
        character(len=*), intent(in) :: string
        type(string_type), intent(in) :: substring
        logical :: match

        match = starts_with(string, char(substring))

    end function starts_with_char_string

    !> Check whether a string starts with substring or not
    elemental function starts_with_string_string(string, substring) result(match)
        type(string_type), intent(in) :: string
        type(string_type), intent(in) :: substring
        logical :: match

        match = starts_with(char(string), char(substring))

    end function starts_with_string_string


    !> Check whether a string ends with substring or not
    pure function ends_with_char_char(string, substring) result(match)
        character(len=*), intent(in) :: string
        character(len=*), intent(in) :: substring
        logical :: match
        integer :: last, nsub

        last = len(string)
        nsub = len(substring)
        if (last < nsub) then
            match = .false.
            return
        end if
        match = string(last-nsub+1:last) == substring

    end function ends_with_char_char

    !> Check whether a string ends with substring or not
    elemental function ends_with_string_char(string, substring) result(match)
        type(string_type), intent(in) :: string
        character(len=*), intent(in) :: substring
        logical :: match

        match = ends_with(char(string), substring)

    end function ends_with_string_char

    !> Check whether a string ends with substring or not
    elemental function ends_with_char_string(string, substring) result(match)
        character(len=*), intent(in) :: string
        type(string_type), intent(in) :: substring
        logical :: match

        match = ends_with(string, char(substring))

    end function ends_with_char_string

    !> Check whether a string ends with substring or not
    elemental function ends_with_string_string(string, substring) result(match)
        type(string_type), intent(in) :: string
        type(string_type), intent(in) :: substring
        logical :: match

        match = ends_with(char(string), char(substring))

    end function ends_with_string_string

    !> Extract the characters from the region between 'first' and 'last' index (both inclusive)
    !> of the input 'string' by taking strides of length 'stride'
    !> Returns a new string
    elemental function slice_string(string, first, last, stride) result(sliced_string)
        type(string_type), intent(in) :: string
        integer, intent(in), optional :: first, last, stride
        type(string_type) :: sliced_string

        sliced_string = string_type(slice(char(string), first, last, stride))

    end function slice_string

    !> Extract the characters from the region between 'first' and 'last' index (both inclusive)
    !> of the input 'string' by taking strides of length 'stride'
    !> Returns a new string
    pure function slice_char(string, first, last, stride) result(sliced_string)
        character(len=*), intent(in) :: string
        integer, intent(in), optional :: first, last, stride
        integer :: first_index, last_index, stride_vector, strides_taken, length_string, i, j
        character(len=:), allocatable :: sliced_string
        length_string = len(string)

        first_index = 0                 ! first_index = -infinity
        last_index = length_string + 1  ! last_index = +infinity
        stride_vector = 1

        if (present(stride)) then
            if (stride /= 0) then
                if (stride < 0) then
                    first_index = length_string + 1     ! first_index = +infinity
                    last_index = 0                      ! last_index = -infinity
                end if
                stride_vector = stride
            end if
        else
            if (present(first) .and. present(last)) then
                if (last < first) then
                    stride_vector = -1
                end if
            end if
        end if

        if (present(first)) then
            first_index = first
        end if
        if (present(last)) then
            last_index = last
        end if
        
        if (stride_vector > 0) then
            first_index = max(first_index, 1)
            last_index = min(last_index, length_string)
        else
            first_index = min(first_index, length_string)
            last_index = max(last_index, 1)
        end if
        
        strides_taken = floor( real(last_index - first_index)/real(stride_vector) )
        allocate(character(len=max(0, strides_taken + 1)) :: sliced_string)
        
        j = 1
        do i = first_index, last_index, stride_vector
            sliced_string(j:j) = string(i:i)
            j = j + 1
        end do
    end function slice_char

    !> Returns the starting index of the 'occurrence'th occurrence of substring 'pattern'
    !> in input 'string'
    !> Returns an integer
    elemental function find_string_string(string, pattern, occurrence, consider_overlapping) result(res)
        type(string_type), intent(in) :: string
        type(string_type), intent(in) :: pattern
        integer, intent(in), optional :: occurrence
        logical, intent(in), optional :: consider_overlapping
        integer :: res

        res = find(char(string), char(pattern), occurrence, consider_overlapping)

    end function find_string_string

    !> Returns the starting index of the 'occurrence'th occurrence of substring 'pattern'
    !> in input 'string'
    !> Returns an integer
    elemental function find_string_char(string, pattern, occurrence, consider_overlapping) result(res)
        type(string_type), intent(in) :: string
        character(len=*), intent(in) :: pattern
        integer, intent(in), optional :: occurrence
        logical, intent(in), optional :: consider_overlapping
        integer :: res

        res = find(char(string), pattern, occurrence, consider_overlapping)

    end function find_string_char

    !> Returns the starting index of the 'occurrence'th occurrence of substring 'pattern'
    !> in input 'string'
    !> Returns an integer
    elemental function find_char_string(string, pattern, occurrence, consider_overlapping) result(res)
        character(len=*), intent(in) :: string
        type(string_type), intent(in) :: pattern
        integer, intent(in), optional :: occurrence
        logical, intent(in), optional :: consider_overlapping
        integer :: res

        res = find(string, char(pattern), occurrence, consider_overlapping)

    end function find_char_string

    !> Returns the starting index of the 'occurrence'th occurrence of substring 'pattern'
    !> in input 'string'
    !> Returns an integer
    elemental function find_char_char(string, pattern, occurrence, consider_overlapping) result(res)
        character(len=*), intent(in) :: string
        character(len=*), intent(in) :: pattern
        integer, intent(in), optional :: occurrence
        logical, intent(in), optional :: consider_overlapping
        integer :: lps_array(len(pattern))
        integer :: res, s_i, p_i, length_string, length_pattern, occurrence_

        occurrence_ = optval(occurrence, 1)
        res = 0
        length_string = len(string)
        length_pattern = len(pattern)

        if (length_pattern > 0 .and. length_pattern <= length_string & 
            & .and. occurrence_ > 0) then
            lps_array = compute_lps(pattern)

            s_i = 1
            p_i = 1
            do while(s_i <= length_string)
                if (string(s_i:s_i) == pattern(p_i:p_i)) then
                    if (p_i == length_pattern) then
                        occurrence_ = occurrence_ - 1
                        if (occurrence_ == 0) then
                            res = s_i - length_pattern + 1
                            exit
                        else if (optval(consider_overlapping, .true.)) then
                            p_i = lps_array(p_i)
                        else
                            p_i = 0
                        end if
                    end if
                    s_i = s_i + 1
                    p_i = p_i + 1
                else if (p_i > 1) then
                    p_i = lps_array(p_i - 1) + 1
                else
                    s_i = s_i + 1
                end if
            end do
        end if
    
    end function find_char_char

    !> Computes longest prefix suffix for each index of the input 'string'
    !> 
    !> Returns an array of integers
    pure function compute_lps(string) result(lps_array)
        character(len=*), intent(in) :: string
        integer :: lps_array(len(string))
        integer :: i, j, length_string
        
        length_string = len(string)

        if (length_string > 0) then
            lps_array(1) = 0

            i = 2
            j = 1
            do while (i <= length_string)
                if (string(j:j) == string(i:i)) then
                    lps_array(i) = j
                    i = i + 1
                    j = j + 1
                else if (j > 1) then
                    j = lps_array(j - 1) + 1
                else
                    lps_array(i) = 0
                    i = i + 1
                end if
            end do
        end if
    
    end function compute_lps

    !> Replaces all occurrences of substring 'pattern' in the input 'string'
    !> with the replacement 'replacement'
    !> Returns a new string
    pure function replace_all_string_string_string(string, pattern, replacement) result(res)
        type(string_type), intent(in) :: string
        type(string_type), intent(in) :: pattern
        type(string_type), intent(in) :: replacement
        type(string_type) :: res

        res = string_type(replace_all(char(string), & 
                & char(pattern), char(replacement)))

    end function replace_all_string_string_string

    !> Replaces all occurrences of substring 'pattern' in the input 'string'
    !> with the replacement 'replacement'
    !> Returns a new string
    pure function replace_all_string_string_char(string, pattern, replacement) result(res)
        type(string_type), intent(in) :: string
        type(string_type), intent(in) :: pattern
        character(len=*), intent(in) :: replacement
        type(string_type) :: res

        res = string_type(replace_all(char(string), char(pattern), replacement))

    end function replace_all_string_string_char

    !> Replaces all occurrences of substring 'pattern' in the input 'string'
    !> with the replacement 'replacement'
    !> Returns a new string
    pure function replace_all_string_char_string(string, pattern, replacement) result(res)
        type(string_type), intent(in) :: string
        character(len=*), intent(in) :: pattern
        type(string_type), intent(in) :: replacement
        type(string_type) :: res

        res = string_type(replace_all(char(string), pattern, char(replacement)))

    end function replace_all_string_char_string

    !> Replaces all occurrences of substring 'pattern' in the input 'string'
    !> with the replacement 'replacement'
    !> Returns a new string
    pure function replace_all_char_string_string(string, pattern, replacement) result(res)
        character(len=*), intent(in) :: string
        type(string_type), intent(in) :: pattern
        type(string_type), intent(in) :: replacement
        character(len=:), allocatable :: res

        res = replace_all(string, char(pattern), char(replacement))

    end function replace_all_char_string_string

    !> Replaces all occurrences of substring 'pattern' in the input 'string'
    !> with the replacement 'replacement'
    !> Returns a new string
    pure function replace_all_string_char_char(string, pattern, replacement) result(res)
        type(string_type), intent(in) :: string
        character(len=*), intent(in) :: pattern
        character(len=*), intent(in) :: replacement
        type(string_type) :: res

        res = string_type(replace_all(char(string), pattern, replacement))

    end function replace_all_string_char_char

    !> Replaces all occurrences of substring 'pattern' in the input 'string'
    !> with the replacement 'replacement'
    !> Returns a new string
    pure function replace_all_char_string_char(string, pattern, replacement) result(res)
        character(len=*), intent(in) :: string
        type(string_type), intent(in) :: pattern
        character(len=*), intent(in) :: replacement
        character(len=:), allocatable :: res

        res = replace_all(string, char(pattern), replacement)

    end function replace_all_char_string_char

    !> Replaces all occurrences of substring 'pattern' in the input 'string'
    !> with the replacement 'replacement'
    !> Returns a new string
    pure function replace_all_char_char_string(string, pattern, replacement) result(res)
        character(len=*), intent(in) :: string
        character(len=*), intent(in) :: pattern
        type(string_type), intent(in) :: replacement
        character(len=:), allocatable :: res

        res = replace_all(string, pattern, char(replacement))

    end function replace_all_char_char_string

    !> Replaces all the occurrences of substring 'pattern' in the input 'string'
    !> with the replacement 'replacement'
    !> Returns a new string
    pure function replace_all_char_char_char(string, pattern, replacement) result(res)
        character(len=*), intent(in) :: string
        character(len=*), intent(in) :: pattern
        character(len=*), intent(in) :: replacement
        character(len=:), allocatable :: res
        integer :: lps_array(len(pattern))
        integer :: s_i, p_i, last, length_string, length_pattern

        res = ""
        length_string = len(string)
        length_pattern = len(pattern)
        last = 1
        
        if (length_pattern > 0 .and. length_pattern <= length_string) then
            lps_array = compute_lps(pattern)

            s_i = 1
            p_i = 1
            do while (s_i <= length_string)
                if (string(s_i:s_i) == pattern(p_i:p_i)) then
                    if (p_i == length_pattern) then
                        res = res // &
                                & string(last : s_i - length_pattern) // &
                                & replacement
                        last = s_i + 1
                        p_i = 0
                    end if
                    s_i = s_i + 1
                    p_i = p_i + 1
                else if (p_i > 1) then
                    p_i = lps_array(p_i - 1) + 1
                else
                    s_i = s_i + 1
                end if
            end do
        end if
        
        res = res // string(last : length_string)

    end function replace_all_char_char_char

    !> Left pad the input string with " " (1 whitespace)
    !>
    !> Returns a new string
    pure function padl_string_default(string, output_length) result(res)
        type(string_type), intent(in) :: string
        integer, intent(in) :: output_length
        type(string_type) :: res

        res = string_type(padl(char(string), output_length, " "))

    end function padl_string_default

    !> Left pad the input string with the 'pad_with' character
    !>
    !> Returns a new string
    pure function padl_string_pad_with(string, output_length, pad_with) result(res)
        type(string_type), intent(in) :: string
        integer, intent(in) :: output_length
        character(len=1), intent(in) :: pad_with
        type(string_type) :: res

        res = string_type(padl(char(string), output_length, pad_with))

    end function padl_string_pad_with

    !> Left pad the input string with " " (1 whitespace)
    !>
    !> Returns a new string
    pure function padl_char_default(string, output_length) result(res)
        character(len=*), intent(in) :: string
        integer, intent(in) :: output_length
        character(len=max(len(string), output_length)) :: res

        res = padl(string, output_length, " ")

    end function padl_char_default

    !> Left pad the input string with the 'pad_with' character
    !>
    !> Returns a new string
    pure function padl_char_pad_with(string, output_length, pad_with) result(res)
        character(len=*), intent(in) :: string
        integer, intent(in) :: output_length
        character(len=1), intent(in) :: pad_with
        character(len=max(len(string), output_length)) :: res
        integer :: string_length

        string_length = len(string)

        if (string_length < output_length) then
            res = repeat(pad_with, output_length - string_length)
            res(output_length - string_length + 1 : output_length) = string
        else
            res = string
        end if

    end function padl_char_pad_with

    !> Right pad the input string with " " (1 whitespace)
    !>
    !> Returns a new string
    pure function padr_string_default(string, output_length) result(res)
        type(string_type), intent(in) :: string
        integer, intent(in) :: output_length
        character(len=max(len(string), output_length)) :: char_output
        type(string_type) :: res

        ! We're taking advantage of `char_output` being longer than `string` and
        ! initialized with whitespaces. By casting `string` to a `character`
        ! type and back to `string_type`, we're effectively right-padding
        ! `string` with spaces, so we don't need to pad explicitly.
        char_output = char(string)
        res = string_type(char_output)

    end function padr_string_default

    !> Right pad the input string with the 'pad_with' character
    !>
    !> Returns a new string
    pure function padr_string_pad_with(string, output_length, pad_with) result(res)
        type(string_type), intent(in) :: string
        integer, intent(in) :: output_length
        character(len=1), intent(in) :: pad_with
        type(string_type) :: res

        res = string_type(padr(char(string), output_length, pad_with))

    end function padr_string_pad_with

    !> Right pad the input string with " " (1 whitespace)
    !>
    !> Returns a new string
    pure function padr_char_default(string, output_length) result(res)
        character(len=*), intent(in) :: string
        integer, intent(in) :: output_length
        character(len=max(len(string), output_length)) :: res

        res = string

    end function padr_char_default

    !> Right pad the input string with the 'pad_with' character
    !>
    !> Returns a new string
    pure function padr_char_pad_with(string, output_length, pad_with) result(res)
        character(len=*), intent(in) :: string
        integer, intent(in) :: output_length
        character(len=1), intent(in) :: pad_with
        character(len=max(len(string), output_length)) :: res
        integer :: string_length

        string_length = len(string)

        res = string
        if (string_length < output_length) then
            res(string_length + 1 : output_length) = &
              repeat(pad_with, output_length - string_length)
        end if

    end function padr_char_pad_with

    !> Returns the number of times substring 'pattern' has appeared in the
    !> input string 'string'
    !> Returns an integer
    elemental function count_string_string(string, pattern, consider_overlapping) result(res)
        type(string_type), intent(in) :: string
        type(string_type), intent(in) :: pattern
        logical, intent(in), optional :: consider_overlapping
        integer :: res

        res = count(char(string), char(pattern), consider_overlapping)

    end function count_string_string

    !> Returns the number of times substring 'pattern' has appeared in the
    !> input string 'string'
    !> Returns an integer
    elemental function count_string_char(string, pattern, consider_overlapping) result(res)
        type(string_type), intent(in) :: string
        character(len=*), intent(in) :: pattern
        logical, intent(in), optional :: consider_overlapping
        integer :: res

        res = count(char(string), pattern, consider_overlapping)

    end function count_string_char

    !> Returns the number of times substring 'pattern' has appeared in the
    !> input string 'string'
    !> Returns an integer
    elemental function count_char_string(string, pattern, consider_overlapping) result(res)
        character(len=*), intent(in) :: string
        type(string_type), intent(in) :: pattern
        logical, intent(in), optional :: consider_overlapping
        integer :: res

        res = count(string, char(pattern), consider_overlapping)

    end function count_char_string

    !> Returns the number of times substring 'pattern' has appeared in the
    !> input string 'string'
    !> Returns an integer
    elemental function count_char_char(string, pattern, consider_overlapping) result(res)
        character(len=*), intent(in) :: string
        character(len=*), intent(in) :: pattern
        logical, intent(in), optional :: consider_overlapping
        integer :: lps_array(len(pattern))
        integer :: res, s_i, p_i, length_string, length_pattern

        res = 0
        length_string = len(string)
        length_pattern = len(pattern)

        if (length_pattern > 0 .and. length_pattern <= length_string) then
            lps_array = compute_lps(pattern)

            s_i = 1
            p_i = 1
            do while (s_i <= length_string)
                if (string(s_i:s_i) == pattern(p_i:p_i)) then
                    if (p_i == length_pattern) then
                        res = res + 1
                        if (optval(consider_overlapping, .true.)) then
                            p_i = lps_array(p_i)
                        else
                            p_i = 0
                        end if
                    end if
                    s_i = s_i + 1
                    p_i = p_i + 1
                else if (p_i > 1) then
                    p_i = lps_array(p_i - 1) + 1
                else
                    s_i = s_i + 1
                end if
            end do
        end if
    
    end function count_char_char

    !> Left pad the input string with zeros
    !>
    !> Returns a new string
    pure function zfill_string(string, output_length) result(res)
        type(string_type), intent(in) :: string
        integer, intent(in) :: output_length
        type(string_type) :: res

        res = string_type(padl(char(string), output_length, "0"))

    end function zfill_string

    !> Left pad the input string with zeros
    !>
    !> Returns a new string
    pure function zfill_char(string, output_length) result(res)
        character(len=*), intent(in) :: string
        integer, intent(in) :: output_length
        character(len=max(len(string), output_length)) :: res

        res = padl(string, output_length, "0")

    end function zfill_char
    

end module stdlib_strings