Skip to content

Commit bd703fb

Browse files
aman-godaraaman-godara
committed
added range feature for get, added shift function
1 parent f294642 commit bd703fb

File tree

1 file changed

+115
-57
lines changed

1 file changed

+115
-57
lines changed

‎src/stdlib_stringlist_type.f90‎

Lines changed: 115 additions & 57 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

@@ -655,7 +672,7 @@ subroutine insert_before_stringlist_int_impl( list, idxn, slist )
655672

656673
work_idxn = idxn
657674
pre_length = slist%len()
658-
call insert_before_empty_positions( list, work_idxn, pre_length )
675+
call insert_before_engine( list, work_idxn, pre_length )
659676
post_length = slist%len()
660677

661678
do i = 1, min( work_idxn - 1, pre_length )
@@ -684,7 +701,7 @@ subroutine insert_before_chararray_int_impl( list, idxn, carray )
684701
integer :: work_idxn, idxnew
685702

686703
work_idxn = idxn
687-
call insert_before_empty_positions( list, work_idxn, size( carray ) )
704+
call insert_before_engine( list, work_idxn, size( carray ) )
688705

689706
do i = 1, size( carray )
690707
idxnew = work_idxn + i - 1
@@ -707,7 +724,7 @@ subroutine insert_before_stringarray_int_impl( list, idxn, sarray )
707724
integer :: work_idxn, idxnew
708725

709726
work_idxn = idxn
710-
call insert_before_empty_positions( list, work_idxn, size( sarray ) )
727+
call insert_before_engine( list, work_idxn, size( sarray ) )
711728

712729
do i = 1, size( sarray )
713730
idxnew = work_idxn + i - 1
@@ -718,68 +735,113 @@ end subroutine insert_before_stringarray_int_impl
718735

719736
! get:
720737

738+
!> Version: experimental
739+
!>
740+
!> Returns strings present at stringlist_indexes in interval ['first', 'last']
741+
!> Stores requested strings in array 'capture_strings'
742+
!> No return
743+
subroutine get_engine( list, first, last, capture_strings )
744+
class(stringlist_type) :: list
745+
type(stringlist_index_type), intent(in) :: first, last
746+
type(string_type), allocatable, intent(out) :: capture_strings(:)
747+
748+
integer :: from, to
749+
integer :: i, inew
750+
751+
from = max( list%to_current_idxn( first ), 1 )
752+
to = min( list%to_current_idxn( last ), list%len() )
753+
754+
! out of bounds indexes won't be captured in capture_strings
755+
if ( from <= to ) then
756+
pos = to - from + 1
757+
allocate( capture_strings(pos) )
758+
759+
inew = 1
760+
do i = from, to
761+
capture_strings(inew) = list%stringarray(i)
762+
inew = inew + 1
763+
end do
764+
765+
else
766+
allocate( capture_strings(0) )
767+
end if
768+
769+
end subroutine get_engine
770+
721771
!> Version: experimental
722772
!>
723773
!> Returns the string present at stringlist_index 'idx' in stringlist 'list'
724774
!> Returns string_type instance
725-
pure function get_string_idx_impl( list, idx )
726-
class(stringlist_type), intent(in) :: list
727-
type(stringlist_index_type), intent(in) :: idx
728-
type(string_type) :: get_string_idx_impl
729-
730-
integer :: idxn
775+
pure function get_idx_impl( list, idx )
776+
class(stringlist_type), intent(in) :: list
777+
type(stringlist_index_type), intent(in) :: idx
778+
type(string_type) :: get_idx_impl
731779

732-
idxn = list%to_current_idxn( idx )
780+
type(string_type), allocatable :: capture_strings(:)
733781

734-
! if the index is out of bounds, returns a string_type instance equivalent to empty string
735-
if ( 1 <= idxn .and. idxn <= list%len() ) then
736-
get_string_idx_impl = list%stringarray(idxn)
782+
call get_engine( list, idx, idx, capture_strings )
737783

784+
! if index 'idx' is out of bounds, returns an empty string
785+
if ( size(capture_strings) == 1 ) then
786+
call move( capture_strings(1), get_idx_impl )
738787
end if
739788

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

742807
!> Version: experimental
743808
!>
744809
!> Removes strings present at indexes in interval ['first', 'last']
745-
!> Returns captured popped strings
746-
subroutine pop_engine( list, first, last, capture_popped)
810+
!> Stores captured popped strings in array 'capture_popped'
811+
!> No return
812+
subroutine pop_drop_engine( list, first, last, capture_popped )
747813
class(stringlist_type) :: list
748814
type(stringlist_index_type), intent(in) :: first, last
749815
type(string_type), allocatable, intent(out), optional :: capture_popped(:)
750816

