Project

General

Profile

self_map_ref.F90 Source File

Source Code

!>
!! 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

© 2016
self was developed by
Documentation generated by FORD