stdlib_hashmap_open.f90 Source File

!! The module, STDLIB_HASHMAP_OPEN implements a simple open addressing hash
!! map using linear addressing. The implementation is loosely based on a
!! C implementation by David Chase, http://chasewoerner.org/src/hasht/, for
!! which he has given permission to use in the Fortran Standard Library.

! Note an error in the code caused attempts to deallocate already deallocated
! entries. This did not cause stat to be non-zero, but did cause system errors,
! on my Mac. I therefore decided to remove all deallocation error reporting.

submodule(stdlib_hashmaps) stdlib_hashmap_open

    use, intrinsic :: iso_fortran_env, only: &
        character_storage_size,              &
        error_unit

    use stdlib_hashmap_wrappers

    implicit none

! Error messages
    character(len=*), parameter ::                                             &
        alloc_inv_fault     = "OPEN_HASHMAP_TYPE % INVERSE allocation fault.", &
        alloc_key_fault     = "KEY allocation fault.",                         &
        alloc_slots_fault   = "OPEN_HASHMAP_TYPE % SLOTS allocation fault.",   &
        conflicting_key     = "KEY already exists in MAP.",                    &
        expand_slots_fail   = "OPEN_HASHMAP_TYPE % SLOTS allocation > " //     &
                              "MAX_BITS.",                                     &
        init_slots_pow_fail = "SLOTS_BITS is not between DEFAULT_BITS " //     &
                              "and MAX_BITS.",                                 &
        invalid_inmap       = "INMAP was not a valid INVERSE index.",          &
        map_consist_fault   = "The hash map found an inconsistency."

    character(*), parameter :: submodule_name = 'STDLIB_HASHMAP_OPEN'


    interface expand_slots
!! Version: Experimental
!!
!! Interface to internal procedure that expands an open map's slots.
        module procedure expand_open_slots
    end interface expand_slots

    interface extend_map_entry_pool
!! Version: Experimental
!!
!! Interface to internal procedure that expands an open map entry pool.
        module procedure extend_open_map_entry_pool
    end interface extend_map_entry_pool

    interface free_map
!! Version: Experimental
!!
!! Interface to procedure that finalizes an open hash map.
        module procedure free_open_map
    end interface free_map

    interface free_map_entry_pool
!! Version: Experimental
!!
!! Interface to internal procedure that finalizes an open hash map
!! entry pool.
        module procedure free_map_entry_pool
    end interface free_map_entry_pool

    interface get_other_data
!! Version: Experimental
!!
!! Interface to procedure that gets an entry's other data.
        module procedure get_other_open_data
    end interface get_other_data

    interface  init
!! Version: Experimental
!!
!! Interface to initialization procedure for an open hash map.
        module procedure init_open_map
    end interface init

    interface rehash
!! Version: Experimental
!!
!! Interface to a procedure that changes the hash function that
!! is used to map the keys into an open hash map.
        module procedure rehash_open_map
    end interface rehash

    interface remove
!! Version: Experimental
!!
!! Interface to a procedure that removees an entry from an open hash map.
        module procedure remove_open_entry
    end interface remove

    interface set_other_data
!! Version: Experimental
!!
!! Interface to a procedure that changes the other data associated with a key
        module procedure set_other_open_data
    end interface set_other_data

contains


    subroutine expand_open_slots( map )
