stdlib_hashmap_wrappers.f90 Source File

The module STDLIB_HASHMAP_WRAPPERS provides wrappers for various entities used by the hash map procedures. These include wrappers for the key and other data, and hashing procedures to operate on entities of the key_type.



Source Code

!! The module STDLIB_HASHMAP_WRAPPERS provides wrappers for various
!! entities used by the hash map procedures. These include wrappers for the
!! `key` and `other` data, and hashing procedures to operate on entities of
!! the `key_type`.

module stdlib_hashmap_wrappers

    use, intrinsic :: iso_fortran_env, only : &
        character_storage_size

    use stdlib_hash_32bit

    use stdlib_kinds, only : &
        int8,                &
        int16,               &
        int32,               &
        int64,               &
        dp

    implicit none

    private

!! Public procedures
    public ::                    &
        copy_key,                &
        copy_other,              &
        fibonacci_hash,          &
        fnv_1_hasher,            &
        fnv_1a_hasher,           &
        free_key,                &
        free_other,              &
        get,                     &
        hasher_fun,              &
        operator(==),            &
        seeded_nmhash32_hasher,  &
        seeded_nmhash32x_hasher, &
        seeded_water_hasher,     &
        set

!! Public types
    public ::      &
        key_type,  &
        other_type

!! Public integers
    public ::   &
        int_hash

    integer, parameter ::               &
! Should be 8
        bits_int8  = bit_size(0_int8)

    integer, parameter ::                   &
        bits_char = character_storage_size, &
        bytes_char = bits_char/bits_int8

    character(*), parameter :: module_name = "STDLIB_HASHMAP_WRAPPERS"

    type :: key_type
!! Version: Experimental
!!
!! A wrapper type for the key's true type
!        private
        integer(int8), allocatable :: value(:)
    end type key_type

    abstract interface
!! Version: Experimental
!!
!! Abstract interface to a 64 bit hash function operating on a KEY_TYPE
        pure function hasher_fun( key )  result(hash_value)
            import key_type, int_hash
            type(key_type), intent(in)    :: key
            integer(int_hash)             :: hash_value
        end function hasher_fun
    end interface

    type :: other_type
!! Version: Experimental
!!
!! A wrapper type for the other data's true type
!        private
        class(*), allocatable :: value
    end type other_type

    interface get

        module procedure get_char_key,   &
                         get_int8_key,   &
                         get_int32_key,   &
                         get_other

    end interface get


    interface operator(==)
        module procedure equal_keys
    end interface operator(==)

    interface set

        module procedure set_char_key,   &
                         set_int8_key,   &
                         set_int32_key, &
                         set_other

    end interface set

contains


    pure subroutine copy_key( old_key, new_key )
