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`.

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