!! Version: Experimental
!!
!! Internal routine to make a duplicate map with more hash slots.
!! Doubles the size of the map % slots array
!! Arguments:
!!     map - the hash table whose hash slots are to be expanded
!
        type(open_hashmap_type), intent(inout) :: map

        integer(int_hash)               :: base_slot
        integer(int_index), allocatable :: dummy_slots(:)
        integer(int_index)              :: inv_index,  &
                                           new_size,   &
                                           offset,     &
                                           old_size,   &
                                           test_slot
        integer(int32)                  :: bits,      &
                                           stat

        character(256) :: errmsg
        character(*), parameter :: procedure = 'EXPAND_SLOTS'

        if ( map % nbits == max_bits ) then
            error stop submodule_name // ' % ' // procedure // ': ' // &
                expand_slots_fail
        end if

        old_size = size(map % slots, kind=int_index)

        new_size = 2*old_size
        bits = map % nbits + 1

        allocate( dummy_slots(0:new_size-1), stat=stat, errmsg=errmsg )
        if (stat /= 0) then
            error stop submodule_name // ' % ' // procedure // ': ' // &
                alloc_slots_fault
        end if

        map % nbits = bits

        dummy_slots(:) = 0
        map % index_mask = new_size-1

        map % total_probes = map % total_probes + map % probe_count
        map % probe_count = 0

        REMAP_SLOTS: do inv_index=1_int_index, &
            map % num_entries + map % num_free
            associate( inverse => map % inverse(inv_index) )
              if ( associated(inverse % target) ) then
                  base_slot = fibonacci_hash( inverse % target % hash_val, &
                                              map % nbits )
                  offset = 0
                  FIND_EMPTY_SLOT: do
                      test_slot = iand( int( base_slot + offset, int_hash), &
                                        map % index_mask )
                      if ( dummy_slots(test_slot) == 0 ) then
                          dummy_slots(test_slot) = inv_index
                          exit FIND_EMPTY_SLOT
                      end if
                      offset = offset + 1
                  end do FIND_EMPTY_SLOT
              end if
            end associate
        end do REMAP_SLOTS

        call move_alloc( dummy_slots, map % slots )

    end subroutine expand_open_slots


    subroutine extend_open_map_entry_pool(pool) ! gent_pool_new
!! Version: Experimental
!!
!! Add more map_entrys to the pool head
!! Arguments:
!!     pool - an open map entry pool
        type(open_map_entry_pool), intent(inout), pointer :: pool

        type(open_map_entry_pool), pointer :: map_entry_pool_head

        allocate(map_entry_pool_head)
        allocate(map_entry_pool_head % more_map_entries(0:pool_size-1))
        map_entry_pool_head % lastpool => pool
        pool => map_entry_pool_head
        pool % next = 0

    end subroutine extend_open_map_entry_pool


    recursive subroutine free_map_entry_pool(pool) ! gent_pool_free
!! Version: Experimental
!! Note the freeing of allocated memory may be unnecessary
!!
!! Recursively descends map entry pool list freeing each element
!! Arguments:
!!     pool  The map entry pool whose elements are to be freed
!
        type(open_map_entry_pool), intent(inout), pointer :: pool

        type(open_map_entry_pool), pointer :: lastpool

        if ( associated(pool) ) then
            lastpool => pool % lastpool
            pool % lastpool => null()
            deallocate( pool )
!         Trace component pointers/lists
            call free_map_entry_pool( lastpool )
        end if

    end subroutine free_map_entry_pool


    module subroutine free_open_map( map )
!! Version: Experimental
!!
!! Frees internal memory of an open map
!! Arguments:
!!     map - the open hash map whose memory is to be freed
!
        type(open_hashmap_type), intent(inout) :: map

        type(open_map_entry_list), pointer :: free_list
        integer(int_index) :: i

        if ( allocated( map % slots ) ) then
            deallocate( map % slots )
        end if

        if ( allocated( map % inverse ) ) then
             remove_links: do i=1, size( map % inverse, kind=int_index )
                map % inverse(i) % target => null()
            end do remove_links
            deallocate( map % inverse )
        end if

        free_free_list: do while( map % num_free > 0 )
            free_list => map % free_list
            map % free_list => map % free_list % next
            free_list % next => null()
            free_list % target => null()
            map % num_free = map % num_free - 1
        end do free_free_list
        map % num_free = 0

        if ( associated( map % cache ) ) call free_map_entry_pool(map % cache)

        map % num_entries = 0

    end subroutine free_open_map


    module subroutine get_all_open_keys(map, all_keys)
!! Version: Experimental
!!
!! Returns all the keys contained in a hash map
!! Arguments:
!!     map - an open hash map
!!     all_keys - all the keys contained in a hash map
!
        class(open_hashmap_type), intent(in) :: map
        type(key_type), allocatable, intent(out) :: all_keys(:)
        
        integer(int32) :: num_keys
        integer(int_index) :: i, key_idx

        num_keys = map % entries()
        allocate( all_keys(num_keys) )
        if ( num_keys == 0 ) return

        if ( allocated( map % inverse) ) then
            key_idx = 1_int_index
            do i=1_int_index, size( map % inverse, kind=int_index )
                if ( associated( map % inverse(i) % target ) ) then
                    all_keys(key_idx) = map % inverse(i) % target % key
                    key_idx = key_idx + 1_int_index
                end if
            end do 
        end if

    end subroutine get_all_open_keys


    module subroutine get_other_open_data( map, key, other, exists )
