From 933a367956c02f8ca9fed876f4ec8973be9317d1 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sun, 10 Oct 2021 21:44:08 +0530 Subject: [PATCH 01/22] resolved inserting 0 lengthed slist in list bug --- src/stdlib_stringlist_type.f90 | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index 78cfb69d3..8aade5a1a 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -642,23 +642,27 @@ subroutine insert_before_stringlist_int_impl( list, idxn, slist ) type(stringlist_type), intent(in) :: slist integer :: i - integer :: work_idxn, idxnew + integer :: work_idxn, inew integer :: pre_length, post_length - work_idxn = idxn pre_length = slist%len() - call insert_before_empty_positions( list, work_idxn, pre_length ) - post_length = slist%len() + if (pre_length > 0) then + work_idxn = idxn - do i = 1, min( work_idxn - 1, pre_length ) - idxnew = work_idxn + i - 1 - list%stringarray(idxnew) = slist%stringarray(i) - end do + call insert_before_engine( list, work_idxn, pre_length ) + post_length = slist%len() - do i = work_idxn + post_length - pre_length, post_length - idxnew = work_idxn + i - post_length + pre_length - 1 - list%stringarray(idxnew) = slist%stringarray(i) - end do + inew = work_idxn + do i = 1, min( work_idxn - 1, pre_length ) + list%stringarray(inew) = slist%stringarray(i) + inew = inew + 1 + end do + + do i = work_idxn + post_length - pre_length, post_length + list%stringarray(inew) = slist%stringarray(i) + inew = inew + 1 + end do + end if end subroutine insert_before_stringlist_int_impl From ea46f1941eace5a3b1a7567b5b70f2f21cf163e9 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sun, 10 Oct 2021 21:45:48 +0530 Subject: [PATCH 02/22] changed name --- src/stdlib_stringlist_type.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index 8aade5a1a..c476be548 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -649,7 +649,7 @@ subroutine insert_before_stringlist_int_impl( list, idxn, slist ) if (pre_length > 0) then work_idxn = idxn - call insert_before_engine( list, work_idxn, pre_length ) + call insert_before_empty_positions( list, work_idxn, pre_length ) post_length = slist%len() inew = work_idxn From c790494d53fb18104c436db45ac52c391087a830 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Mon, 6 Sep 2021 21:40:36 +0530 Subject: [PATCH 03/22] added delete function for stringlist --- src/stdlib_stringlist_type.f90 | 59 ++++++++++++++++++++++++++++++---- 1 file changed, 52 insertions(+), 7 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index c476be548..5634d2c1f 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -84,8 +84,11 @@ module stdlib_stringlist_type insert_before_chararray_int, & insert_before_stringarray_int - procedure :: get_string_idx => get_string_idx_wrap - generic, public :: get => get_string_idx + procedure :: get_string_idx => get_string_idx_impl + generic, public :: get => get_string_idx + + procedure :: delete_string_idx => delete_string_idx_impl + generic, public :: delete => delete_string_idx end type stringlist_type @@ -718,22 +721,64 @@ end subroutine insert_before_stringarray_int_impl !> !> Returns the string present at stringlist_index 'idx' in stringlist 'list' !> Returns string_type instance - pure function get_string_idx_wrap( list, idx ) + pure function get_string_idx_impl( list, idx ) class(stringlist_type), intent(in) :: list type(stringlist_index_type), intent(in) :: idx - type(string_type) :: get_string_idx_wrap + type(string_type) :: get_string_idx_impl integer :: idxn idxn = list%to_current_idxn( idx ) - ! if the index is out of bounds, return a string_type equivalent to empty string + ! if the index is out of bounds, returns a string_type instance equivalent to empty string if ( 1 <= idxn .and. idxn <= list%len() ) then - get_string_idx_wrap = list%stringarray(idxn) + get_string_idx_impl = list%stringarray(idxn) end if - end function get_string_idx_wrap + end function get_string_idx_impl + + ! delete: + + !> Version: experimental + !> + !> Deletes the string present at stringlist_index 'idx' in stringlist 'list' + !> Returns the deleted string + impure function delete_string_idx_impl( list, idx ) + class(stringlist_type) :: list + type(stringlist_index_type), intent(in) :: idx + type(string_type) :: delete_string_idx_impl + + integer :: idxn, i, inew + integer :: old_len, new_len + type(string_type), dimension(:), allocatable :: new_stringarray + + idxn = list%to_current_idxn( idx ) + + old_len = list%len() + ! if the index is out of bounds, returns a string_type instance equivalent to empty string + ! without deleting anything from the stringlist + if ( 1 <= idxn .and. idxn <= old_len ) then + delete_string_idx_impl = list%stringarray(idxn) + + new_len = old_len - 1 + + allocate( new_stringarray(new_len) ) + + do i = 1, idxn - 1 + ! TODO: can be improved by move + new_stringarray(i) = list%stringarray(i) + end do + do i = idxn + 1, old_len + inew = i - 1 + ! TODO: can be improved by move + new_stringarray(inew) = list%stringarray(i) + end do + + call move_alloc( new_stringarray, list%stringarray ) + + end if + end function delete_string_idx_impl end module stdlib_stringlist_type From e446e7aa53ad44017e7a3a71c55cda0712ee1874 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Mon, 6 Sep 2021 21:49:22 +0530 Subject: [PATCH 04/22] completed TODO by adding move subroutine --- src/stdlib_stringlist_type.f90 | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index 5634d2c1f..6ade7e437 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -15,7 +15,7 @@ ! throughout the PR ! module stdlib_stringlist_type - use stdlib_string_type, only: string_type, operator(/=) + use stdlib_string_type, only: string_type, operator(/=), move use stdlib_math, only: clip implicit none private @@ -600,13 +600,11 @@ subroutine insert_before_empty_positions( list, idxn, positions ) allocate( new_stringarray(new_len) ) do i = 1, idxn - 1 - ! TODO: can be improved by move - new_stringarray(i) = list%stringarray(i) + call move( list%stringarray(i), new_stringarray(i) ) end do do i = idxn, old_len inew = i + positions - ! TODO: can be improved by move - new_stringarray(inew) = list%stringarray(i) + call move( list%stringarray(i), new_stringarray(inew) ) end do call move_alloc( new_stringarray, list%stringarray ) @@ -766,13 +764,11 @@ impure function delete_string_idx_impl( list, idx ) allocate( new_stringarray(new_len) ) do i = 1, idxn - 1 - ! TODO: can be improved by move - new_stringarray(i) = list%stringarray(i) + call move( list%stringarray(i), new_stringarray(i) ) end do do i = idxn + 1, old_len inew = i - 1 - ! TODO: can be improved by move - new_stringarray(inew) = list%stringarray(i) + call move( list%stringarray(i), new_stringarray(inew) ) end do call move_alloc( new_stringarray, list%stringarray ) From bfad13d0efc0c5bda05762e81de797f3c4ece7cc Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sun, 12 Sep 2021 13:51:59 +0530 Subject: [PATCH 05/22] renamed delete to pop, created subroutine drop --- src/stdlib_stringlist_type.f90 | 37 +++++++++++++++++++++++++--------- 1 file changed, 28 insertions(+), 9 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index 6ade7e437..c96367d3f 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -87,8 +87,11 @@ module stdlib_stringlist_type procedure :: get_string_idx => get_string_idx_impl generic, public :: get => get_string_idx - procedure :: delete_string_idx => delete_string_idx_impl - generic, public :: delete => delete_string_idx + procedure :: pop_string_idx => pop_string_idx_impl + generic, public :: pop => pop_string_idx + + procedure :: drop_string_idx => drop_string_idx_impl + generic, public :: drop => drop_string_idx end type stringlist_type @@ -736,16 +739,16 @@ pure function get_string_idx_impl( list, idx ) end function get_string_idx_impl - ! delete: + ! pop: !> Version: experimental !> - !> Deletes the string present at stringlist_index 'idx' in stringlist 'list' - !> Returns the deleted string - impure function delete_string_idx_impl( list, idx ) + !> Removes the string present at stringlist_index 'idx' in stringlist 'list' + !> Returns the removed string + function pop_string_idx_impl( list, idx ) class(stringlist_type) :: list type(stringlist_index_type), intent(in) :: idx - type(string_type) :: delete_string_idx_impl + type(string_type) :: pop_string_idx_impl integer :: idxn, i, inew integer :: old_len, new_len @@ -757,7 +760,7 @@ impure function delete_string_idx_impl( list, idx ) ! if the index is out of bounds, returns a string_type instance equivalent to empty string ! without deleting anything from the stringlist if ( 1 <= idxn .and. idxn <= old_len ) then - delete_string_idx_impl = list%stringarray(idxn) + pop_string_idx_impl = list%stringarray(idxn) new_len = old_len - 1 @@ -775,6 +778,22 @@ impure function delete_string_idx_impl( list, idx ) end if - end function delete_string_idx_impl + end function pop_string_idx_impl + + ! drop: + + !> Version: experimental + !> + !> Removes the string present at stringlist_index 'idx' in stringlist 'list' + !> Doesn't return the removed string + subroutine drop_string_idx_impl( list, idx ) + class(stringlist_type) :: list + type(stringlist_index_type), intent(in) :: idx + type(string_type) :: garbage_string + + ! Throwing away garbage_string by not returning it + garbage_string = list%pop( idx ) + + end subroutine drop_string_idx_impl end module stdlib_stringlist_type From 00de2b75d1adaf96f3a002718518f6b9559030d1 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sun, 12 Sep 2021 14:19:31 +0530 Subject: [PATCH 06/22] fixed an error in documentation of stringlist --- doc/specs/stdlib_stringlist_type.md | 4 ++-- src/stdlib_stringlist_type.f90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/specs/stdlib_stringlist_type.md b/doc/specs/stdlib_stringlist_type.md index 88dc6521a..39d9c5ecc 100644 --- a/doc/specs/stdlib_stringlist_type.md +++ b/doc/specs/stdlib_stringlist_type.md @@ -421,7 +421,7 @@ program demo_equality_operator res = ( stringlist == ["#4", "#3", "#2", "#1"] ) ! res <-- .true. - print'(a)', stringlist == ["#4", "#3", "#1"] + print *, stringlist == ["#4", "#3", "#1"] ! .false. end program demo_equality_operator @@ -491,7 +491,7 @@ program demo_inequality_operator res = ( stringlist /= ["#111", "#222", "#333", "#444"] ) ! res <-- .true. - print'(a)', stringlist /= ["#4", "#3", "#1"] + print *, stringlist /= ["#4", "#3", "#1"] ! .true. end program demo_inequality_operator diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index c96367d3f..f579e516d 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -11,8 +11,8 @@ ! insert BEFORE: Inserts an element BEFORE the element present currently at the asked index ! insert AFTER: Inserts an element AFTER the element present currently at the asked index ! -! Note the distinction between AT and BEFORE in the module. Care has been taken to keep it consistent -! throughout the PR +! Note the distinction between AT and BEFORE in the whole module. Care has been taken to +! keep this terminology consistent throughout the module. ! module stdlib_stringlist_type use stdlib_string_type, only: string_type, operator(/=), move From 92d5f0dcf75df821556f6084f2393831d17fa13b Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sun, 12 Sep 2021 16:27:25 +0530 Subject: [PATCH 07/22] created a new subroutine pop_positions --- src/stdlib_stringlist_type.f90 | 81 +++++++++++++++++++++++----------- 1 file changed, 55 insertions(+), 26 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index f579e516d..8d32aedb6 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -739,45 +739,76 @@ pure function get_string_idx_impl( list, idx ) end function get_string_idx_impl - ! pop: - !> Version: experimental !> - !> Removes the string present at stringlist_index 'idx' in stringlist 'list' - !> Returns the removed string - function pop_string_idx_impl( list, idx ) - class(stringlist_type) :: list - type(stringlist_index_type), intent(in) :: idx - type(string_type) :: pop_string_idx_impl - - integer :: idxn, i, inew - integer :: old_len, new_len - type(string_type), dimension(:), allocatable :: new_stringarray - - idxn = list%to_current_idxn( idx ) + !> Removes strings present at indexes in interval ['first', 'last'] + !> Returns captured popped strings + subroutine pop_positions( list, first, last, capture_popped) + class(stringlist_type) :: list + type(stringlist_index_type), intent(in) :: first, last + type(string_type), allocatable, intent(out), optional :: capture_popped(:) + + integer :: firstn, lastn + integer :: i, inew + integer :: pos, old_len, new_len + type(string_type), dimension(:), allocatable :: new_stringarray old_len = list%len() - ! if the index is out of bounds, returns a string_type instance equivalent to empty string - ! without deleting anything from the stringlist - if ( 1 <= idxn .and. idxn <= old_len ) then - pop_string_idx_impl = list%stringarray(idxn) - new_len = old_len - 1 + firstn = max( list%to_current_idxn( first ), 1 ) + lastn = min( list%to_current_idxn( last ), old_len ) + + ! out of bounds indexes won't modify stringlist + if ( firstn <= lastn ) then + pos = lastn - firstn + 1 + new_len = old_len - pos allocate( new_stringarray(new_len) ) - - do i = 1, idxn - 1 + do i = 1, firstn - 1 call move( list%stringarray(i), new_stringarray(i) ) end do - do i = idxn + 1, old_len - inew = i - 1 + + ! capture popped strings + if ( present(capture_popped) ) then + allocate( capture_popped(pos) ) + inew = 1 + do i = firstn, lastn + call move( list%stringarray(i), capture_popped(inew) ) + inew = inew + 1 + end do + end if + + inew = firstn + do i = lastn + 1, old_len call move( list%stringarray(i), new_stringarray(inew) ) + inew = inew + 1 end do call move_alloc( new_stringarray, list%stringarray ) end if + end subroutine pop_positions + + ! pop: + + !> Version: experimental + !> + !> Removes the string present at stringlist_index 'idx' in stringlist 'list' + !> Returns the removed string + function pop_string_idx_impl( list, idx ) + class(stringlist_type) :: list + type(stringlist_index_type), intent(in) :: idx + type(string_type) :: pop_string_idx_impl + + type(string_type), dimension(:), allocatable :: capture_popped + + call pop_positions( list, idx, idx, capture_popped ) + + if ( allocated(capture_popped) ) then + pop_string_idx_impl = capture_popped(1) + end if + end function pop_string_idx_impl ! drop: @@ -789,10 +820,8 @@ end function pop_string_idx_impl subroutine drop_string_idx_impl( list, idx ) class(stringlist_type) :: list type(stringlist_index_type), intent(in) :: idx - type(string_type) :: garbage_string - ! Throwing away garbage_string by not returning it - garbage_string = list%pop( idx ) + call pop_positions( list, idx, idx ) end subroutine drop_string_idx_impl From 1468fb6765b4e44450d7b75450a9dc945a0100de Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sun, 12 Sep 2021 17:23:39 +0530 Subject: [PATCH 08/22] added range functions for pop and drop --- src/stdlib_stringlist_type.f90 | 77 ++++++++++++++++++++++++---------- 1 file changed, 56 insertions(+), 21 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index 8d32aedb6..8013ce2ab 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -69,10 +69,10 @@ module stdlib_stringlist_type procedure :: insert_at_stringlist_idx => insert_at_stringlist_idx_wrap procedure :: insert_at_chararray_idx => insert_at_chararray_idx_wrap procedure :: insert_at_stringarray_idx => insert_at_stringarray_idx_wrap - generic, public :: insert_at => insert_at_char_idx, & - insert_at_string_idx, & - insert_at_stringlist_idx, & - insert_at_chararray_idx, & + generic, public :: insert_at => insert_at_char_idx, & + insert_at_string_idx, & + insert_at_stringlist_idx, & + insert_at_chararray_idx, & insert_at_stringarray_idx procedure :: insert_before_string_int => insert_before_string_int_impl @@ -87,11 +87,15 @@ module stdlib_stringlist_type procedure :: get_string_idx => get_string_idx_impl generic, public :: get => get_string_idx - procedure :: pop_string_idx => pop_string_idx_impl - generic, public :: pop => pop_string_idx + procedure :: pop_idx => pop_idx_impl + procedure :: pop_range_idx => pop_range_idx_impl + generic, public :: pop => pop_idx, & + pop_range_idx - procedure :: drop_string_idx => drop_string_idx_impl - generic, public :: drop => drop_string_idx + procedure :: drop_idx => drop_idx_impl + procedure :: drop_range_idx => drop_range_idx_impl + generic, public :: drop => drop_idx, & + drop_range_idx end type stringlist_type @@ -743,7 +747,7 @@ end function get_string_idx_impl !> !> Removes strings present at indexes in interval ['first', 'last'] !> Returns captured popped strings - subroutine pop_positions( list, first, last, capture_popped) + subroutine pop_engine( list, first, last, capture_popped) class(stringlist_type) :: list type(stringlist_index_type), intent(in) :: first, last type(string_type), allocatable, intent(out), optional :: capture_popped(:) @@ -785,10 +789,13 @@ subroutine pop_positions( list, first, last, capture_popped) end do call move_alloc( new_stringarray, list%stringarray ) - + else + if ( present(capture_popped) ) then + allocate( capture_popped(0) ) + end if end if - end subroutine pop_positions + end subroutine pop_engine ! pop: @@ -796,20 +803,35 @@ end subroutine pop_positions !> !> Removes the string present at stringlist_index 'idx' in stringlist 'list' !> Returns the removed string - function pop_string_idx_impl( list, idx ) + function pop_idx_impl( list, idx ) class(stringlist_type) :: list type(stringlist_index_type), intent(in) :: idx - type(string_type) :: pop_string_idx_impl + type(string_type) :: pop_idx_impl - type(string_type), dimension(:), allocatable :: capture_popped + type(string_type), dimension(:), allocatable :: popped_strings - call pop_positions( list, idx, idx, capture_popped ) + call pop_engine( list, idx, idx, popped_strings ) - if ( allocated(capture_popped) ) then - pop_string_idx_impl = capture_popped(1) + if ( size(popped_strings) > 0 ) then + pop_idx_impl = popped_strings(1) end if - end function pop_string_idx_impl + end function pop_idx_impl + + !> Version: experimental + !> + !> Removes strings present at stringlist_indexes in interval ['first', 'last'] + !> in stringlist 'list' + !> Returns removed strings + function pop_range_idx_impl( list, first, last ) + class(stringlist_type) :: list + type(stringlist_index_type), intent(in) :: first, last + + type(string_type), dimension(:), allocatable :: pop_range_idx_impl + + call pop_engine( list, first, last, pop_range_idx_impl ) + + end function pop_range_idx_impl ! drop: @@ -817,12 +839,25 @@ end function pop_string_idx_impl !> !> Removes the string present at stringlist_index 'idx' in stringlist 'list' !> Doesn't return the removed string - subroutine drop_string_idx_impl( list, idx ) + subroutine drop_idx_impl( list, idx ) class(stringlist_type) :: list type(stringlist_index_type), intent(in) :: idx - call pop_positions( list, idx, idx ) + call pop_engine( list, idx, idx ) + + end subroutine drop_idx_impl + + !> Version: experimental + !> + !> Removes strings present at stringlist_indexes in interval ['first', 'last'] + !> in stringlist 'list' + !> Doesn't return removed strings + subroutine drop_idx_impl( list, first, last) + class(stringlist_type) :: list + type(stringlist_index_type), intent(in) :: first, last + + call pop_engine( list, first, last ) - end subroutine drop_string_idx_impl + end subroutine drop_idx_impl end module stdlib_stringlist_type From 937fac29db8ce2d01e5e62627b237da45e5db7e5 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sun, 12 Sep 2021 17:31:02 +0530 Subject: [PATCH 09/22] corrected a typo --- src/stdlib_stringlist_type.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index 8013ce2ab..3982e6c7c 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -812,7 +812,7 @@ function pop_idx_impl( list, idx ) call pop_engine( list, idx, idx, popped_strings ) - if ( size(popped_strings) > 0 ) then + if ( size(popped_strings) == 1 ) then pop_idx_impl = popped_strings(1) end if @@ -852,12 +852,12 @@ end subroutine drop_idx_impl !> Removes strings present at stringlist_indexes in interval ['first', 'last'] !> in stringlist 'list' !> Doesn't return removed strings - subroutine drop_idx_impl( list, first, last) + subroutine drop_range_idx_impl( list, first, last) class(stringlist_type) :: list type(stringlist_index_type), intent(in) :: first, last call pop_engine( list, first, last ) - end subroutine drop_idx_impl + end subroutine drop_range_idx_impl end module stdlib_stringlist_type From f60dd9e81ed85b94dcf489ab174fb95080cddb84 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Mon, 13 Sep 2021 14:42:26 +0530 Subject: [PATCH 10/22] corrected errors in documentation --- doc/specs/stdlib_stringlist_type.md | 4 ++-- doc/specs/stdlib_strings.md | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/doc/specs/stdlib_stringlist_type.md b/doc/specs/stdlib_stringlist_type.md index 39d9c5ecc..bac355bda 100644 --- a/doc/specs/stdlib_stringlist_type.md +++ b/doc/specs/stdlib_stringlist_type.md @@ -421,7 +421,7 @@ program demo_equality_operator res = ( stringlist == ["#4", "#3", "#2", "#1"] ) ! res <-- .true. - print *, stringlist == ["#4", "#3", "#1"] + print'(l0)', stringlist == ["#4", "#3", "#1"] ! .false. end program demo_equality_operator @@ -491,7 +491,7 @@ program demo_inequality_operator res = ( stringlist /= ["#111", "#222", "#333", "#444"] ) ! res <-- .true. - print *, stringlist /= ["#4", "#3", "#1"] + print'(l0)', stringlist /= ["#4", "#3", "#1"] ! .true. end program demo_inequality_operator diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index f16995b48..6e507563b 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -146,8 +146,8 @@ The result is of scalar logical type. program demo use stdlib_strings, only : starts_with implicit none - print'(a)', starts_with("pattern", "pat") ! T - print'(a)', starts_with("pattern", "ern") ! F + print'(l0)', starts_with("pattern", "pat") ! T + print'(l0)', starts_with("pattern", "ern") ! F end program demo ``` @@ -188,8 +188,8 @@ The result is of scalar logical type. program demo use stdlib_strings, only : ends_with implicit none - print'(a)', ends_with("pattern", "ern") ! T - print'(a)', ends_with("pattern", "pat") ! F + print'(l0)', ends_with("pattern", "ern") ! T + print'(l0)', ends_with("pattern", "pat") ! F end program demo ``` From 88a1abbf56cbe3de4b2cb386714d99733c8106f8 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Mon, 13 Sep 2021 21:11:01 +0530 Subject: [PATCH 11/22] added range feature for get, added shift function --- src/stdlib_stringlist_type.f90 | 170 ++++++++++++++++++++++----------- 1 file changed, 114 insertions(+), 56 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index 3982e6c7c..e0b5ae48e 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -84,18 +84,20 @@ module stdlib_stringlist_type insert_before_chararray_int, & insert_before_stringarray_int - procedure :: get_string_idx => get_string_idx_impl - generic, public :: get => get_string_idx + procedure :: get_idx => get_idx_impl + procedure :: get_range_idx => get_range_idx_impl + generic, public :: get => get_idx, & + get_range_idx - procedure :: pop_idx => pop_idx_impl - procedure :: pop_range_idx => pop_range_idx_impl - generic, public :: pop => pop_idx, & - pop_range_idx + procedure :: pop_idx => pop_idx_impl + procedure :: pop_range_idx => pop_range_idx_impl + generic, public :: pop => pop_idx, & + pop_range_idx - procedure :: drop_idx => drop_idx_impl - procedure :: drop_range_idx => drop_range_idx_impl - generic, public :: drop => drop_idx, & - drop_range_idx + procedure :: drop_idx => drop_idx_impl + procedure :: drop_range_idx => drop_range_idx_impl + generic, public :: drop => drop_idx, & + drop_range_idx end type stringlist_type @@ -453,6 +455,21 @@ pure logical function ineq_sarray_stringlist( lhs, rhs ) end function ineq_sarray_stringlist + ! Version: experimental + !> + !> Shifts a stringlist_index by integer 'shift_by' + !> Returns the shifted stringlist_index + pure function shift( idx, shift_by ) + !> Not a part of public API + type(stringlist_index_type), intent(in) :: idx + integer, intent(in) :: shift_by + + type(stringlist_index_type), intent(in) :: shift + + shift = merge( fidx( idx%offset + shift_by ), bidx( idx%offset + shift_by ), idx%forward ) + + end function shift + ! clear: !> Version: experimental @@ -588,7 +605,7 @@ end subroutine insert_at_stringarray_idx_wrap !> !> Inserts 'positions' number of empty positions BEFORE integer index 'idxn' !> Modifies the input stringlist 'list' - subroutine insert_before_empty_positions( list, idxn, positions ) + subroutine insert_before_engine( list, idxn, positions ) !> Not a part of public API class(stringlist_type), intent(inout) :: list integer, intent(inout) :: idxn @@ -618,7 +635,7 @@ subroutine insert_before_empty_positions( list, idxn, positions ) end if - end subroutine insert_before_empty_positions + end subroutine insert_before_engine !> Version: experimental !> @@ -633,7 +650,7 @@ subroutine insert_before_string_int_impl( list, idxn, string ) integer :: work_idxn work_idxn = idxn - call insert_before_empty_positions( list, work_idxn, 1 ) + call insert_before_engine( list, work_idxn, 1 ) list%stringarray(work_idxn) = string @@ -688,7 +705,7 @@ subroutine insert_before_chararray_int_impl( list, idxn, carray ) integer :: work_idxn, idxnew work_idxn = idxn - call insert_before_empty_positions( list, work_idxn, size( carray ) ) + call insert_before_engine( list, work_idxn, size( carray ) ) do i = 1, size( carray ) idxnew = work_idxn + i - 1 @@ -711,7 +728,7 @@ subroutine insert_before_stringarray_int_impl( list, idxn, sarray ) integer :: work_idxn, idxnew work_idxn = idxn - call insert_before_empty_positions( list, work_idxn, size( sarray ) ) + call insert_before_engine( list, work_idxn, size( sarray ) ) do i = 1, size( sarray ) idxnew = work_idxn + i - 1 @@ -722,68 +739,113 @@ end subroutine insert_before_stringarray_int_impl ! get: + !> Version: experimental + !> + !> Returns strings present at stringlist_indexes in interval ['first', 'last'] + !> Stores requested strings in array 'capture_strings' + !> No return + subroutine get_engine( list, first, last, capture_strings ) + class(stringlist_type) :: list + type(stringlist_index_type), intent(in) :: first, last + type(string_type), allocatable, intent(out) :: capture_strings(:) + + integer :: from, to + integer :: i, inew + + from = max( list%to_current_idxn( first ), 1 ) + to = min( list%to_current_idxn( last ), list%len() ) + + ! out of bounds indexes won't be captured in capture_strings + if ( from <= to ) then + pos = to - from + 1 + allocate( capture_strings(pos) ) + + inew = 1 + do i = from, to + capture_strings(inew) = list%stringarray(i) + inew = inew + 1 + end do + + else + allocate( capture_strings(0) ) + end if + + end subroutine get_engine + !> Version: experimental !> !> Returns the string present at stringlist_index 'idx' in stringlist 'list' !> Returns string_type instance - pure function get_string_idx_impl( list, idx ) - class(stringlist_type), intent(in) :: list - type(stringlist_index_type), intent(in) :: idx - type(string_type) :: get_string_idx_impl - - integer :: idxn + pure function get_idx_impl( list, idx ) + class(stringlist_type), intent(in) :: list + type(stringlist_index_type), intent(in) :: idx + type(string_type) :: get_idx_impl - idxn = list%to_current_idxn( idx ) + type(string_type), allocatable :: capture_strings(:) - ! if the index is out of bounds, returns a string_type instance equivalent to empty string - if ( 1 <= idxn .and. idxn <= list%len() ) then - get_string_idx_impl = list%stringarray(idxn) + call get_engine( list, idx, idx, capture_strings ) + ! if index 'idx' is out of bounds, returns an empty string + if ( size(capture_strings) == 1 ) then + call move( capture_strings(1), get_idx_impl ) end if - end function get_string_idx_impl + end function get_idx_impl + + !> Version: experimental + !> + !> Returns strings present at stringlist_indexes in interval ['first', 'last'] + !> Returns array of string_type instances + pure function get_range_idx_impl( list, first, last ) + class(stringlist_type), intent(in) :: list + type(stringlist_index_type), intent(in) :: first, last + + type(string_type), allocatable :: get_range_idx_impl(:) + + call get_engine( list, first, last, get_range_idx_impl ) + + end function get_range_idx_impl + + ! pop & drop: !> Version: experimental !> !> Removes strings present at indexes in interval ['first', 'last'] - !> Returns captured popped strings - subroutine pop_engine( list, first, last, capture_popped) + !> Stores captured popped strings in array 'capture_popped' + !> No return + subroutine pop_drop_engine( list, first, last, capture_popped ) class(stringlist_type) :: list type(stringlist_index_type), intent(in) :: first, last type(string_type), allocatable, intent(out), optional :: capture_popped(:) - integer :: firstn, lastn - integer :: i, inew - integer :: pos, old_len, new_len + integer :: firstn, lastn, from, to + integer :: i, inew, pos, old_len, new_len type(string_type), dimension(:), allocatable :: new_stringarray old_len = list%len() - - firstn = max( list%to_current_idxn( first ), 1 ) - lastn = min( list%to_current_idxn( last ), old_len ) + firstn = list%to_current_idxn( first ) + lastn = list%to_current_idxn( last ) + from = max( firstn , 1 ) + to = min( lastn , old_len ) ! out of bounds indexes won't modify stringlist - if ( firstn <= lastn ) then - pos = lastn - firstn + 1 + if ( from <= to ) then + pos = to - from + 1 new_len = old_len - pos allocate( new_stringarray(new_len) ) - do i = 1, firstn - 1 + do i = 1, from - 1 call move( list%stringarray(i), new_stringarray(i) ) end do ! capture popped strings if ( present(capture_popped) ) then - allocate( capture_popped(pos) ) - inew = 1 - do i = firstn, lastn - call move( list%stringarray(i), capture_popped(inew) ) - inew = inew + 1 - end do + call get_engine( list, shift( first, from - firstn ), & + & shift( last, lastn - to ), capture_popped ) end if - inew = firstn - do i = lastn + 1, old_len + inew = from + do i = to + 1, old_len call move( list%stringarray(i), new_stringarray(inew) ) inew = inew + 1 end do @@ -795,9 +857,7 @@ subroutine pop_engine( list, first, last, capture_popped) end if end if - end subroutine pop_engine - - ! pop: + end subroutine pop_drop_engine !> Version: experimental !> @@ -810,10 +870,10 @@ function pop_idx_impl( list, idx ) type(string_type), dimension(:), allocatable :: popped_strings - call pop_engine( list, idx, idx, popped_strings ) + call pop_drop_engine( list, idx, idx, popped_strings ) if ( size(popped_strings) == 1 ) then - pop_idx_impl = popped_strings(1) + call move( pop_idx_impl, popped_strings(1) ) end if end function pop_idx_impl @@ -829,12 +889,10 @@ function pop_range_idx_impl( list, first, last ) type(string_type), dimension(:), allocatable :: pop_range_idx_impl - call pop_engine( list, first, last, pop_range_idx_impl ) + call pop_drop_engine( list, first, last, pop_range_idx_impl ) end function pop_range_idx_impl - ! drop: - !> Version: experimental !> !> Removes the string present at stringlist_index 'idx' in stringlist 'list' @@ -843,7 +901,7 @@ subroutine drop_idx_impl( list, idx ) class(stringlist_type) :: list type(stringlist_index_type), intent(in) :: idx - call pop_engine( list, idx, idx ) + call pop_drop_engine( list, idx, idx ) end subroutine drop_idx_impl @@ -852,11 +910,11 @@ end subroutine drop_idx_impl !> Removes strings present at stringlist_indexes in interval ['first', 'last'] !> in stringlist 'list' !> Doesn't return removed strings - subroutine drop_range_idx_impl( list, first, last) + subroutine drop_range_idx_impl( list, first, last ) class(stringlist_type) :: list type(stringlist_index_type), intent(in) :: first, last - call pop_engine( list, first, last ) + call pop_drop_engine( list, first, last ) end subroutine drop_range_idx_impl From ccd6dff0424dfcaf9a2a1331af07d842078d351d Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Mon, 13 Sep 2021 21:40:17 +0530 Subject: [PATCH 12/22] made move subroutine of stdlib_string_type module pure --- src/stdlib_string_type.fypp | 8 ++++---- src/stdlib_stringlist_type.f90 | 13 ++++++------- 2 files changed, 10 insertions(+), 11 deletions(-) diff --git a/src/stdlib_string_type.fypp b/src/stdlib_string_type.fypp index a47ee6fc0..135620456 100644 --- a/src/stdlib_string_type.fypp +++ b/src/stdlib_string_type.fypp @@ -678,7 +678,7 @@ contains !> Moves the allocated character scalar from 'from' to 'to' !> No output - subroutine move_string_string(from, to) + pure subroutine move_string_string(from, to) type(string_type), intent(inout) :: from type(string_type), intent(out) :: to @@ -688,7 +688,7 @@ contains !> Moves the allocated character scalar from 'from' to 'to' !> No output - subroutine move_string_char(from, to) + pure subroutine move_string_char(from, to) type(string_type), intent(inout) :: from character(len=:), intent(out), allocatable :: to @@ -698,7 +698,7 @@ contains !> Moves the allocated character scalar from 'from' to 'to' !> No output - subroutine move_char_string(from, to) + pure subroutine move_char_string(from, to) character(len=:), intent(inout), allocatable :: from type(string_type), intent(out) :: to @@ -708,7 +708,7 @@ contains !> Moves the allocated character scalar from 'from' to 'to' !> No output - subroutine move_char_char(from, to) + pure subroutine move_char_char(from, to) character(len=:), intent(inout), allocatable :: from character(len=:), intent(out), allocatable :: to diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index e0b5ae48e..b6de3c66a 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -464,7 +464,7 @@ pure function shift( idx, shift_by ) type(stringlist_index_type), intent(in) :: idx integer, intent(in) :: shift_by - type(stringlist_index_type), intent(in) :: shift + type(stringlist_index_type) :: shift shift = merge( fidx( idx%offset + shift_by ), bidx( idx%offset + shift_by ), idx%forward ) @@ -607,7 +607,7 @@ end subroutine insert_at_stringarray_idx_wrap !> Modifies the input stringlist 'list' subroutine insert_before_engine( list, idxn, positions ) !> Not a part of public API - class(stringlist_type), intent(inout) :: list + type(stringlist_type), intent(inout) :: list integer, intent(inout) :: idxn integer, intent(in) :: positions @@ -744,8 +744,8 @@ end subroutine insert_before_stringarray_int_impl !> Returns strings present at stringlist_indexes in interval ['first', 'last'] !> Stores requested strings in array 'capture_strings' !> No return - subroutine get_engine( list, first, last, capture_strings ) - class(stringlist_type) :: list + pure subroutine get_engine( list, first, last, capture_strings ) + type(stringlist_type), intent(in) :: list type(stringlist_index_type), intent(in) :: first, last type(string_type), allocatable, intent(out) :: capture_strings(:) @@ -757,8 +757,7 @@ subroutine get_engine( list, first, last, capture_strings ) ! out of bounds indexes won't be captured in capture_strings if ( from <= to ) then - pos = to - from + 1 - allocate( capture_strings(pos) ) + allocate( capture_strings( to - from + 1 ) ) inew = 1 do i = from, to @@ -779,8 +778,8 @@ end subroutine get_engine pure function get_idx_impl( list, idx ) class(stringlist_type), intent(in) :: list type(stringlist_index_type), intent(in) :: idx - type(string_type) :: get_idx_impl + type(string_type) :: get_idx_impl type(string_type), allocatable :: capture_strings(:) call get_engine( list, idx, idx, capture_strings ) From 2e216c8faf62389c3a38cb9fb545169f5e965360 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Wed, 15 Sep 2021 19:05:12 +0530 Subject: [PATCH 13/22] some minor changes --- src/stdlib_stringlist_type.f90 | 51 +++++++++++++++++----------------- 1 file changed, 26 insertions(+), 25 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index b6de3c66a..a3a232853 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -171,14 +171,16 @@ end function new_stringlist pure function new_stringlist_carray( array ) character(len=*), dimension(:), intent(in) :: array type(stringlist_type) :: new_stringlist_carray - type(string_type), dimension( size(array) ) :: sarray + + type(string_type), allocatable :: sarray(:) integer :: i + allocate( sarray( size(array) ) ) do i = 1, size(array) sarray(i) = string_type( array(i) ) end do - new_stringlist_carray = stringlist_type( sarray ) + call move_alloc( sarray, new_stringlist_carray%stringarray ) end function new_stringlist_carray @@ -188,7 +190,6 @@ pure function new_stringlist_sarray( array ) type(string_type), dimension(:), intent(in) :: array type(stringlist_type) :: new_stringlist_sarray - new_stringlist_sarray = stringlist_type() new_stringlist_sarray%stringarray = array end function new_stringlist_sarray @@ -476,7 +477,7 @@ end function shift !> !> Resets stringlist 'list' to an empy stringlist of len 0 !> Modifies the input stringlist 'list' - subroutine clear_list( list ) + pure subroutine clear_list( list ) class(stringlist_type), intent(inout) :: list if ( allocated( list%stringarray ) ) then @@ -540,7 +541,7 @@ end function convert_to_current_idxn !> !> Inserts character scalar 'string' AT stringlist_index 'idx' in stringlist 'list' !> Modifies the input stringlist 'list' - subroutine insert_at_char_idx_wrap( list, idx, string ) + pure subroutine insert_at_char_idx_wrap( list, idx, string ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx character(len=*), intent(in) :: string @@ -553,7 +554,7 @@ end subroutine insert_at_char_idx_wrap !> !> Inserts string 'string' AT stringlist_index 'idx' in stringlist 'list' !> Modifies the input stringlist 'list' - subroutine insert_at_string_idx_wrap( list, idx, string ) + pure subroutine insert_at_string_idx_wrap( list, idx, string ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx type(string_type), intent(in) :: string @@ -566,7 +567,7 @@ end subroutine insert_at_string_idx_wrap !> !> Inserts stringlist 'slist' AT stringlist_index 'idx' in stringlist 'list' !> Modifies the input stringlist 'list' - subroutine insert_at_stringlist_idx_wrap( list, idx, slist ) + pure subroutine insert_at_stringlist_idx_wrap( list, idx, slist ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx type(stringlist_type), intent(in) :: slist @@ -579,7 +580,7 @@ end subroutine insert_at_stringlist_idx_wrap !> !> Inserts chararray 'carray' AT stringlist_index 'idx' in stringlist 'list' !> Modifies the input stringlist 'list' - subroutine insert_at_chararray_idx_wrap( list, idx, carray ) + pure subroutine insert_at_chararray_idx_wrap( list, idx, carray ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx character(len=*), dimension(:), intent(in) :: carray @@ -592,7 +593,7 @@ end subroutine insert_at_chararray_idx_wrap !> !> Inserts stringarray 'sarray' AT stringlist_index 'idx' in stringlist 'list' !> Modifies the input stringlist 'list' - subroutine insert_at_stringarray_idx_wrap( list, idx, sarray ) + pure subroutine insert_at_stringarray_idx_wrap( list, idx, sarray ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx type(string_type), dimension(:), intent(in) :: sarray @@ -605,7 +606,7 @@ end subroutine insert_at_stringarray_idx_wrap !> !> Inserts 'positions' number of empty positions BEFORE integer index 'idxn' !> Modifies the input stringlist 'list' - subroutine insert_before_engine( list, idxn, positions ) + pure subroutine insert_before_engine( list, idxn, positions ) !> Not a part of public API type(stringlist_type), intent(inout) :: list integer, intent(inout) :: idxn @@ -641,7 +642,7 @@ end subroutine insert_before_engine !> !> Inserts string 'string' BEFORE integer index 'idxn' in the underlying stringarray !> Modifies the input stringlist 'list' - subroutine insert_before_string_int_impl( list, idxn, string ) + pure subroutine insert_before_string_int_impl( list, idxn, string ) !> Not a part of public API class(stringlist_type), intent(inout) :: list integer, intent(in) :: idxn @@ -660,7 +661,7 @@ end subroutine insert_before_string_int_impl !> !> Inserts stringlist 'slist' BEFORE integer index 'idxn' in the underlying stringarray !> Modifies the input stringlist 'list' - subroutine insert_before_stringlist_int_impl( list, idxn, slist ) + pure subroutine insert_before_stringlist_int_impl( list, idxn, slist ) !> Not a part of public API class(stringlist_type), intent(inout) :: list integer, intent(in) :: idxn @@ -695,7 +696,7 @@ end subroutine insert_before_stringlist_int_impl !> !> Inserts chararray 'carray' BEFORE integer index 'idxn' in the underlying stringarray !> Modifies the input stringlist 'list' - subroutine insert_before_chararray_int_impl( list, idxn, carray ) + pure subroutine insert_before_chararray_int_impl( list, idxn, carray ) !> Not a part of public API class(stringlist_type), intent(inout) :: list integer, intent(in) :: idxn @@ -718,7 +719,7 @@ end subroutine insert_before_chararray_int_impl !> !> Inserts stringarray 'sarray' BEFORE integer index 'idxn' in the underlying stringarray !> Modifies the input stringlist 'list' - subroutine insert_before_stringarray_int_impl( list, idxn, sarray ) + pure subroutine insert_before_stringarray_int_impl( list, idxn, sarray ) !> Not a part of public API class(stringlist_type), intent(inout) :: list integer, intent(in) :: idxn @@ -755,7 +756,7 @@ pure subroutine get_engine( list, first, last, capture_strings ) from = max( list%to_current_idxn( first ), 1 ) to = min( list%to_current_idxn( last ), list%len() ) - ! out of bounds indexes won't be captured in capture_strings + ! out of bounds indexes won't be captured in 'capture_strings' if ( from <= to ) then allocate( capture_strings( to - from + 1 ) ) @@ -812,8 +813,8 @@ end function get_range_idx_impl !> Removes strings present at indexes in interval ['first', 'last'] !> Stores captured popped strings in array 'capture_popped' !> No return - subroutine pop_drop_engine( list, first, last, capture_popped ) - class(stringlist_type) :: list + pure subroutine pop_drop_engine( list, first, last, capture_popped ) + class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: first, last type(string_type), allocatable, intent(out), optional :: capture_popped(:) @@ -824,8 +825,8 @@ subroutine pop_drop_engine( list, first, last, capture_popped ) old_len = list%len() firstn = list%to_current_idxn( first ) lastn = list%to_current_idxn( last ) - from = max( firstn , 1 ) - to = min( lastn , old_len ) + from = max( firstn, 1 ) + to = min( lastn, old_len ) ! out of bounds indexes won't modify stringlist if ( from <= to ) then @@ -863,7 +864,7 @@ end subroutine pop_drop_engine !> Removes the string present at stringlist_index 'idx' in stringlist 'list' !> Returns the removed string function pop_idx_impl( list, idx ) - class(stringlist_type) :: list + class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx type(string_type) :: pop_idx_impl @@ -883,7 +884,7 @@ end function pop_idx_impl !> in stringlist 'list' !> Returns removed strings function pop_range_idx_impl( list, first, last ) - class(stringlist_type) :: list + class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: first, last type(string_type), dimension(:), allocatable :: pop_range_idx_impl @@ -896,8 +897,8 @@ end function pop_range_idx_impl !> !> Removes the string present at stringlist_index 'idx' in stringlist 'list' !> Doesn't return the removed string - subroutine drop_idx_impl( list, idx ) - class(stringlist_type) :: list + pure subroutine drop_idx_impl( list, idx ) + class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx call pop_drop_engine( list, idx, idx ) @@ -909,8 +910,8 @@ end subroutine drop_idx_impl !> Removes strings present at stringlist_indexes in interval ['first', 'last'] !> in stringlist 'list' !> Doesn't return removed strings - subroutine drop_range_idx_impl( list, first, last ) - class(stringlist_type) :: list + pure subroutine drop_range_idx_impl( list, first, last ) + class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: first, last call pop_drop_engine( list, first, last ) From 5d24c0cd016b1d94fa4b2a92a5b64e91d8eab889 Mon Sep 17 00:00:00 2001 From: Aman Godara <34789087+Aman-Godara@users.noreply.github.com> Date: Fri, 17 Sep 2021 18:23:35 +0530 Subject: [PATCH 14/22] rename capture_popped to popped_strings Co-authored-by: Emanuele Pagone --- src/stdlib_stringlist_type.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index a3a232853..22654692b 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -816,7 +816,7 @@ end function get_range_idx_impl pure subroutine pop_drop_engine( list, first, last, capture_popped ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: first, last - type(string_type), allocatable, intent(out), optional :: capture_popped(:) + type(string_type), allocatable, intent(out), optional :: popped_strings(:) integer :: firstn, lastn, from, to integer :: i, inew, pos, old_len, new_len From 48c94dca84bfc02ef9b66af802172b81e02cdb0a Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Fri, 17 Sep 2021 18:38:45 +0530 Subject: [PATCH 15/22] renamed to popped_strings all over the function --- src/stdlib_stringlist_type.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index 22654692b..4e36459dc 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -811,9 +811,9 @@ end function get_range_idx_impl !> Version: experimental !> !> Removes strings present at indexes in interval ['first', 'last'] - !> Stores captured popped strings in array 'capture_popped' + !> Stores popped strings in array 'popped_strings' !> No return - pure subroutine pop_drop_engine( list, first, last, capture_popped ) + pure subroutine pop_drop_engine( list, first, last, popped_strings ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: first, last type(string_type), allocatable, intent(out), optional :: popped_strings(:) @@ -839,9 +839,9 @@ pure subroutine pop_drop_engine( list, first, last, capture_popped ) end do ! capture popped strings - if ( present(capture_popped) ) then + if ( present(popped_strings) ) then call get_engine( list, shift( first, from - firstn ), & - & shift( last, lastn - to ), capture_popped ) + & shift( last, lastn - to ), popped_strings ) end if inew = from @@ -852,8 +852,8 @@ pure subroutine pop_drop_engine( list, first, last, capture_popped ) call move_alloc( new_stringarray, list%stringarray ) else - if ( present(capture_popped) ) then - allocate( capture_popped(0) ) + if ( present(popped_strings) ) then + allocate( popped_strings(0) ) end if end if From 980c18aeb2667b3c09cd33a8942732a36879adc4 Mon Sep 17 00:00:00 2001 From: Aman Godara <34789087+Aman-Godara@users.noreply.github.com> Date: Sun, 26 Sep 2021 21:25:14 +0530 Subject: [PATCH 16/22] removing redundant naming convention Co-authored-by: Emanuele Pagone --- src/stdlib_stringlist_type.f90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index 4e36459dc..9fe29dc1f 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -89,10 +89,9 @@ module stdlib_stringlist_type generic, public :: get => get_idx, & get_range_idx - procedure :: pop_idx => pop_idx_impl - procedure :: pop_range_idx => pop_range_idx_impl - generic, public :: pop => pop_idx, & - pop_range_idx + procedure :: pop_index ! or `pop_idx`, if you wish + procedure :: pop_range_index ! or `pop_range_idx`, if you wish + generic, public :: pop => pop_index, pop_range_index procedure :: drop_idx => drop_idx_impl procedure :: drop_range_idx => drop_range_idx_impl From e935ea14871253ef7e65bbc73b9577e3405da0aa Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sun, 26 Sep 2021 21:23:52 +0530 Subject: [PATCH 17/22] improved append operator's performance --- src/stdlib_stringlist_type.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index 9fe29dc1f..3b243630f 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -222,7 +222,8 @@ function append_char( lhs, rhs ) character(len=*), intent(in) :: rhs type(stringlist_type) :: append_char - append_char = lhs // string_type( rhs ) + append_char = lhs ! Intent: creating a full, deep copy + call append_char%insert_at( list_tail, rhs ) end function append_char @@ -245,7 +246,8 @@ function prepend_char( lhs, rhs ) type(stringlist_type), intent(in) :: rhs type(stringlist_type) :: prepend_char - prepend_char = string_type( lhs ) // rhs + prepend_char = rhs ! Intent: creating a full, deep copy + call prepend_char%insert_at( list_head, lhs ) end function prepend_char From e34cce20f3e2a33b7b4f5546274464267d0a7d07 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sun, 26 Sep 2021 21:35:57 +0530 Subject: [PATCH 18/22] changed naming convention throughout the module --- src/stdlib_stringlist_type.f90 | 125 +++++++++++++++++---------------- 1 file changed, 63 insertions(+), 62 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index 3b243630f..f2f6dcbb4 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -60,41 +60,42 @@ module stdlib_stringlist_type procedure, public :: len => length_list - procedure :: to_future_at_idxn => convert_to_future_at_idxn + procedure :: to_future_at_idxn - procedure :: to_current_idxn => convert_to_current_idxn + procedure :: to_current_idxn - procedure :: insert_at_char_idx => insert_at_char_idx_wrap - procedure :: insert_at_string_idx => insert_at_string_idx_wrap - procedure :: insert_at_stringlist_idx => insert_at_stringlist_idx_wrap - procedure :: insert_at_chararray_idx => insert_at_chararray_idx_wrap - procedure :: insert_at_stringarray_idx => insert_at_stringarray_idx_wrap + procedure :: insert_at_char_idx + procedure :: insert_at_string_idx + procedure :: insert_at_stringlist_idx + procedure :: insert_at_chararray_idx + procedure :: insert_at_stringarray_idx generic, public :: insert_at => insert_at_char_idx, & insert_at_string_idx, & insert_at_stringlist_idx, & insert_at_chararray_idx, & insert_at_stringarray_idx - procedure :: insert_before_string_int => insert_before_string_int_impl - procedure :: insert_before_stringlist_int => insert_before_stringlist_int_impl - procedure :: insert_before_chararray_int => insert_before_chararray_int_impl - procedure :: insert_before_stringarray_int => insert_before_stringarray_int_impl + procedure :: insert_before_string_int + procedure :: insert_before_stringlist_int + procedure :: insert_before_chararray_int + procedure :: insert_before_stringarray_int generic :: insert_before => insert_before_string_int, & insert_before_stringlist_int, & insert_before_chararray_int, & insert_before_stringarray_int - procedure :: get_idx => get_idx_impl - procedure :: get_range_idx => get_range_idx_impl + procedure :: get_idx + procedure :: get_range_idx generic, public :: get => get_idx, & get_range_idx - procedure :: pop_index ! or `pop_idx`, if you wish - procedure :: pop_range_index ! or `pop_range_idx`, if you wish - generic, public :: pop => pop_index, pop_range_index + procedure :: pop_idx + procedure :: pop_range_idx + generic, public :: pop => pop_idx, & + pop_range_idx - procedure :: drop_idx => drop_idx_impl - procedure :: drop_range_idx => drop_range_idx_impl + procedure :: drop_idx + procedure :: drop_range_idx generic, public :: drop => drop_idx, & drop_range_idx @@ -510,15 +511,15 @@ end function length_list !> Converts a forward index OR a backward index to an integer index at !> which the new element will be present post insertion (i.e. in future) !> Returns an integer - pure integer function convert_to_future_at_idxn( list, idx ) + pure integer function to_future_at_idxn( list, idx ) !> Not a part of public API class(stringlist_type), intent(in) :: list type(stringlist_index_type), intent(in) :: idx ! Formula: merge( fidx( x ) - ( list_head - 1 ), len - bidx( x ) + ( list_tail - 1 ) + 2, ... ) - convert_to_future_at_idxn = merge( idx%offset, list%len() - idx%offset + 2 , idx%forward ) + to_future_at_idxn = merge( idx%offset, list%len() - idx%offset + 2 , idx%forward ) - end function convert_to_future_at_idxn + end function to_future_at_idxn ! to_current_idxn: @@ -526,15 +527,15 @@ end function convert_to_future_at_idxn !> !> Converts a forward index OR backward index to its equivalent integer index idxn !> Returns an integer - pure integer function convert_to_current_idxn( list, idx ) + pure integer function to_current_idxn( list, idx ) !> Not a part of public API class(stringlist_type), intent(in) :: list type(stringlist_index_type), intent(in) :: idx ! Formula: merge( fidx( x ) - ( list_head - 1 ), len + 1 - bidx( x ) + ( list_tail - 1 ), ... ) - convert_to_current_idxn = merge( idx%offset, list%len() - idx%offset + 1, idx%forward ) + to_current_idxn = merge( idx%offset, list%len() - idx%offset + 1, idx%forward ) - end function convert_to_current_idxn + end function to_current_idxn ! insert_at: @@ -542,66 +543,66 @@ end function convert_to_current_idxn !> !> Inserts character scalar 'string' AT stringlist_index 'idx' in stringlist 'list' !> Modifies the input stringlist 'list' - pure subroutine insert_at_char_idx_wrap( list, idx, string ) + pure subroutine insert_at_char_idx( list, idx, string ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx character(len=*), intent(in) :: string call list%insert_at( idx, string_type( string ) ) - end subroutine insert_at_char_idx_wrap + end subroutine insert_at_char_idx !> Version: experimental !> !> Inserts string 'string' AT stringlist_index 'idx' in stringlist 'list' !> Modifies the input stringlist 'list' - pure subroutine insert_at_string_idx_wrap( list, idx, string ) + pure subroutine insert_at_string_idx( list, idx, string ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx type(string_type), intent(in) :: string call list%insert_before( list%to_future_at_idxn( idx ), string ) - end subroutine insert_at_string_idx_wrap + end subroutine insert_at_string_idx !> Version: experimental !> !> Inserts stringlist 'slist' AT stringlist_index 'idx' in stringlist 'list' !> Modifies the input stringlist 'list' - pure subroutine insert_at_stringlist_idx_wrap( list, idx, slist ) + pure subroutine insert_at_stringlist_idx( list, idx, slist ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx type(stringlist_type), intent(in) :: slist call list%insert_before( list%to_future_at_idxn( idx ), slist ) - end subroutine insert_at_stringlist_idx_wrap + end subroutine insert_at_stringlist_idx !> Version: experimental !> !> Inserts chararray 'carray' AT stringlist_index 'idx' in stringlist 'list' !> Modifies the input stringlist 'list' - pure subroutine insert_at_chararray_idx_wrap( list, idx, carray ) + pure subroutine insert_at_chararray_idx( list, idx, carray ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx character(len=*), dimension(:), intent(in) :: carray call list%insert_before( list%to_future_at_idxn( idx ), carray ) - end subroutine insert_at_chararray_idx_wrap + end subroutine insert_at_chararray_idx !> Version: experimental !> !> Inserts stringarray 'sarray' AT stringlist_index 'idx' in stringlist 'list' !> Modifies the input stringlist 'list' - pure subroutine insert_at_stringarray_idx_wrap( list, idx, sarray ) + pure subroutine insert_at_stringarray_idx( list, idx, sarray ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx type(string_type), dimension(:), intent(in) :: sarray call list%insert_before( list%to_future_at_idxn( idx ), sarray ) - end subroutine insert_at_stringarray_idx_wrap + end subroutine insert_at_stringarray_idx !> Version: experimental !> @@ -643,7 +644,7 @@ end subroutine insert_before_engine !> !> Inserts string 'string' BEFORE integer index 'idxn' in the underlying stringarray !> Modifies the input stringlist 'list' - pure subroutine insert_before_string_int_impl( list, idxn, string ) + pure subroutine insert_before_string_int( list, idxn, string ) !> Not a part of public API class(stringlist_type), intent(inout) :: list integer, intent(in) :: idxn @@ -656,13 +657,13 @@ pure subroutine insert_before_string_int_impl( list, idxn, string ) list%stringarray(work_idxn) = string - end subroutine insert_before_string_int_impl + end subroutine insert_before_string_int !> Version: experimental !> !> Inserts stringlist 'slist' BEFORE integer index 'idxn' in the underlying stringarray !> Modifies the input stringlist 'list' - pure subroutine insert_before_stringlist_int_impl( list, idxn, slist ) + pure subroutine insert_before_stringlist_int( list, idxn, slist ) !> Not a part of public API class(stringlist_type), intent(inout) :: list integer, intent(in) :: idxn @@ -691,13 +692,13 @@ pure subroutine insert_before_stringlist_int_impl( list, idxn, slist ) end do end if - end subroutine insert_before_stringlist_int_impl + end subroutine insert_before_stringlist_int !> Version: experimental !> !> Inserts chararray 'carray' BEFORE integer index 'idxn' in the underlying stringarray !> Modifies the input stringlist 'list' - pure subroutine insert_before_chararray_int_impl( list, idxn, carray ) + pure subroutine insert_before_chararray_int( list, idxn, carray ) !> Not a part of public API class(stringlist_type), intent(inout) :: list integer, intent(in) :: idxn @@ -714,13 +715,13 @@ pure subroutine insert_before_chararray_int_impl( list, idxn, carray ) list%stringarray(idxnew) = string_type( carray(i) ) end do - end subroutine insert_before_chararray_int_impl + end subroutine insert_before_chararray_int !> Version: experimental !> !> Inserts stringarray 'sarray' BEFORE integer index 'idxn' in the underlying stringarray !> Modifies the input stringlist 'list' - pure subroutine insert_before_stringarray_int_impl( list, idxn, sarray ) + pure subroutine insert_before_stringarray_int( list, idxn, sarray ) !> Not a part of public API class(stringlist_type), intent(inout) :: list integer, intent(in) :: idxn @@ -737,7 +738,7 @@ pure subroutine insert_before_stringarray_int_impl( list, idxn, sarray ) list%stringarray(idxnew) = sarray(i) end do - end subroutine insert_before_stringarray_int_impl + end subroutine insert_before_stringarray_int ! get: @@ -777,35 +778,35 @@ end subroutine get_engine !> !> Returns the string present at stringlist_index 'idx' in stringlist 'list' !> Returns string_type instance - pure function get_idx_impl( list, idx ) + pure function get_idx( list, idx ) class(stringlist_type), intent(in) :: list type(stringlist_index_type), intent(in) :: idx - type(string_type) :: get_idx_impl + type(string_type) :: get_idx type(string_type), allocatable :: capture_strings(:) call get_engine( list, idx, idx, capture_strings ) ! if index 'idx' is out of bounds, returns an empty string if ( size(capture_strings) == 1 ) then - call move( capture_strings(1), get_idx_impl ) + call move( capture_strings(1), get_idx ) end if - end function get_idx_impl + end function get_idx !> Version: experimental !> !> Returns strings present at stringlist_indexes in interval ['first', 'last'] !> Returns array of string_type instances - pure function get_range_idx_impl( list, first, last ) + pure function get_range_idx( list, first, last ) class(stringlist_type), intent(in) :: list type(stringlist_index_type), intent(in) :: first, last - type(string_type), allocatable :: get_range_idx_impl(:) + type(string_type), allocatable :: get_range_idx(:) - call get_engine( list, first, last, get_range_idx_impl ) + call get_engine( list, first, last, get_range_idx ) - end function get_range_idx_impl + end function get_range_idx ! pop & drop: @@ -864,59 +865,59 @@ end subroutine pop_drop_engine !> !> Removes the string present at stringlist_index 'idx' in stringlist 'list' !> Returns the removed string - function pop_idx_impl( list, idx ) + function pop_idx( list, idx ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx - type(string_type) :: pop_idx_impl + type(string_type) :: pop_idx type(string_type), dimension(:), allocatable :: popped_strings call pop_drop_engine( list, idx, idx, popped_strings ) if ( size(popped_strings) == 1 ) then - call move( pop_idx_impl, popped_strings(1) ) + call move( pop_idx, popped_strings(1) ) end if - end function pop_idx_impl + end function pop_idx !> Version: experimental !> !> Removes strings present at stringlist_indexes in interval ['first', 'last'] !> in stringlist 'list' !> Returns removed strings - function pop_range_idx_impl( list, first, last ) + function pop_range_idx( list, first, last ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: first, last - type(string_type), dimension(:), allocatable :: pop_range_idx_impl + type(string_type), dimension(:), allocatable :: pop_range_idx - call pop_drop_engine( list, first, last, pop_range_idx_impl ) + call pop_drop_engine( list, first, last, pop_range_idx ) - end function pop_range_idx_impl + end function pop_range_idx !> Version: experimental !> !> Removes the string present at stringlist_index 'idx' in stringlist 'list' !> Doesn't return the removed string - pure subroutine drop_idx_impl( list, idx ) + pure subroutine drop_idx( list, idx ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx call pop_drop_engine( list, idx, idx ) - end subroutine drop_idx_impl + end subroutine drop_idx !> Version: experimental !> !> Removes strings present at stringlist_indexes in interval ['first', 'last'] !> in stringlist 'list' !> Doesn't return removed strings - pure subroutine drop_range_idx_impl( list, first, last ) + pure subroutine drop_range_idx( list, first, last ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: first, last call pop_drop_engine( list, first, last ) - end subroutine drop_range_idx_impl + end subroutine drop_range_idx end module stdlib_stringlist_type From 2b3a5efb51c78d4101f51055f870d8b6fd60288b Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Fri, 15 Oct 2021 16:42:24 +0530 Subject: [PATCH 19/22] some minor improvements --- src/stdlib_stringlist_type.f90 | 103 ++++++++++++++------------------- 1 file changed, 45 insertions(+), 58 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index f2f6dcbb4..65a20ff18 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -75,14 +75,14 @@ module stdlib_stringlist_type insert_at_chararray_idx, & insert_at_stringarray_idx - procedure :: insert_before_string_int - procedure :: insert_before_stringlist_int - procedure :: insert_before_chararray_int - procedure :: insert_before_stringarray_int - generic :: insert_before => insert_before_string_int, & - insert_before_stringlist_int, & - insert_before_chararray_int, & - insert_before_stringarray_int + procedure :: insert_before_string_idxn + procedure :: insert_before_stringlist_idxn + procedure :: insert_before_chararray_idxn + procedure :: insert_before_stringarray_idxn + generic :: insert_before => insert_before_string_idxn, & + insert_before_stringlist_idxn, & + insert_before_chararray_idxn, & + insert_before_stringarray_idxn procedure :: get_idx procedure :: get_range_idx @@ -218,7 +218,7 @@ end function backward_index !> Appends character scalar 'rhs' to the stringlist 'list' !> Returns a new stringlist - function append_char( lhs, rhs ) + pure function append_char( lhs, rhs ) type(stringlist_type), intent(in) :: lhs character(len=*), intent(in) :: rhs type(stringlist_type) :: append_char @@ -230,7 +230,7 @@ end function append_char !> Appends string 'rhs' to the stringlist 'list' !> Returns a new stringlist - function append_string( lhs, rhs ) + pure function append_string( lhs, rhs ) type(stringlist_type), intent(in) :: lhs type(string_type), intent(in) :: rhs type(stringlist_type) :: append_string @@ -242,7 +242,7 @@ end function append_string !> Prepends character scalar 'lhs' to the stringlist 'rhs' !> Returns a new stringlist - function prepend_char( lhs, rhs ) + pure function prepend_char( lhs, rhs ) character(len=*), intent(in) :: lhs type(stringlist_type), intent(in) :: rhs type(stringlist_type) :: prepend_char @@ -254,7 +254,7 @@ end function prepend_char !> Prepends string 'lhs' to the stringlist 'rhs' !> Returns a new stringlist - function prepend_string( lhs, rhs ) + pure function prepend_string( lhs, rhs ) type(string_type), intent(in) :: lhs type(stringlist_type), intent(in) :: rhs type(stringlist_type) :: prepend_string @@ -266,7 +266,7 @@ end function prepend_string !> Appends stringlist 'rhs' to the stringlist 'lhs' !> Returns a new stringlist - function append_stringlist( lhs, rhs ) + pure function append_stringlist( lhs, rhs ) type(stringlist_type), intent(in) :: lhs type(stringlist_type), intent(in) :: rhs type(stringlist_type) :: append_stringlist @@ -278,7 +278,7 @@ end function append_stringlist !> Appends chararray 'rhs' to the stringlist 'lhs' !> Returns a new stringlist - function append_carray( lhs, rhs ) + pure function append_carray( lhs, rhs ) type(stringlist_type), intent(in) :: lhs character(len=*), dimension(:), intent(in) :: rhs type(stringlist_type) :: append_carray @@ -290,7 +290,7 @@ end function append_carray !> Appends stringarray 'rhs' to the stringlist 'lhs' !> Returns a new stringlist - function append_sarray( lhs, rhs ) + pure function append_sarray( lhs, rhs ) type(stringlist_type), intent(in) :: lhs type(string_type), dimension(:), intent(in) :: rhs type(stringlist_type) :: append_sarray @@ -302,7 +302,7 @@ end function append_sarray !> Prepends chararray 'lhs' to the stringlist 'rhs' !> Returns a new stringlist - function prepend_carray( lhs, rhs ) + pure function prepend_carray( lhs, rhs ) character(len=*), dimension(:), intent(in) :: lhs type(stringlist_type), intent(in) :: rhs type(stringlist_type) :: prepend_carray @@ -314,7 +314,7 @@ end function prepend_carray !> Prepends stringarray 'lhs' to the stringlist 'rhs' !> Returns a new stringlist - function prepend_sarray( lhs, rhs ) + pure function prepend_sarray( lhs, rhs ) type(string_type), dimension(:), intent(in) :: lhs type(stringlist_type), intent(in) :: rhs type(stringlist_type) :: prepend_sarray @@ -458,21 +458,6 @@ pure logical function ineq_sarray_stringlist( lhs, rhs ) end function ineq_sarray_stringlist - ! Version: experimental - !> - !> Shifts a stringlist_index by integer 'shift_by' - !> Returns the shifted stringlist_index - pure function shift( idx, shift_by ) - !> Not a part of public API - type(stringlist_index_type), intent(in) :: idx - integer, intent(in) :: shift_by - - type(stringlist_index_type) :: shift - - shift = merge( fidx( idx%offset + shift_by ), bidx( idx%offset + shift_by ), idx%forward ) - - end function shift - ! clear: !> Version: experimental @@ -525,7 +510,7 @@ end function to_future_at_idxn !> Version: experimental !> - !> Converts a forward index OR backward index to its equivalent integer index idxn + !> Converts a forward index OR backward index to its equivalent integer index !> Returns an integer pure integer function to_current_idxn( list, idx ) !> Not a part of public API @@ -644,7 +629,7 @@ end subroutine insert_before_engine !> !> Inserts string 'string' BEFORE integer index 'idxn' in the underlying stringarray !> Modifies the input stringlist 'list' - pure subroutine insert_before_string_int( list, idxn, string ) + pure subroutine insert_before_string_idxn( list, idxn, string ) !> Not a part of public API class(stringlist_type), intent(inout) :: list integer, intent(in) :: idxn @@ -657,13 +642,13 @@ pure subroutine insert_before_string_int( list, idxn, string ) list%stringarray(work_idxn) = string - end subroutine insert_before_string_int + end subroutine insert_before_string_idxn !> Version: experimental !> !> Inserts stringlist 'slist' BEFORE integer index 'idxn' in the underlying stringarray !> Modifies the input stringlist 'list' - pure subroutine insert_before_stringlist_int( list, idxn, slist ) + pure subroutine insert_before_stringlist_idxn( list, idxn, slist ) !> Not a part of public API class(stringlist_type), intent(inout) :: list integer, intent(in) :: idxn @@ -675,9 +660,9 @@ pure subroutine insert_before_stringlist_int( list, idxn, slist ) pre_length = slist%len() if (pre_length > 0) then - work_idxn = idxn + work_idxn = idxn - call insert_before_empty_positions( list, work_idxn, pre_length ) + call insert_before_engine( list, work_idxn, pre_length ) post_length = slist%len() inew = work_idxn @@ -692,53 +677,53 @@ pure subroutine insert_before_stringlist_int( list, idxn, slist ) end do end if - end subroutine insert_before_stringlist_int + end subroutine insert_before_stringlist_idxn !> Version: experimental !> !> Inserts chararray 'carray' BEFORE integer index 'idxn' in the underlying stringarray !> Modifies the input stringlist 'list' - pure subroutine insert_before_chararray_int( list, idxn, carray ) + pure subroutine insert_before_chararray_idxn( list, idxn, carray ) !> Not a part of public API class(stringlist_type), intent(inout) :: list integer, intent(in) :: idxn character(len=*), dimension(:), intent(in) :: carray - integer :: i - integer :: work_idxn, idxnew + integer :: i, inew + integer :: work_idxn work_idxn = idxn call insert_before_engine( list, work_idxn, size( carray ) ) do i = 1, size( carray ) - idxnew = work_idxn + i - 1 - list%stringarray(idxnew) = string_type( carray(i) ) + inew = work_idxn + i - 1 + list%stringarray(inew) = string_type( carray(i) ) end do - end subroutine insert_before_chararray_int + end subroutine insert_before_chararray_idxn !> Version: experimental !> !> Inserts stringarray 'sarray' BEFORE integer index 'idxn' in the underlying stringarray !> Modifies the input stringlist 'list' - pure subroutine insert_before_stringarray_int( list, idxn, sarray ) + pure subroutine insert_before_stringarray_idxn( list, idxn, sarray ) !> Not a part of public API class(stringlist_type), intent(inout) :: list integer, intent(in) :: idxn type(string_type), dimension(:), intent(in) :: sarray - integer :: i - integer :: work_idxn, idxnew + integer :: i, inew + integer :: work_idxn work_idxn = idxn call insert_before_engine( list, work_idxn, size( sarray ) ) do i = 1, size( sarray ) - idxnew = work_idxn + i - 1 - list%stringarray(idxnew) = sarray(i) + inew = work_idxn + i - 1 + list%stringarray(inew) = sarray(i) end do - end subroutine insert_before_stringarray_int + end subroutine insert_before_stringarray_idxn ! get: @@ -820,15 +805,13 @@ pure subroutine pop_drop_engine( list, first, last, popped_strings ) type(stringlist_index_type), intent(in) :: first, last type(string_type), allocatable, intent(out), optional :: popped_strings(:) - integer :: firstn, lastn, from, to + integer :: from, to integer :: i, inew, pos, old_len, new_len type(string_type), dimension(:), allocatable :: new_stringarray old_len = list%len() - firstn = list%to_current_idxn( first ) - lastn = list%to_current_idxn( last ) - from = max( firstn, 1 ) - to = min( lastn, old_len ) + from = max( list%to_current_idxn( first ), 1 ) + to = min( list%to_current_idxn( last ), old_len ) ! out of bounds indexes won't modify stringlist if ( from <= to ) then @@ -842,8 +825,12 @@ pure subroutine pop_drop_engine( list, first, last, popped_strings ) ! capture popped strings if ( present(popped_strings) ) then - call get_engine( list, shift( first, from - firstn ), & - & shift( last, lastn - to ), popped_strings ) + allocate( popped_strings(pos) ) + inew = 1 + do i = from, to + call move( list%stringarray(i), popped_strings(inew) ) + inew = inew + 1 + end do end if inew = from From 29f988024b88fd658eba2080ac0b9026a21fec66 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sat, 25 Dec 2021 23:30:35 +0530 Subject: [PATCH 20/22] Minor refactoring --- src/stdlib_stringlist_type.f90 | 64 +++++++++++++++++++--------------- 1 file changed, 36 insertions(+), 28 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index 65a20ff18..cba128f0a 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -168,16 +168,16 @@ end function new_stringlist !> Constructor to convert chararray to stringlist !> Returns a new instance of type stringlist - pure function new_stringlist_carray( array ) - character(len=*), dimension(:), intent(in) :: array + pure function new_stringlist_carray( carray ) + character(len=*), dimension(:), intent(in) :: carray type(stringlist_type) :: new_stringlist_carray - type(string_type), allocatable :: sarray(:) + type(string_type), dimension(:), allocatable :: sarray integer :: i - allocate( sarray( size(array) ) ) - do i = 1, size(array) - sarray(i) = string_type( array(i) ) + allocate( sarray( size(carray) ) ) + do i = 1, size(carray) + sarray(i) = string_type( carray(i) ) end do call move_alloc( sarray, new_stringlist_carray%stringarray ) @@ -186,31 +186,31 @@ end function new_stringlist_carray !> Constructor to convert stringarray to stringlist !> Returns a new instance of type stringlist - pure function new_stringlist_sarray( array ) - type(string_type), dimension(:), intent(in) :: array + pure function new_stringlist_sarray( sarray ) + type(string_type), dimension(:), intent(in) :: sarray type(stringlist_type) :: new_stringlist_sarray - new_stringlist_sarray%stringarray = array + new_stringlist_sarray%stringarray = sarray end function new_stringlist_sarray ! constructor for stringlist_index_type: - !> Returns an instance of type 'stringlist_index_type' representing forward index 'idx' - pure function forward_index( idx ) - integer, intent(in) :: idx + !> Returns an instance of type 'stringlist_index_type' representing forward index 'idxn' + pure function forward_index( idxn ) + integer, intent(in) :: idxn type(stringlist_index_type) :: forward_index - forward_index = stringlist_index_type( .true., idx ) + forward_index = stringlist_index_type( .true., idxn ) end function forward_index - !> Returns an instance of type 'stringlist_index_type' representing backward index 'idx' - pure function backward_index( idx ) - integer, intent(in) :: idx + !> Returns an instance of type 'stringlist_index_type' representing backward index 'idxn' + pure function backward_index( idxn ) + integer, intent(in) :: idxn type(stringlist_index_type) :: backward_index - backward_index = stringlist_index_type( .false., idx ) + backward_index = stringlist_index_type( .false., idxn ) end function backward_index @@ -695,9 +695,10 @@ pure subroutine insert_before_chararray_idxn( list, idxn, carray ) work_idxn = idxn call insert_before_engine( list, work_idxn, size( carray ) ) + inew = work_idxn do i = 1, size( carray ) - inew = work_idxn + i - 1 list%stringarray(inew) = string_type( carray(i) ) + inew = inew + 1 end do end subroutine insert_before_chararray_idxn @@ -718,9 +719,10 @@ pure subroutine insert_before_stringarray_idxn( list, idxn, sarray ) work_idxn = idxn call insert_before_engine( list, work_idxn, size( sarray ) ) + inew = work_idxn do i = 1, size( sarray ) - inew = work_idxn + i - 1 list%stringarray(inew) = sarray(i) + inew = inew + 1 end do end subroutine insert_before_stringarray_idxn @@ -729,19 +731,19 @@ end subroutine insert_before_stringarray_idxn !> Version: experimental !> - !> Returns strings present at stringlist_indexes in interval ['first', 'last'] + !> Returns strings present at integer indexes in interval ['firstn', 'lastn'] !> Stores requested strings in array 'capture_strings' !> No return - pure subroutine get_engine( list, first, last, capture_strings ) + pure subroutine get_engine( list, firstn, lastn, capture_strings ) type(stringlist_type), intent(in) :: list - type(stringlist_index_type), intent(in) :: first, last + integer, intent(in) :: firstn, lastn type(string_type), allocatable, intent(out) :: capture_strings(:) integer :: from, to integer :: i, inew - from = max( list%to_current_idxn( first ), 1 ) - to = min( list%to_current_idxn( last ), list%len() ) + from = max( firstn, 1 ) + to = min( lastn, list%len() ) ! out of bounds indexes won't be captured in 'capture_strings' if ( from <= to ) then @@ -766,11 +768,13 @@ end subroutine get_engine pure function get_idx( list, idx ) class(stringlist_type), intent(in) :: list type(stringlist_index_type), intent(in) :: idx - type(string_type) :: get_idx + + integer :: idxn type(string_type), allocatable :: capture_strings(:) - call get_engine( list, idx, idx, capture_strings ) + idxn = list%to_current_idxn( idx ) + call get_engine( list, idxn, idxn, capture_strings ) ! if index 'idx' is out of bounds, returns an empty string if ( size(capture_strings) == 1 ) then @@ -786,10 +790,14 @@ end function get_idx pure function get_range_idx( list, first, last ) class(stringlist_type), intent(in) :: list type(stringlist_index_type), intent(in) :: first, last - type(string_type), allocatable :: get_range_idx(:) - call get_engine( list, first, last, get_range_idx ) + integer :: firstn, lastn + + firstn = list%to_current_idxn( first ) + lastn = list%to_current_idxn( last ) + + call get_engine( list, firstn, lastn, get_range_idx ) end function get_range_idx From 207c1fbe3dd3d739d529b09466d6d076ed64fdb2 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sun, 26 Dec 2021 20:57:58 +0530 Subject: [PATCH 21/22] Add strides feature to get function get_engine func takes an integer stride_vector which decides the number of strides to take between indexes. get_range_idx func takes stride of type stringlist_index_type: fidx(+3) means takes +3 as stride (jump 3 indexes to right) fidx(-3) means takes -3 as stride (jump 3 indexes to left) bidx(+3) means takes -3 as stride (jump 3 indexes to left) bidx(-3) means takes +3 as stride (jump 3 indexes to right) --- src/stdlib_stringlist_type.f90 | 88 +++++++++++++++++++++------------- 1 file changed, 56 insertions(+), 32 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index cba128f0a..4c45b0573 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -734,31 +734,34 @@ end subroutine insert_before_stringarray_idxn !> Returns strings present at integer indexes in interval ['firstn', 'lastn'] !> Stores requested strings in array 'capture_strings' !> No return - pure subroutine get_engine( list, firstn, lastn, capture_strings ) + pure subroutine get_engine( list, firstn, lastn, stride_vector, capture_strings ) type(stringlist_type), intent(in) :: list - integer, intent(in) :: firstn, lastn + integer, intent(in) :: firstn, lastn, stride_vector type(string_type), allocatable, intent(out) :: capture_strings(:) - integer :: from, to + integer :: from, to, strides_taken integer :: i, inew - from = max( firstn, 1 ) - to = min( lastn, list%len() ) - - ! out of bounds indexes won't be captured in 'capture_strings' - if ( from <= to ) then - allocate( capture_strings( to - from + 1 ) ) - - inew = 1 - do i = from, to - capture_strings(inew) = list%stringarray(i) - inew = inew + 1 - end do - + if (stride_vector > 0) then + from = max( firstn, 1 ) + to = min( lastn, list%len() ) + else if (stride_vector < 0) then + from = min( firstn, list%len() ) + to = max( lastn, 1 ) else allocate( capture_strings(0) ) + stop end if + strides_taken = floor( real(to - from) / real(stride_vector) ) + allocate( capture_strings( max(0, strides_taken + 1) ) ) + + inew = 1 + do i = from, to, stride_vector + capture_strings(inew) = list%stringarray(i) + inew = inew + 1 + end do + end subroutine get_engine !> Version: experimental @@ -774,7 +777,7 @@ pure function get_idx( list, idx ) type(string_type), allocatable :: capture_strings(:) idxn = list%to_current_idxn( idx ) - call get_engine( list, idxn, idxn, capture_strings ) + call get_engine( list, idxn, idxn, 1, capture_strings ) ! if index 'idx' is out of bounds, returns an empty string if ( size(capture_strings) == 1 ) then @@ -787,17 +790,24 @@ end function get_idx !> !> Returns strings present at stringlist_indexes in interval ['first', 'last'] !> Returns array of string_type instances - pure function get_range_idx( list, first, last ) + pure function get_range_idx( list, first, last, stride ) class(stringlist_type), intent(in) :: list type(stringlist_index_type), intent(in) :: first, last + type(stringlist_index_type), intent(in), optional :: stride type(string_type), allocatable :: get_range_idx(:) - integer :: firstn, lastn + integer :: firstn, lastn, stride_vector firstn = list%to_current_idxn( first ) lastn = list%to_current_idxn( last ) - call get_engine( list, firstn, lastn, get_range_idx ) + if ( present(stride) ) then + stride_vector = merge( stride%offset, -1 * stride%offset, stride%forward ) + else + stride_vector = merge( 1, -1, firstn <= lastn ) + end if + + call get_engine( list, firstn, lastn, stride_vector, get_range_idx ) end function get_range_idx @@ -805,12 +815,12 @@ end function get_range_idx !> Version: experimental !> - !> Removes strings present at indexes in interval ['first', 'last'] + !> Removes strings present at integer indexes in interval ['firstn', 'lastn'] !> Stores popped strings in array 'popped_strings' !> No return - pure subroutine pop_drop_engine( list, first, last, popped_strings ) + pure subroutine pop_drop_engine( list, firstn, lastn, popped_strings ) class(stringlist_type), intent(inout) :: list - type(stringlist_index_type), intent(in) :: first, last + integer, intent(in) :: firstn, lastn type(string_type), allocatable, intent(out), optional :: popped_strings(:) integer :: from, to @@ -818,9 +828,9 @@ pure subroutine pop_drop_engine( list, first, last, popped_strings ) type(string_type), dimension(:), allocatable :: new_stringarray old_len = list%len() - from = max( list%to_current_idxn( first ), 1 ) - to = min( list%to_current_idxn( last ), old_len ) - + from = max( firstn, 1 ) + to = min( lastn, old_len ) + ! out of bounds indexes won't modify stringlist if ( from <= to ) then pos = to - from + 1 @@ -860,14 +870,16 @@ end subroutine pop_drop_engine !> !> Removes the string present at stringlist_index 'idx' in stringlist 'list' !> Returns the removed string - function pop_idx( list, idx ) + impure function pop_idx( list, idx ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx type(string_type) :: pop_idx + integer :: idxn type(string_type), dimension(:), allocatable :: popped_strings - call pop_drop_engine( list, idx, idx, popped_strings ) + idxn = list%to_current_idxn( idx ) + call pop_drop_engine( list, idxn, idxn, popped_strings ) if ( size(popped_strings) == 1 ) then call move( pop_idx, popped_strings(1) ) @@ -880,13 +892,17 @@ end function pop_idx !> Removes strings present at stringlist_indexes in interval ['first', 'last'] !> in stringlist 'list' !> Returns removed strings - function pop_range_idx( list, first, last ) + impure function pop_range_idx( list, first, last ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: first, last + integer :: firstn, lastn type(string_type), dimension(:), allocatable :: pop_range_idx - call pop_drop_engine( list, first, last, pop_range_idx ) + firstn = list%to_current_idxn( first ) + lastn = list%to_current_idxn( last ) + + call pop_drop_engine( list, firstn, lastn, pop_range_idx ) end function pop_range_idx @@ -898,7 +914,10 @@ pure subroutine drop_idx( list, idx ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: idx - call pop_drop_engine( list, idx, idx ) + integer :: idxn + + idxn = list%to_current_idxn( idx ) + call pop_drop_engine( list, idxn, idxn ) end subroutine drop_idx @@ -911,7 +930,12 @@ pure subroutine drop_range_idx( list, first, last ) class(stringlist_type), intent(inout) :: list type(stringlist_index_type), intent(in) :: first, last - call pop_drop_engine( list, first, last ) + integer :: firstn, lastn + + firstn = list%to_current_idxn( first ) + lastn = list%to_current_idxn( last ) + + call pop_drop_engine( list, firstn, lastn ) end subroutine drop_range_idx From e6b6143f01a507cefbaa603a46063415fd30fd07 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Tue, 28 Dec 2021 22:29:02 +0530 Subject: [PATCH 22/22] Add get_impl interface in the middle get_impl comes in the middle of get_engine and get_idx routines This allows to get i-th element inside the module using integer indexes --- src/stdlib_stringlist_type.f90 | 77 +++++++++++++++++++++++++++------- 1 file changed, 63 insertions(+), 14 deletions(-) diff --git a/src/stdlib_stringlist_type.f90 b/src/stdlib_stringlist_type.f90 index 4c45b0573..ce7995cb9 100644 --- a/src/stdlib_stringlist_type.f90 +++ b/src/stdlib_stringlist_type.f90 @@ -88,6 +88,11 @@ module stdlib_stringlist_type procedure :: get_range_idx generic, public :: get => get_idx, & get_range_idx + + procedure :: get_impl_idxn + procedure :: get_impl_range_idxn + generic :: get_impl => get_impl_idxn, & + get_impl_range_idxn procedure :: pop_idx procedure :: pop_range_idx @@ -729,12 +734,28 @@ end subroutine insert_before_stringarray_idxn ! get: + !> Version: experimental + !> + !> Returns strings present at integer indexe idxn + !> Stores requested string in 'capture_string' + !> No return + pure subroutine get_idxn_engine( list, idxn, capture_string ) + type(stringlist_type), intent(in) :: list + integer, intent(in) :: idxn + type(string_type), intent(out) :: capture_string + + if ( 1 <= idxn .and. idxn <= list%len() ) then + capture_string = list%stringarray(idxn) + end if + + end subroutine get_idxn_engine + !> Version: experimental !> !> Returns strings present at integer indexes in interval ['firstn', 'lastn'] !> Stores requested strings in array 'capture_strings' !> No return - pure subroutine get_engine( list, firstn, lastn, stride_vector, capture_strings ) + pure subroutine get_range_engine( list, firstn, lastn, stride_vector, capture_strings ) type(stringlist_type), intent(in) :: list integer, intent(in) :: firstn, lastn, stride_vector type(string_type), allocatable, intent(out) :: capture_strings(:) @@ -762,7 +783,44 @@ pure subroutine get_engine( list, firstn, lastn, stride_vector, capture_strings inew = inew + 1 end do - end subroutine get_engine + end subroutine get_range_engine + + !> Version: experimental + !> + !> Returns the string present at integer index 'idxn' in stringlist 'list' + !> Stores requested string in 'capture_string' + !> No return + pure subroutine get_impl_idxn( list, idxn, capture_string ) + class(stringlist_type), intent(in) :: list + integer, intent(in) :: idxn + type(string_type), intent(out) :: capture_string + + call get_idxn_engine( list, idxn, capture_string ) + + end subroutine get_impl_idxn + + !> Version: experimental + !> + !> Returns strings present at integer indexes in interval ['firstn', 'lastn'] + !> Stores requested strings in 'capture_strings' + !> No return + pure subroutine get_impl_range_idxn( list, firstn, lastn, stride_vector, capture_strings ) + class(stringlist_type), intent(in) :: list + integer, intent(in) :: firstn, lastn + integer, intent(in), optional :: stride_vector + type(string_type), allocatable, intent(out) :: capture_strings(:) + + integer :: stride_vector_mod + + if ( present(stride_vector) ) then + stride_vector_mod = stride_vector + else + stride_vector_mod = merge( 1, -1, firstn <= lastn ) + end if + + call get_range_engine( list, firstn, lastn, stride_vector_mod, capture_strings ) + + end subroutine get_impl_range_idxn !> Version: experimental !> @@ -773,19 +831,10 @@ pure function get_idx( list, idx ) type(stringlist_index_type), intent(in) :: idx type(string_type) :: get_idx - integer :: idxn - type(string_type), allocatable :: capture_strings(:) - - idxn = list%to_current_idxn( idx ) - call get_engine( list, idxn, idxn, 1, capture_strings ) - - ! if index 'idx' is out of bounds, returns an empty string - if ( size(capture_strings) == 1 ) then - call move( capture_strings(1), get_idx ) - end if + call list%get_impl( list%to_current_idxn( idx ), get_idx ) end function get_idx - + !> Version: experimental !> !> Returns strings present at stringlist_indexes in interval ['first', 'last'] @@ -807,7 +856,7 @@ pure function get_range_idx( list, first, last, stride ) stride_vector = merge( 1, -1, firstn <= lastn ) end if - call get_engine( list, firstn, lastn, stride_vector, get_range_idx ) + call list%get_impl( firstn, lastn, stride_vector, get_range_idx ) end function get_range_idx pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy