diff --git a/doc/specs/stdlib_stringlist_type.md b/doc/specs/stdlib_stringlist_type.md
index 88dc6521a..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'(a)', 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'(a)', 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
```
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 78cfb69d3..ce7995cb9 100644
--- a/src/stdlib_stringlist_type.f90
+++ b/src/stdlib_stringlist_type.f90
@@ -11,11 +11,11 @@
! 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(/=)
+ use stdlib_string_type, only: string_type, operator(/=), move
use stdlib_math, only: clip
implicit none
private
@@ -60,32 +60,49 @@ 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
- generic, public :: insert_at => insert_at_char_idx, &
- insert_at_string_idx, &
- insert_at_stringlist_idx, &
- insert_at_chararray_idx, &
+ 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
- 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
+ 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
+ generic, public :: pop => pop_idx, &
+ pop_range_idx
- procedure :: get_string_idx => get_string_idx_wrap
- generic, public :: get => get_string_idx
+ procedure :: drop_idx
+ procedure :: drop_range_idx
+ generic, public :: drop => drop_idx, &
+ drop_range_idx
end type stringlist_type
@@ -156,48 +173,49 @@ 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), dimension( size(array) ) :: sarray
+
+ type(string_type), dimension(:), allocatable :: sarray
integer :: i
- 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
- new_stringlist_carray = stringlist_type( sarray )
+ call move_alloc( sarray, new_stringlist_carray%stringarray )
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 = stringlist_type()
- 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
@@ -205,18 +223,19 @@ 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
- 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
!> 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
@@ -228,18 +247,19 @@ 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
- 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
!> 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
@@ -251,7 +271,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
@@ -263,7 +283,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
@@ -275,7 +295,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
@@ -287,7 +307,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
@@ -299,7 +319,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
@@ -449,7 +469,7 @@ end function ineq_sarray_stringlist
!>
!> 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
@@ -481,31 +501,31 @@ 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:
!> 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 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:
@@ -513,74 +533,74 @@ 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( 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'
- 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'
- 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'
- 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'
- 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
!>
!> Inserts 'positions' number of empty positions BEFORE integer index 'idxn'
!> Modifies the input stringlist 'list'
- subroutine insert_before_empty_positions( list, idxn, positions )
+ pure 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
@@ -597,26 +617,24 @@ 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 )
end if
- end subroutine insert_before_empty_positions
+ end subroutine insert_before_engine
!> Version: experimental
!>
!> 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_idxn( list, idxn, string )
!> Not a part of public API
class(stringlist_type), intent(inout) :: list
integer, intent(in) :: idxn
@@ -625,111 +643,349 @@ 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
- end subroutine insert_before_string_int_impl
+ end subroutine insert_before_string_idxn
!> Version: experimental
!>
!> 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_idxn( list, idxn, slist )
!> Not a part of public API
class(stringlist_type), intent(inout) :: list
integer, intent(in) :: idxn
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
- end subroutine insert_before_stringlist_int_impl
+ 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_idxn
!> Version: experimental
!>
!> 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_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_empty_positions( list, work_idxn, size( carray ) )
+ call insert_before_engine( list, work_idxn, size( carray ) )
+ inew = work_idxn
do i = 1, size( carray )
- idxnew = work_idxn + i - 1
- list%stringarray(idxnew) = string_type( carray(i) )
+ list%stringarray(inew) = string_type( carray(i) )
+ inew = inew + 1
end do
- end subroutine insert_before_chararray_int_impl
+ end subroutine insert_before_chararray_idxn
!> Version: experimental
!>
!> 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_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_empty_positions( list, work_idxn, size( sarray ) )
+ call insert_before_engine( list, work_idxn, size( sarray ) )
+ inew = work_idxn
do i = 1, size( sarray )
- idxnew = work_idxn + i - 1
- list%stringarray(idxnew) = sarray(i)
+ list%stringarray(inew) = sarray(i)
+ inew = inew + 1
end do
- end subroutine insert_before_stringarray_int_impl
+ 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_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(:)
+
+ integer :: from, to, strides_taken
+ integer :: i, inew
+
+ 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_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
!>
!> Returns the string present at stringlist_index 'idx' in stringlist 'list'
!> Returns string_type instance
- pure function get_string_idx_wrap( list, idx )
- class(stringlist_type), intent(in) :: list
- type(stringlist_index_type), intent(in) :: idx
- type(string_type) :: get_string_idx_wrap
+ 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
+ call list%get_impl( list%to_current_idxn( idx ), get_idx )
- idxn = list%to_current_idxn( idx )
+ 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( 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, stride_vector
+
+ firstn = list%to_current_idxn( first )
+ lastn = list%to_current_idxn( last )
+
+ if ( present(stride) ) then
+ stride_vector = merge( stride%offset, -1 * stride%offset, stride%forward )
+ else
+ stride_vector = merge( 1, -1, firstn <= lastn )
+ end if
- ! if the index is out of bounds, return a string_type equivalent to empty string
- if ( 1 <= idxn .and. idxn <= list%len() ) then
- get_string_idx_wrap = list%stringarray(idxn)
+ call list%get_impl( firstn, lastn, stride_vector, get_range_idx )
+
+ end function get_range_idx
+ ! pop & drop:
+
+ !> Version: experimental
+ !>
+ !> 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, firstn, lastn, popped_strings )
+ class(stringlist_type), intent(inout) :: list
+ integer, intent(in) :: firstn, lastn
+ type(string_type), allocatable, intent(out), optional :: popped_strings(:)
+
+ integer :: from, to
+ integer :: i, inew, pos, old_len, new_len
+ type(string_type), dimension(:), allocatable :: new_stringarray
+
+ old_len = list%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
+ new_len = old_len - pos
+
+ allocate( new_stringarray(new_len) )
+ do i = 1, from - 1
+ call move( list%stringarray(i), new_stringarray(i) )
+ end do
+
+ ! capture popped strings
+ if ( present(popped_strings) ) then
+ 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
+ do i = to + 1, old_len
+ call move( list%stringarray(i), new_stringarray(inew) )
+ inew = inew + 1
+ end do
+
+ call move_alloc( new_stringarray, list%stringarray )
+ else
+ if ( present(popped_strings) ) then
+ allocate( popped_strings(0) )
+ end if
+ end if
+
+ end subroutine pop_drop_engine
+
+ !> Version: experimental
+ !>
+ !> Removes the string present at stringlist_index 'idx' in stringlist 'list'
+ !> Returns the removed string
+ 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
+
+ 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) )
end if
- end function get_string_idx_wrap
+ end function pop_idx
+
+ !> Version: experimental
+ !>
+ !> Removes strings present at stringlist_indexes in interval ['first', 'last']
+ !> in stringlist 'list'
+ !> Returns removed strings
+ 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
+
+ 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
+
+ !> Version: experimental
+ !>
+ !> Removes the string present at stringlist_index 'idx' in stringlist 'list'
+ !> Doesn't return the removed string
+ pure subroutine drop_idx( list, idx )
+ class(stringlist_type), intent(inout) :: list
+ type(stringlist_index_type), intent(in) :: idx
+
+ integer :: idxn
+
+ idxn = list%to_current_idxn( idx )
+ call pop_drop_engine( list, idxn, idxn )
+
+ 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( list, first, last )
+ class(stringlist_type), intent(inout) :: list
+ type(stringlist_index_type), intent(in) :: 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
end module stdlib_stringlist_type
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