!! Version: Experimental
!!
!! Returns the other data associated with the inverse table index
!! Arguments:
!!     map   - an open hash table
!!     key   - the key associated with a map entry
!!     other - the other data associated with the key
!!     exists - a logical flag indicating whether an entry with that key exists
!
        class(open_hashmap_type), intent(inout) :: map
        type(key_type), intent(in)              :: key
        type(other_type), intent(out)           :: other
        logical, intent(out), optional          :: exists

        integer(int_index) :: inmap
        character(*), parameter :: procedure = 'GET_OTHER_DATA'

        call in_open_map(map, inmap, key)
        if ( inmap <= 0 .or. &
            inmap > map % num_entries + map % num_free ) then
            if ( present(exists) ) then
                exists = .false.
                return
            else
                error stop submodule_name // ' % ' // procedure // ': ' // &
                    invalid_inmap
            end if
        else if ( associated( map % inverse(inmap) % target ) ) then
            if ( present(exists) ) exists = .true.
            call copy_other( map % inverse(inmap) % target % other, other )
        else
            if ( present(exists) ) then
                exists = .false.
                return
            else
                error stop submodule_name // ' % ' // procedure // ': ' // &
                    map_consist_fault
            end if
        end if

    end subroutine get_other_open_data


    subroutine in_open_map(map, inmap, key) ! Chase's inmap
!! Version: Experimental
!!
!! Returns the index into the INVERSE array associated with the KEY
!! Arguments:
!!     map   - the hash map of interest
!!     inmap - the returned index into the INVERSE array of entry pointers
!!     key   - the key identifying the entry of interest
!
        class(open_hashmap_type), intent(inout) :: map
        integer(int_index), intent(out)         :: inmap
        type(key_type), intent(in)              :: key

        character(*), parameter :: procedure = 'IN_MAP'
        integer(int_hash) :: &
            base_slot,       &
            hash_val,        &
            test_slot
        integer(int_index) :: &
            offset

        hash_val = map % hasher( key )

        if ( map % probe_count > inmap_probe_factor * map % call_count .or. &
             map % num_entries >= load_factor *                             &
             size( map % slots, kind=int_index ) ) then
            if ( map % nbits < max_bits ) &
                 call expand_slots(map)
        end if

        map % call_count = map % call_count + 1
        base_slot = fibonacci_hash( hash_val, map % nbits )
        offset = 0_int_index
        PROBE_SLOTS: do
            test_slot = iand( base_slot + offset, map % index_mask )
            map % probe_count = map % probe_count + 1
            inmap = map % slots( test_slot )
            if ( inmap == 0 ) then
                return
            else if ( inmap < 0 .or. &
                 inmap > map % num_entries + map % num_free ) then
                error stop submodule_name // ' % ' // procedure // ': ' // &
                    map_consist_fault
            else if ( .not. associated( map % inverse(inmap) % target ) ) then
                error stop submodule_name // ' % ' // procedure // ': ' // &
                    map_consist_fault
            else
                associate( inverse => map % inverse(inmap) )
                  if ( hash_val == inverse % target % hash_val ) then
                      if ( key == inverse % target % key ) then
                          return
                      end if
                  end if
                end associate
            end if
            offset = offset + 1_int_index
        end do PROBE_SLOTS

    end subroutine in_open_map


    module subroutine init_open_map( map,         &
                                     hasher,      &
                                     slots_bits,  &
                                     status )