751-
integer :: firstn, lastn
752-
integer :: i, inew
753-
integer :: pos, old_len, new_len
817+
integer :: firstn, lastn, from, to
818+
integer :: i, inew, pos, old_len, new_len
754819
type(string_type), dimension(:), allocatable :: new_stringarray
755820

756821
old_len = list%len()
757-
758-
firstn = max( list%to_current_idxn( first ), 1 )
759-
lastn = min( list%to_current_idxn( last ), old_len )
822+
firstn = list%to_current_idxn( first )
823+
lastn = list%to_current_idxn( last )
824+
from = max( firstn , 1 )
825+
to = min( lastn , old_len )
760826

761827
! out of bounds indexes won't modify stringlist
762-
if ( firstn <= lastn ) then
763-
pos = lastn - firstn + 1
828+
if ( from <= to ) then
829+
pos = to - from + 1
764830
new_len = old_len - pos
765831

766832
allocate( new_stringarray(new_len) )
767-
do i = 1, firstn - 1
833+
do i = 1, from - 1
768834
call move( list%stringarray(i), new_stringarray(i) )
769835
end do
770836

771837
! capture popped strings
772838
if ( present(capture_popped) ) then
773-
allocate( capture_popped(pos) )
774-
inew = 1
775-
do i = firstn, lastn
776-
call move( list%stringarray(i), capture_popped(inew) )
777-
inew = inew + 1
778-
end do
839+
call get_engine( list, shift( first, from - firstn ), &
840+
& shift( last, lastn - to ), capture_popped )
779841
end if
780842

781-
inew = firstn
782-
do i = lastn + 1, old_len
843+
inew = from
844+
do i = to + 1, old_len
783845
call move( list%stringarray(i), new_stringarray(inew) )
784846
inew = inew + 1
785847
end do
@@ -791,9 +853,7 @@ subroutine pop_engine( list, first, last, capture_popped)
791853
end if
792854
end if
793855

794-
end subroutine pop_engine
795-
796-
! pop:
856+
end subroutine pop_drop_engine
797857

798858
!> Version: experimental
799859
!>
@@ -806,10 +866,10 @@ function pop_idx_impl( list, idx )
806866

807867
type(string_type), dimension(:), allocatable :: popped_strings
808868

809-
call pop_engine( list, idx, idx, popped_strings )
869+
call pop_drop_engine( list, idx, idx, popped_strings )
810870

811871
if ( size(popped_strings) == 1 ) then
812-
pop_idx_impl = popped_strings(1)
872+
call move( pop_idx_impl, popped_strings(1) )
813873
end if
814874

815875
end function pop_idx_impl
@@ -825,12 +885,10 @@ function pop_range_idx_impl( list, first, last )
825885

826886
type(string_type), dimension(:), allocatable :: pop_range_idx_impl
827887

828-
call pop_engine( list, first, last, pop_range_idx_impl )
888+
call pop_drop_engine( list, first, last, pop_range_idx_impl )
829889

830890
end function pop_range_idx_impl
831891

832-
! drop:
833-
834892
!> Version: experimental
835893
!>
836894
!> Removes the string present at stringlist_index 'idx' in stringlist 'list'
@@ -839,7 +897,7 @@ subroutine drop_idx_impl( list, idx )
839897
class(stringlist_type) :: list
840898
type(stringlist_index_type), intent(in) :: idx
841899

842-
call pop_engine( list, idx, idx )
900+
call pop_drop_engine( list, idx, idx )
843901

844902
end subroutine drop_idx_impl
845903

@@ -848,11 +906,11 @@ end subroutine drop_idx_impl
848906
!> Removes strings present at stringlist_indexes in interval ['first', 'last']
849907
!> in stringlist 'list'
850908
!> Doesn't return removed strings
851-
subroutine drop_range_idx_impl( list, first, last)
909+
subroutine drop_range_idx_impl( list, first, last )
852910
class(stringlist_type) :: list
853911
type(stringlist_index_type), intent(in) :: first, last
854912

855-
call pop_engine( list, first, last )
913+
call pop_drop_engine( list, first, last )
856914

857915
end subroutine drop_range_idx_impl
858916

0 commit comments

Comments
 (0)