@@ -12,7 +12,7 @@ module stdlib_strings
12
12
13
13
public :: strip, chomp
14
14
public :: starts_with, ends_with
15
- public :: slice, find
15
+ public :: slice, find, replace_all
16
16
17
17
18
18
!> Remove leading and trailing whitespace characters.
@@ -78,6 +78,20 @@ module stdlib_strings
78
78
module procedure :: find_char_char
79
79
end interface find
80
80
81
+ !> Replaces all the occurrences of substring 'pattern' in the input 'string'
82
+ !> with the replacement 'replacement'
83
+ !> Version: experimental
84
+ interface replace_all
85
+ !module procedure :: replace_all_string_string_string
86
+ !module procedure :: replace_all_string_string_char
87
+ !module procedure :: replace_all_string_char_string
88
+ !module procedure :: replace_all_char_string_string
89
+ !module procedure :: replace_all_string_char_char
90
+ !module procedure :: replace_all_char_string_char
91
+ !module procedure :: replace_all_char_char_string
92
+ module procedure :: replace_all_char_char_char
93
+ end interface replace_all
94
+
81
95
contains
82
96
83
97
@@ -498,5 +512,55 @@ pure function compute_lps(string) result(lps_array)
498
512
499
513
end function compute_lps
500
514
515
+ !> Replaces all the occurrences of substring 'pattern' in the input 'string'
516
+ !> with the replacement 'replacement'
517
+ !> Returns a new string
518
+ pure function replace_all_char_char_char(string, pattern, replacement, replace_overlapping) result(res)
519
+ character(len=*), intent(in) :: string
520
+ character(len=*), intent(in) :: pattern
521
+ character(len=*), intent(in) :: replacement
522
+ logical, intent(in), optional :: replace_overlapping
523
+ character(:), allocatable :: res
524
+ integer :: lps_array(len(pattern))
525
+ integer :: s_i, p_i, last, length_string, length_pattern
526
+ logical :: replace_overlapping_
527
+
528
+ res = ""
529
+ replace_overlapping_ = optval(replace_overlapping, .false.)
530
+ length_string = len(string)
531
+ length_pattern = len(pattern)
532
+ last = 1
533
+
534
+ if (length_pattern > 0 .and. length_pattern <= length_string) then
535
+ lps_array = compute_lps(pattern)
536
+
537
+ s_i = 1
538
+ p_i = 1
539
+ do while(s_i <= length_string)
540
+ if (string(s_i:s_i) == pattern(p_i:p_i)) then
541
+ if (p_i == length_pattern) then
542
+ res = res // &
543
+ & slice(string, first=last, last=s_i - length_pattern, stride=1) // &
544
+ & replacement
545
+ last = s_i + 1
546
+ if (replace_overlapping_) then
547
+ p_i = lps_array(p_i)
548
+ else
549
+ p_i = 0
550
+ end if
551
+ end if
552
+ s_i = s_i + 1
553
+ p_i = p_i + 1
554
+ else if (p_i > 1) then
555
+ p_i = lps_array(p_i - 1) + 1
556
+ else
557
+ s_i = s_i + 1
558
+ end if
559
+ end do
560
+ end if
561
+
562
+ res = res // slice(string, first=last)
563
+
564
+ end function replace_all_char_char_char
501
565
502
566
end module stdlib_strings
0 commit comments