!! Version: Experimental
!!
!! Copies the contents of the key, old_key, to the key, new_key
!! ([Specifications](../page/specs/stdlib_hashmaps.html#copy_key-returns-a-copy-of-the-key))
!!
!! Arguments:
!!     old_key - the input key
!!     new_key - the output copy of old_key
        type(key_type), intent(in)  :: old_key
        type(key_type), intent(out) :: new_key

        new_key % value = old_key % value

    end subroutine copy_key


    subroutine copy_other( other_in, other_out )
!! Version: Experimental
!!
!! Copies the other data, other_in, to the variable, other_out
!! ([Specifications](../page/specs/stdlib_hashmaps.html#copy_other-returns-a-copy-of-the-other-data))
!!
!! Arguments:
!!     other_in  - the input data
!!     other_out - the output data
        type(other_type), intent(in)  :: other_in
        type(other_type), intent(out) :: other_out

        allocate(other_out % value, source = other_in % value )

    end subroutine copy_other


    function equal_keys( key1, key2 ) result(test) ! Chase's tester
!! Version: Experimental
!!
!! Compares two keys for equality
!! ([Specifications](../page/specs/stdlib_hashmaps.html#operator(==)-compares-two-keys-for-equality))
!!
!! Arguments:
!!     key1 - the first key
!!     key2 - the second key
        logical                    :: test
        type(key_type), intent(in) :: key1
        type(key_type), intent(in) :: key2

        if ( size(key1 % value, kind=int64) /= &
             size(key2 % value, kind=int64) ) then
            test = .false.
            return
        end if

        if ( all( key1 % value == key2 % value ) ) then
            test = .true.
        else
            test = .false.
        end if

    end function equal_keys


    subroutine free_key( key )
!! Version: Experimental
!!
!! Frees the memory in a key
!! ([Specifications](../page/specs/stdlib_hashmaps.html#free_key-frees-the-memory-associated-with-a-key))
!!
!! Arguments:
!!     key  - the key
        type(key_type), intent(inout) :: key

        if ( allocated( key % value ) ) deallocate( key % value )

    end subroutine free_key


    subroutine free_other( other )
!! Version: Experimental
!!
!! Frees the memory in the other data
!! ([Specifications](../page/specs/stdlib_hashmaps.html#free_other-frees-the-memory-associated-with-other-data))
!!
!! Arguments:
!!     other  - the other data
        type(other_type), intent(inout) :: other

        if ( allocated( other % value) ) deallocate( other % value )

    end subroutine free_other


    subroutine get_char_key( key, value )
!! Version: Experimental
!!
!! Gets the contents of the key as a CHARACTER string
!! Arguments:
!!     key   - the input key
!!     value - the contents of key mapped to a CHARACTER string
        type(key_type), intent(in)             :: key
        character(:), allocatable, intent(out) :: value
        character(*), parameter :: procedure = "GET"

        integer(int64) :: key_as_char
        integer(int64) :: key_size

        key_size = size( key % value, kind=int64 )
        select case( bytes_char )
        case(1)
            key_as_char = key_size
        case(2)
            if ( iand( key_size, 1_int64 ) > 0 ) then
                error stop module_name // " % " // procedure // &
                          ": Internal Error at stdlib_hashmaps: " // &
                           "System uses 2 bytes per character, so " // &
                           "key_size can't be an odd number."
            end if
            key_as_char = ishft( key_size, -1 )
        case(4)
            if ( iand( key_size, 3_int64) > 0 ) then
                error stop module_name // " % " // procedure // &
                          ": Internal Error at stdlib_hashmaps: " // &
                           "System uses 4 bytes per character, and " // &
                           "key_size is not a multiple of four."
            end if
            key_as_char = ishft( key_size, -2 )
        case default
            error stop module_name // " % " // procedure // &
                       ": Internal Error: " // &
                       "System doesn't use a power of two for its " // &
                       "character size as expected by stdlib_hashmaps."
        end select

        allocate( character( len=key_as_char ) :: value )

        value(1:key_as_char) = transfer( key % value, value )

    end subroutine get_char_key

    subroutine get_other( other, value )
!! Version: Experimental
!!
!! Gets the contents of the other as a CLASS(*) string
!! Arguments:
!!     other - the input other data
!!     value - the contents of other mapped to a CLASS(*) variable
        type(other_type), intent(in)       :: other
        class(*), allocatable, intent(out) :: value

        allocate(value, source=other % value)

    end subroutine get_other


    subroutine get_int8_key( key, value )
!! Version: Experimental
!!
!! Gets the contents of the key as an INTEGER(INT8) vector
!! Arguments:
!!     key   - the input key
!!     value - the contents of key mapped to an INTEGER(INT8) vector
        type(key_type), intent(in)              :: key
        integer(int8), allocatable, intent(out) :: value(:)

        value = key % value

    end subroutine get_int8_key


    pure subroutine get_int32_key( key, value )
!! Version: Experimental
!!
!! Gets the contents of the key as an INTEGER(INT32) vector
!! Arguments:
!!     key   - the input key
!!     value - the contents of key mapped to an INTEGER(INT32) vector
        type(key_type), intent(in)              :: key
        integer(int32), allocatable, intent(out) :: value(:)
        
        value = transfer( key % value, value )
        
    end subroutine get_int32_key


    subroutine set_char_key( key, value )
!! Version: Experimental
!!
!! Sets the contents of the key from a CHARACTER string
!! Arguments:
!!     key   - the output key
!!     value - the input CHARACTER string
        type(key_type), intent(out) :: key
        character(*), intent(in)    :: value

        key % value = transfer( value, key % value, &
                                bytes_char * len( value ) )

    end subroutine set_char_key


    subroutine set_other( other, value )
!! Version: Experimental
!!
!! Sets the contents of the other data from a CLASS(*) variable
!! Arguments:
!!     other - the output other data
!!     value - the input CLASS(*) variable
        type(other_type), intent(out) :: other
        class(*), intent(in)          :: value

        allocate(other % value, source=value)

    end subroutine set_other


    subroutine set_int8_key( key, value )
!! Version: Experimental
!!
!! Sets the contents of the key from an INTEGER(INT8) vector
!! Arguments:
!!     key   - the output key
!!     value - the input INTEGER(INT8) vector
        type(key_type), intent(out) :: key
        integer(int8), intent(in)   :: value(:)

        key % value = value

    end subroutine set_int8_key


    pure subroutine set_int32_key( key, value )
!! Version: Experimental
!!
!! Sets the contents of the key from an INTEGER(INT32) vector
!! Arguments:
!!     key   - the output key
!!     value - the input INTEGER(INT32) vector
        type(key_type), intent(out) :: key
        integer(int32), intent(in)   :: value(:)
                
        key % value = transfer(value, key % value)
                
    end subroutine set_int32_key


    pure function fnv_1_hasher( key )
!! Version: Experimental
!!
!! Hashes a key with the FNV_1 algorithm
!! Arguments:
!!     key  - the key to be hashed
        type(key_type), intent(in)    :: key
        integer(int_hash)             :: fnv_1_hasher

        fnv_1_hasher = fnv_1_hash( key % value )

    end function fnv_1_hasher


    pure function fnv_1a_hasher( key )
!! Version: Experimental
!!
!! Hashes a key with the FNV_1a algorithm
!! ([Specifications](../page/specs/stdlib_hashmaps.html#fnv_1a_hasher-calculates-a-hash-code-from-a-key))
!!
!! Arguments:
!!     key  - the key to be hashed
        type(key_type), intent(in)    :: key
        integer(int_hash)             :: fnv_1a_hasher

        fnv_1a_hasher = fnv_1a_hash( key % value )

    end function fnv_1a_hasher


    pure function seeded_nmhash32_hasher( key )
!! Version: Experimental
!!
!! Hashes a key with the NMHASH32 hash algorithm
!! ([Specifications](../page/specs/stdlib_hashmaps.html#seeded_nmhash32_hasher-calculates-a-hash-code-from-a-key))
!!
!! Arguments:
!!     key  - the key to be hashed
!!     seed - the seed (unused) for the hashing algorithm
        type(key_type), intent(in)    :: key
        integer(int_hash)             :: seeded_nmhash32_hasher

        seeded_nmhash32_hasher = nmhash32( key % value, &
            int( z'DEADBEEF', int32 ) )

    end function seeded_nmhash32_hasher


    pure function seeded_nmhash32x_hasher( key )
!! Version: Experimental
!!
!! Hashes a key with the NMHASH32X hash algorithm
!! ([Specifications](../page/specs/stdlib_hashmaps.html#seeded_nmhash32x_hasher-calculates-a-hash-code-from-a-key))
!! Arguments:
!!     key  - the key to be hashed
!!     seed - the seed (unused) for the hashing algorithm
        type(key_type), intent(in)    :: key
        integer(int_hash)             :: seeded_nmhash32x_hasher

        seeded_nmhash32x_hasher = nmhash32x( key % value, &
            int( z'DEADBEEF', int32 ) )

    end function seeded_nmhash32x_hasher


    pure function seeded_water_hasher( key )
!! Version: Experimental
!!
!! Hashes a key with the waterhash algorithm
!! ([Specifications](../page/specs/stdlib_hashmaps.html#seeded_water_hasher-calculates-a-hash-code-from-a-key))
!!
!! Arguments:
!!     key  - the key to be hashed
        type(key_type), intent(in)  :: key
        integer(int_hash)           :: seeded_water_hasher

        seeded_water_hasher = water_hash( key % value, &
            int( z'DEADBEEF1EADBEEF', int64 ) )

    end function seeded_water_hasher


end module stdlib_hashmap_wrappers