Skip to content

Commit 88a1abb

Browse files
aman-godaraaman-godara
committed
added range feature for get, added shift function
1 parent f60dd9e commit 88a1abb

File tree

1 file changed

+114
-56
lines changed

1 file changed

+114
-56
lines changed

‎src/stdlib_stringlist_type.f90

Lines changed: 114 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -84,18 +84,20 @@ module stdlib_stringlist_type
8484
insert_before_chararray_int, &
8585
insert_before_stringarray_int
8686

87-
procedure :: get_string_idx => get_string_idx_impl
88-
generic, public :: get => get_string_idx
87+
procedure :: get_idx => get_idx_impl
88+
procedure :: get_range_idx => get_range_idx_impl
89+
generic, public :: get => get_idx, &
90+
get_range_idx
8991

90-
procedure :: pop_idx => pop_idx_impl
91-
procedure :: pop_range_idx => pop_range_idx_impl
92-
generic, public :: pop => pop_idx, &
93-
pop_range_idx
92+
procedure :: pop_idx => pop_idx_impl
93+
procedure :: pop_range_idx => pop_range_idx_impl
94+
generic, public :: pop => pop_idx, &
95+
pop_range_idx
9496

95-
procedure :: drop_idx => drop_idx_impl
96-
procedure :: drop_range_idx => drop_range_idx_impl
97-
generic, public :: drop => drop_idx, &
98-
drop_range_idx
97+
procedure :: drop_idx => drop_idx_impl
98+
procedure :: drop_range_idx => drop_range_idx_impl
99+
generic, public :: drop => drop_idx, &
100+
drop_range_idx
99101

100102
end type stringlist_type
101103

@@ -453,6 +455,21 @@ pure logical function ineq_sarray_stringlist( lhs, rhs )
453455

454456
end function ineq_sarray_stringlist
455457

458+
! Version: experimental
459+
!>
460+
!> Shifts a stringlist_index by integer 'shift_by'
461+
!> Returns the shifted stringlist_index
462+
pure function shift( idx, shift_by )
463+
!> Not a part of public API
464+
type(stringlist_index_type), intent(in) :: idx
465+
integer, intent(in) :: shift_by
466+
467+
type(stringlist_index_type), intent(in) :: shift
468+
469+
shift = merge( fidx( idx%offset + shift_by ), bidx( idx%offset + shift_by ), idx%forward )
470+
471+
end function shift
472+
456473
! clear:
457474

458475
!> Version: experimental
@@ -588,7 +605,7 @@ end subroutine insert_at_stringarray_idx_wrap
588605
!>
589606
!> Inserts 'positions' number of empty positions BEFORE integer index 'idxn'
590607
!> Modifies the input stringlist 'list'
591-
subroutine insert_before_empty_positions( list, idxn, positions )
608+
subroutine insert_before_engine( list, idxn, positions )
592609
!> Not a part of public API
593610
class(stringlist_type), intent(inout) :: list
594611
integer, intent(inout) :: idxn
@@ -618,7 +635,7 @@ subroutine insert_before_empty_positions( list, idxn, positions )
618635

619636
end if
620637

621-
end subroutine insert_before_empty_positions
638+
end subroutine insert_before_engine
622639

623640
!> Version: experimental
624641
!>
@@ -633,7 +650,7 @@ subroutine insert_before_string_int_impl( list, idxn, string )
633650
integer :: work_idxn
634651

635652
work_idxn = idxn
636-
call insert_before_empty_positions( list, work_idxn, 1 )
653+
call insert_before_engine( list, work_idxn, 1 )
637654

638655
list%stringarray(work_idxn) = string
639656

@@ -688,7 +705,7 @@ subroutine insert_before_chararray_int_impl( list, idxn, carray )
688705
integer :: work_idxn, idxnew
689706

690707
work_idxn = idxn
691-
call insert_before_empty_positions( list, work_idxn, size( carray ) )
708+
call insert_before_engine( list, work_idxn, size( carray ) )
692709

693710
do i = 1, size( carray )
694711
idxnew = work_idxn + i - 1
@@ -711,7 +728,7 @@ subroutine insert_before_stringarray_int_impl( list, idxn, sarray )
711728
integer :: work_idxn, idxnew
712729