!! Version: Experimental
!!
!! Routine to allocate an empty map with HASHER as the hash function,
!! 2**SLOTS_BITS initial SIZE(map % slots), and SIZE(map % slots) limited to a
!! maximum of 2**MAX_BITS. All fields are initialized.
!! Arguments:
!!     map         - the open hash maap to be initialized
!!     hasher      - the hash function to be used to map keys to slots
!!     slots_bits  - the number of bits used to map to the slots
!!     status      - an integer error status flag with the allowed values:
!!         success - no problems were found
!!         alloc_fault - map % slots or map % inverse could not be allocated
!!         array_size_error - slots_bits is less than default_bitd or
!!             greater than max_bits

        class(open_hashmap_type), intent(out)      :: map
        procedure(hasher_fun)                      :: hasher
        integer, intent(in), optional              :: slots_bits
        integer(int32), intent(out), optional      :: status

        character(256)          :: errmsg
        integer(int_index)      :: i
        character(*), parameter :: procedure = 'INIT'
        integer(int_index)      :: slots
        integer(int32)          :: stat
        type(open_map_entry_pool), pointer :: map_entry_pool_head

        map % call_count = 0
        map % probe_count = 0
        map % total_probes = 0

        map % hasher => hasher

        if ( present(slots_bits) ) then
            if ( slots_bits < default_bits .OR. &
                 slots_bits > max_bits ) then
                if ( present(status) ) then
                    status = array_size_error
                    return
                else
                    error stop submodule_name // ' % ' // procedure // ': ' // &
                        init_slots_pow_fail
                end if
            end if
            map % nbits = slots_bits
        else
            map % nbits = min( default_bits, max_bits )
        end if

        slots = 2_int32**map % nbits
        map % index_mask = slots - 1

        allocate( map % slots(0:slots-1), stat=stat, errmsg=errmsg )
        if ( stat /= 0 ) then
            if ( present(status) ) then
                status = alloc_fault
                return
            else
                write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg)
                error stop submodule_name // ' % ' // procedure // ': ' // &
                    alloc_slots_fault
            end if
        end if

        do i=0, size( map % slots, kind=int_index ) -  1
            map % slots(i) = 0 ! May be redundant
        end do

!! 5*s from Chase's g_new_map
        allocate( map % inverse(1:ceiling(load_factor*slots, &
                  kind=int_index)),                          &
                  stat=stat,                                 &
                  errmsg=errmsg )
        if ( stat /= 0 ) then
            if ( present( status ) ) then
                status = alloc_fault
                return
            else
                write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg)
                error stop submodule_name // ' % ' // procedure // ': ' // &
                    alloc_inv_fault
            end if
        end if

        do i=1, size(map % inverse, kind=int_index)
            map % inverse(i) % target => null()
        end do

        do while(associated(map % cache))
            map_entry_pool_head => map % cache
            map % cache => map_entry_pool_head % lastpool
            map_entry_pool_head % lastpool => null()
            deallocate( map_entry_pool_head % more_map_entries )
            deallocate( map_entry_pool_head )
        end do

        call extend_map_entry_pool(map % cache)

        if (present(status) ) status = success

    end subroutine init_open_map


    pure module function open_loading( map )
!! Version: Experimental
!!
!! Returns the number of entries relative to slots in a hash map
!! Arguments:
!!       map - an open hash map
        class(open_hashmap_type), intent(in) :: map
        real :: open_loading

        open_loading = real( map % num_entries ) / &
                       size( map % slots, kind=int_index )

    end function open_loading


    module subroutine map_open_entry(map, key, other, conflict)
