!>
!! Provides array-based, self-extending reference vectors of arbitrary type.
!!
module self_map_ref
use self_object
use self_vector
implicit none
private
type, extends(object) :: item
class(*), allocatable :: key
class(*), pointer :: value
contains
procedure :: is_equal => is_equal_item
procedure :: to_string => to_string_item
end type
type, extends(vector), public :: map_ref
contains
procedure :: add_keyed_item
generic :: add => add_keyed_item
procedure :: get
end type
interface map_ref
module procedure new_empty
end interface map_ref
contains
!
! type(vector)
!
! constructors
function new_empty(verbose, initial_size) result(this)
logical, optional, intent(in) :: verbose
integer, optional, intent(in) :: initial_size
type(map_ref) :: this
if(present(verbose) .and. verbose) print *, 'map_ref%new_empty begin'
this%vector = vector(verbose, initial_size)
if(this%get_verbose()) print *, 'map_ref%new_empty end'
end function new_empty
subroutine add_keyed_item(this, key, new_stuff)
class(map_ref),intent(inout) :: this
class(*), intent(in) :: key
class(*), target, intent(in) :: new_stuff
integer :: idx
class(*), pointer :: my_item_ptr
type(item) :: my_item
if(this%get_verbose()) print *, 'map_ref%add_keyed_item begin'
allocate(my_item%key, source=key)
my_item%value => new_stuff
idx = this%find(my_item)
if(idx > 0) then
my_item_ptr => this%at(idx)
select type(my_item_ptr)
type is (item)
my_item_ptr%value => new_stuff
#ifndef NDEBUG
class default
write(0, '(*(g0))') 'Danger: invalid item in map_ref'
#endif
end select
else
call this%vector%add(my_item)
end if
if(this%get_verbose()) then
print *, 'added to map_ref (', this%length(), '/', &
this%capacity(), ' elements)'
end if
if(this%get_verbose()) print *, 'map_ref%add_keyed_item end'
end subroutine add_keyed_item
function get(this, key)
class(map_ref), intent(inout) :: this
class(*), intent(in) :: key
class(*), pointer :: get
class(*), pointer :: my_item_ptr
type(item) :: my_item
integer :: idx
get => null()
allocate(my_item%key, source=key)
idx = this%find(my_item)
if(idx > 0) then
my_item_ptr => this%at(idx)
select type(my_item_ptr)
class is(item)
get => my_item_ptr%value
#ifndef NDEBUG
class default
write(0, '(*(g0))') 'Danger: invalid item in map_ref'
#endif
end select
end if
end function get
logical function is_equal_item(this, that) result(equal)
class(item), intent(in) :: this
class(*), intent(in) :: that
select type(that)
class is (item)
equal = object_equal(this%key, that%key)
class default
equal = .false.
end select
end function is_equal_item
function to_string_item(this)
class(item), intent(in) :: this
character(:), allocatable :: to_string_item
to_string_item = "("//object_string(this%key)//","//object_string(this%value)//")"
end function to_string_item
end module self_map_ref