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