!! Version: Experimental
!!
!! Inserts an entry into the hash table
!!  Arguments:
!!      map     the hash table of interest
!!      key      - the key identifying the entry
!!      other    - other data associated with the key
!!      conflict - logical flag indicating whether the entry key conflicts
!!                 with an existing key
!
        class(open_hashmap_type), intent(inout) :: map
        type(key_type), intent(in)              :: key
        type(other_type), intent(in), optional  :: other
        logical, intent(out), optional          :: conflict

        type(open_map_entry_type), pointer :: new_ent
        integer(int_hash)  :: base_slot
        integer(int_hash)  :: hash_val
        integer(int_index) :: inmap, offset, test_slot
        character(*), parameter :: procedure = 'MAP_ENTRY'

        hash_val = map % hasher( key )

        if ( map % probe_count > map_probe_factor * map % call_count .or.   &
             map % num_entries >= load_factor * size( map % slots,          &
                                                      kind=int_index) ) then
            call expand_slots(map)
        end if
        map % call_count = map % call_count  + 1
        base_slot = fibonacci_hash( hash_val, map % nbits )

        offset = 0
        PROBE_SUCCESSIVE_SLOTS: do
            map % probe_count = map % probe_count + 1
            test_slot = iand( base_slot + offset, map % index_mask )
            inmap = map % slots(test_slot)
            if ( inmap == 0 ) then
                call allocate_open_map_entry(map, new_ent)
                new_ent % hash_val = hash_val
                call copy_key( key, new_ent % key )
                if ( present( other ) ) &
                    call copy_other( other, new_ent % other )
                inmap = new_ent % inmap
                map % inverse( inmap ) % target => new_ent
                map % slots( test_slot ) = inmap
                if ( present(conflict) ) conflict = .false.
                return
            else if ( inmap < 0 .or. &
                inmap > map % num_entries + map % num_free ) then
                error stop submodule_name // ' % ' // procedure // ': ' // &
                    invalid_inmap
            else if (.not. associated( map % inverse(inmap) % target ) ) then
                error stop submodule_name // ' % ' // procedure // ': ' // &
                    invalid_inmap
            else
                associate( target => map % inverse(inmap) % target )
                  if ( hash_val == target % hash_val ) then
                      if ( key == target % key ) then
                          ! entry already exists
                          if ( present(conflict) ) then
                              conflict = .true.
                          else
                              error stop submodule_name // ' % ' // procedure &
                                  // ': ' // conflicting_key
                          end if
                          return
                      end if
                  end if
                end associate
            end if
            offset = offset + 1
        end do PROBE_SUCCESSIVE_SLOTS

    contains

        subroutine allocate_open_map_entry(map, bucket)
!         allocates a hash bucket
            type(open_hashmap_type), intent(inout) :: map
            type(open_map_entry_type), pointer, intent(out) :: bucket
            type(open_map_entry_list), pointer :: free_list
            type(open_map_entry_pool), pointer :: pool
            character(*), parameter :: procedure_name = "ALLOCATE_MAP_ENTRY"

            pool => map % cache
            map % num_entries = map % num_entries + 1
            if ( associated(map % free_list) ) then
!             Get hash bucket from free_list
                free_list => map % free_list
                bucket => free_list % target
                map % free_list => free_list % next
                free_list % target => null()
                free_list % next => null()
                if (bucket % inmap <= 0) &
                    error stop submodule_name // " % " // procedure_name // &
                    ": Failed consistency check: BUCKET % INMAP <= 0"
                map % num_free = map % num_free - 1
            else
!             Get hash bucket from pool
                if ( pool % next == pool_size ) then
!         Expand pool
                    call extend_map_entry_pool(map % cache)
                    pool => map % cache
                end if
                bucket      => pool % more_map_entries(pool % next)
                pool % next =  pool % next + 1 ! 0s based -> post-increment
                if ( map % num_entries >                     &
                     size( map % inverse, kind=int_index ) ) then
                    call expand_inverse( map )
                end if
                if ( map % num_entries <= 0 ) &
                    error stop submodule_name // " % " // procedure_name // &
                    ": Failed consistency check: MAP % NUM_ENTRIES <= 0."
                bucket % inmap = map % num_entries
            end if

        end subroutine allocate_open_map_entry

        subroutine expand_inverse(map)
!!     Increase size of map % inverse
            type(open_hashmap_type), intent(inout) :: map
            type(open_map_entry_ptr), allocatable   :: dummy_inverse(:)

            integer(int32) :: stat
            character(256) :: errmsg

            allocate( dummy_inverse(1:2*size(map % inverse, kind=int_index)), &
                      stat=stat, errmsg=errmsg )
            if ( stat /= 0 ) then
                write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg)
                error stop submodule_name // ' % ' // procedure // ': ' // &
                    alloc_inv_fault
            end if
            dummy_inverse(1:size(map % inverse, kind=int_index)) = &
                map % inverse(:)

            call move_alloc( dummy_inverse, map % inverse )

        end subroutine expand_inverse

    end subroutine map_open_entry


    module subroutine rehash_open_map( map, hasher )