713730
work_idxn = idxn
714-
call insert_before_empty_positions( list, work_idxn, size( sarray ) )
731+
call insert_before_engine( list, work_idxn, size( sarray ) )
715732

716733
do i = 1, size( sarray )
717734
idxnew = work_idxn + i - 1
@@ -722,68 +739,113 @@ end subroutine insert_before_stringarray_int_impl
722739

723740
! get:
724741

742+
!> Version: experimental
743+
!>
744+
!> Returns strings present at stringlist_indexes in interval ['first', 'last']
745+
!> Stores requested strings in array 'capture_strings'
746+
!> No return
747+
subroutine get_engine( list, first, last, capture_strings )
748+
class(stringlist_type) :: list
749+
type(stringlist_index_type), intent(in) :: first, last
750+
type(string_type), allocatable, intent(out) :: capture_strings(:)
751+
752+
integer :: from, to
753+
integer :: i, inew
754+
755+
from = max( list%to_current_idxn( first ), 1 )
756+
to = min( list%to_current_idxn( last ), list%len() )
757+
758+
! out of bounds indexes won't be captured in capture_strings
759+
if ( from <= to ) then
760+
pos = to - from + 1
761+
allocate( capture_strings(pos) )
762+
763+
inew = 1
764+
do i = from, to
765+
capture_strings(inew) = list%stringarray(i)
766+
inew = inew + 1
767+
end do
768+
769+
else
770+
allocate( capture_strings(0) )
771+
end if
772+
773+
end subroutine get_engine
774+
725775
!> Version: experimental
726776
!>
727777
!> Returns the string present at stringlist_index 'idx' in stringlist 'list'
728778
!> Returns string_type instance
729-
pure function get_string_idx_impl( list, idx )
730-
class(stringlist_type), intent(in) :: list
731-
type(stringlist_index_type), intent(in) :: idx
732-
type(string_type) :: get_string_idx_impl
733-
734-
integer :: idxn
779+
pure function get_idx_impl( list, idx )
780+
class(stringlist_type), intent(in) :: list
781+
type(stringlist_index_type), intent(in) :: idx
782+
type(string_type) :: get_idx_impl
735783

736-
idxn = list%to_current_idxn( idx )
784+
type(string_type), allocatable :: capture_strings(:)
737785

738-
! if the index is out of bounds, returns a string_type instance equivalent to empty string
739-
if ( 1 <= idxn .and. idxn <= list%len() ) then
740-
get_string_idx_impl = list%stringarray(idxn)
786+
call get_engine( list, idx, idx, capture_strings )
741787

788+
! if index 'idx' is out of bounds, returns an empty string
789+
if ( size(capture_strings) == 1 ) then
790+
call move( capture_strings(1), get_idx_impl )
742791
end if
743792

744-
end function get_string_idx_impl
793+
end function get_idx_impl
794+
795+
!> Version: experimental
796+
!>
797+
!> Returns strings present at stringlist_indexes in interval ['first', 'last']
798+
!> Returns array of string_type instances
799+
pure function get_range_idx_impl( list, first, last )
800+
class(stringlist_type), intent(in) :: list
801+
type(stringlist_index_type), intent(in) :: first, last
802+
803+
type(string_type), allocatable :: get_range_idx_impl(:)
804+
805+
call get_engine( list, first, last, get_range_idx_impl )
806+
807+
end function get_range_idx_impl
808+
809+
! pop & drop:
745810

746811
!> Version: experimental
747812
!>
748813
!> Removes strings present at indexes in interval ['first', 'last']
749-
!> Returns captured popped strings
750-
subroutine pop_engine( list, first, last, capture_popped)
814+
!> Stores captured popped strings in array 'capture_popped'
815+
!> No return
816+
subroutine pop_drop_engine( list, first, last, capture_popped )
751817
class(stringlist_type) :: list
752818
type(stringlist_index_type), intent(in) :: first, last
753819
type(string_type), allocatable, intent(out), optional :: capture_popped(:)
754820