!! Version: Experimental
!!
!! Changes the hashing method of the table entries to that of HASHER.
!! Arguments:
!!     map      the table to be rehashed
!!     hasher the hasher function to be used for the table
!
        class(open_hashmap_type), intent(inout) :: map
        procedure(hasher_fun)                   :: hasher

        integer(int_hash)       :: base_slot
        integer(int_hash)       :: hash_val
        integer(int_index)      :: i, test_slot, offset

        map % hasher => hasher

        map % slots = 0

        do i=1, map % num_entries + map % num_free
            if ( .not. associated( map % inverse(i) % target ) ) cycle
            hash_val = map % hasher( map % inverse(i) % target % key )
            map % inverse(i) % target % hash_val = hash_val
            base_slot = fibonaccI_hash( hash_val, map % nbits )
            offset = 0
            FIND_EMPTY_SLOT: do
                test_slot = iand( int( base_slot + offset, int_hash ), &
                                  map % index_mask )
                if ( map % slots(test_slot) == 0 ) then
                    map % slots(test_slot) = i
                    exit FIND_EMPTY_SLOT
                end if
                offset = offset + 1
            end do FIND_EMPTY_SLOT
        end do

    end subroutine rehash_open_map


    module subroutine remove_open_entry(map, key, existed)
!! Remove the entry, if any, that has the key
!! Arguments:
!!    map     - the table from which the entry is to be removed
!!    key     - the key to an entry
!!    existed - a logical flag indicating whether an entry with the key
!!              was present in the original map
!
        class(open_hashmap_type), intent(inout) :: map
        type(key_type), intent(in)              :: key
        logical, intent(out), optional          :: existed

        type(open_map_entry_list), pointer :: aentry
        type(open_map_entry_type), pointer :: bucket
        integer(int_index)                 :: base_slot
        integer(int_index)                 :: current_index
        integer(int_index)                 :: current_slot
        integer(int_index)                 :: empty_slot
        integer(int_index)                 :: inmap
        logical                            :: overlap
        integer(int_index)                 :: slot_index

        overlap = .false.
        call in_open_map( map, inmap, key )
        if ( inmap < 1 .or. inmap > size( map % inverse ) ) then
            if ( present( existed ) ) existed = .false.
            return
        end if

        bucket => map % inverse(inmap) % target
        if ( associated(bucket) ) then
            base_slot = fibonacci_hash( bucket % hash_val, map % nbits )
            if ( present(existed) ) existed = .true.
        else
            if ( present( existed ) ) existed = .false.
            return
        end if

! Find slot associated with inmap and nullify the pointer
        current_slot = base_slot
        search_for_inmap: do
            slot_index = map % slots(current_slot)
            if ( slot_index == inmap ) then
                allocate(aentry)
                aentry % target => map % inverse(inmap) % target
                aentry % next => map % free_list
                map % free_list => aentry
                map % num_free = map % num_free + 1
                map % slots( current_slot ) = 0
                map % inverse(inmap) % target => null()
                map % num_entries = map % num_entries - 1
                empty_slot = current_slot
                current_slot = iand( map % index_mask, current_slot + 1 )
                if ( map % slots(current_slot) == 0 ) return
                if ( current_slot == 0 ) overlap = .true.
                exit search_for_inmap
            else
                if ( map % slots(current_slot) == 0 ) return
                current_slot = iand( map % index_mask, current_slot + 1 )
                if ( current_slot == 0 ) overlap = .true.
                cycle search_for_inmap
            end if
        end do search_for_inmap

! Have found slot and stored it in free_list, now may need to iteratively
! swap to fill holes. First search backwards to find start of run.
        find_run_start: do
            base_slot = iand( map % index_mask, base_slot - 1 )
            if ( base_slot == map % index_mask ) then
                if ( map % slots(base_slot) == 0 ) then
                    base_slot = 0
                    exit find_run_start
                else
                    overlap = .true.
                    cycle find_run_start
                end if
            else if ( map % slots(base_slot) == 0 ) then
                base_slot = iand( map % index_mask, base_slot + 1 )
                exit find_run_start
            else
                cycle find_run_start
            end if
        end do find_run_start

! Search forward for entry to fill empty slot
        fill_empty_slots: do
            bucket => map % inverse(map % slots(current_slot) ) % target
            current_index = fibonacci_hash( bucket % hash_val, &
                                            map % nbits )
            if ( overlap .and. empty_slot < base_slot ) then
                if ( ( current_index >= base_slot .and. &
                       current_index <= map % index_mask ) .or. &
                     ( current_index >= 0 .and. &
                       current_index <= empty_slot ) ) then
                    map % slots( empty_slot ) = map % slots( current_slot )
                    map % slots( current_slot ) = 0
                    empty_slot = current_slot
                end if
                current_slot = iand( map % index_mask, current_slot + 1 )
            else
                if ( current_index >= base_slot .and. &
                     current_index <= empty_slot ) then
                    map % slots( empty_slot ) = map % slots( current_slot )
                    map % slots( current_slot ) = 0
                    empty_slot = current_slot
                end if
                current_slot = iand( map % index_mask, current_slot + 1 )
                if ( current_slot == 0 ) overlap = .true.
            end if
            if ( map % slots( current_slot ) == 0 ) exit fill_empty_slots
        end do fill_empty_slots

    end subroutine remove_open_entry


    module subroutine set_other_open_data( map, key, other, exists )
!! Version: Experimental
!!
!! Change the other data associated with the key
!! Arguments:
!!     map    - the map with the entry of interest
!!     key    - the key to the entry inthe map
!!     other  - the new data to be associated with the key
!!     exists - a logical flag indicating whether the key is already entered
!!              in the map
!
        class(open_hashmap_type), intent(inout) :: map
        type(key_type), intent(in)              :: key
        type(other_type), intent(in)            :: other
        logical, intent(out),optional           :: exists

        integer(int_index) :: inmap

        character(*), parameter :: procedure = 'SET_OTHER_DATA'

        call in_open_map( map, inmap, key )
        if ( inmap <= 0 .or. inmap > size( map % inverse, kind=int_index ) ) &
            then
            if ( present(exists) ) then
                exists = .false.
                return
            else
                error stop submodule_name // ' % ' // procedure // ': ' // &
                    invalid_inmap
            end if
        else if ( associated( map % inverse(inmap) % target ) ) then
            associate( target => map % inverse(inmap) % target )
              call copy_other( other, target % other )
              if ( present(exists) ) exists = .true.
              return
            end associate
        else
            error stop submodule_name // ' % ' // procedure // ': ' // &
                invalid_inmap
        end if

    end subroutine set_other_open_data


    module function total_open_depth( map ) result(total_depth)
!! Version: Experimental
!!
!! Returns the total number of ones based offsets of slot entries from
!! their slot index for a hash map
!! Arguments:
!!     map - an open hash map
        class(open_hashmap_type), intent(in) :: map
        integer(int64) :: total_depth

        integer(int_index) :: inv_index, slot, slots
        integer(int_hash)  :: index

        total_depth = 0_int64
        slots = size( map % slots, kind=int_index )
        do slot=0, slots-1
            if ( map % slots( slot ) == 0 ) cycle
            inv_index = map % slots( slot )
            if ( inv_index <= 0 ) cycle
            associate( inverse => map % inverse( inv_index ))
              index = fibonacci_hash( inverse % target % hash_val, &
                                      map % nbits )
            end associate
            total_depth = total_depth + &
                iand( slot - index, map % index_mask ) + 1_int64
        end do

    end function total_open_depth


    module subroutine open_key_test(map, key, present)
!! Version: Experimental
!!
!! Returns a logical flag indicating whether KEY exists in the hash map
!! Arguments:
!!     map - the hash map of interest
!!     key - the key of interest
!
        class(open_hashmap_type), intent(inout) :: map
        type(key_type), intent(in)              :: key
        logical, intent(out)                    :: present

        integer(int_index) :: inmap

        call in_open_map( map, inmap, key )
        if ( inmap <= 0 .or. inmap > size( map % inverse, kind=int_index ) ) &
            then
            present = .false.
        else
            present = associated( map % inverse(inmap) % target )
        end if

    end subroutine open_key_test

end submodule stdlib_hashmap_open