755-
integer :: firstn, lastn
756-
integer :: i, inew
757-
integer :: pos, old_len, new_len
821+
integer :: firstn, lastn, from, to
822+
integer :: i, inew, pos, old_len, new_len
758823
type(string_type), dimension(:), allocatable :: new_stringarray
759824

760825
old_len = list%len()
761-
762-
firstn = max( list%to_current_idxn( first ), 1 )
763-
lastn = min( list%to_current_idxn( last ), old_len )
826+
firstn = list%to_current_idxn( first )
827+
lastn = list%to_current_idxn( last )
828+
from = max( firstn , 1 )
829+
to = min( lastn , old_len )
764830

765831
! out of bounds indexes won't modify stringlist
766-
if ( firstn <= lastn ) then
767-
pos = lastn - firstn + 1
832+
if ( from <= to ) then
833+
pos = to - from + 1
768834
new_len = old_len - pos
769835

770836
allocate( new_stringarray(new_len) )
771-
do i = 1, firstn - 1
837+
do i = 1, from - 1
772838
call move( list%stringarray(i), new_stringarray(i) )
773839
end do
774840

775841
! capture popped strings
776842
if ( present(capture_popped) ) then
777-
allocate( capture_popped(pos) )
778-
inew = 1
779-
do i = firstn, lastn
780-
call move( list%stringarray(i), capture_popped(inew) )
781-
inew = inew + 1
782-
end do
843+
call get_engine( list, shift( first, from - firstn ), &
844+
& shift( last, lastn - to ), capture_popped )
783845
end if
784846

785-
inew = firstn
786-
do i = lastn + 1, old_len
847+
inew = from
848+
do i = to + 1, old_len
787849
call move( list%stringarray(i), new_stringarray(inew) )
788850
inew = inew + 1
789851
end do
@@ -795,9 +857,7 @@ subroutine pop_engine( list, first, last, capture_popped)
795857
end if
796858
end if
797859

798-
end subroutine pop_engine
799-
800-
! pop:
860+
end subroutine pop_drop_engine
801861

802862
!> Version: experimental
803863
!>
@@ -810,10 +870,10 @@ function pop_idx_impl( list, idx )
810870

811871
type(string_type), dimension(:), allocatable :: popped_strings
812872

813-
call pop_engine( list, idx, idx, popped_strings )
873+
call pop_drop_engine( list, idx, idx, popped_strings )
814874

815875
if ( size(popped_strings) == 1 ) then
816-
pop_idx_impl = popped_strings(1)
876+
call move( pop_idx_impl, popped_strings(1) )
817877
end if
818878

819879
end function pop_idx_impl
@@ -829,12 +889,10 @@ function pop_range_idx_impl( list, first, last )
829889

830890
type(string_type), dimension(:), allocatable :: pop_range_idx_impl
831891

832-
call pop_engine( list, first, last, pop_range_idx_impl )
892+
call pop_drop_engine( list, first, last, pop_range_idx_impl )
833893

834894
end function pop_range_idx_impl
835895

836-
! drop:
837-
838896
!> Version: experimental
839897
!>
840898
!> Removes the string present at stringlist_index 'idx' in stringlist 'list'
@@ -843,7 +901,7 @@ subroutine drop_idx_impl( list, idx )
843901
class(stringlist_type) :: list
844902
type(stringlist_index_type), intent(in) :: idx
845903

846-
call pop_engine( list, idx, idx )
904+
call pop_drop_engine( list, idx, idx )
847905

848906
end subroutine drop_idx_impl
849907

@@ -852,11 +910,11 @@ end subroutine drop_idx_impl
852910
!> Removes strings present at stringlist_indexes in interval ['first', 'last']
853911
!> in stringlist 'list'
854912
!> Doesn't return removed strings
855-
subroutine drop_range_idx_impl( list, first, last)
913+
subroutine drop_range_idx_impl( list, first, last )
856914
class(stringlist_type) :: list
857915
type(stringlist_index_type), intent(in) :: first, last
858916

859-
call pop_engine( list, first, last )
917+
call pop_drop_engine( list, first, last )
860918

861919
end subroutine drop_range_idx_impl
862920

0 commit comments

Comments
 (0)