diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index d324fa29b..94b42413f 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -157,7 +157,7 @@ Procedures to manipulate `key_type` data: `key_in`, to contents of the key, `key_out`. * `get( key, value )` - extracts the contents of `key` into `value`, - an `int8` array, 'int32' array, or character string. + an `int8` array, `int32` array, or character string. * `free_key( key )` - frees the memory in `key`. @@ -474,9 +474,9 @@ is an `intent(in)` argument. `other`: shall be a scalar expression of type `other_type`. It is an `intent(in)` argument. -`value`: if the the first argument is of `key_type` `value` shall be -an allocatable default character string variable, or -an allocatable vector variable of type integer and kind `int8` or +`value`: if the the first argument is of `key_type`, `value` shall be +an allocatable default `character` string variable, or +an allocatable vector variable of type `integer` and kind `int8` or `int32`, otherwise the first argument is of `other_type` and `value` shall be an allocatable of `class(*)`. It is an `intent(out)` argument. @@ -751,8 +751,8 @@ is an `intent(out)` argument. `other`: shall be a scalar variable of type `other_type`. It is an `intent(out)` argument. -`value`: if the first argument is `key` `value` shall be a default -character string scalar expression, or a vector expression of type integer +`value`: if the first argument is `key`, `value` shall be a default +`character` string scalar expression, or a vector expression of type `integer` and kind `int8` or `int32`, while for a first argument of type `other` `value` shall be of type `class(*)`. It is an `intent(in)` argument. @@ -790,6 +790,14 @@ overall structure and performance of the hash map object:`calls`, `max_bits`, `int_calls`, `int_depth`, `int_index`, `int_probes`, `success`, `alloc_fault`, and `array_size_error`. +Generic key interfaces for `key_test`, `map_entry`, `get_other_data`, +`remove`, and `set_other_data` are povided so that the supported types +of `int8` arrays, `int32` arrays and `character` scalars can be used in the +key field as well as the base `key` type. So for `key_test`, +`key_key_test` specifies key type for the key field, `int8_key_test` is `int8` +for the key field and so on. Procedures other than `key_key_test` will call +the `set` function to generate a key type and pass to `key_key_test`. + ### The `stdlib_hashmaps` module's public constants The module defines several categories of public constants. Some are @@ -924,6 +932,7 @@ The type's definition is below: ```fortran type, abstract :: hashmap_type + private integer(int_calls) :: call_count = 0 integer(int_calls) :: probe_count = 0 @@ -932,22 +941,52 @@ The type's definition is below: integer(int_index) :: num_free = 0 integer(int32) :: nbits = default_bits procedure(hasher_fun), pointer, nopass :: hasher => fnv_1_hasher + contains + procedure, non_overridable, pass(map) :: calls procedure, non_overridable, pass(map) :: entries procedure, non_overridable, pass(map) :: map_probes - procedure, non_overridable, pass(map) :: slots_bits procedure, non_overridable, pass(map) :: num_slots - procedure(get_all_keys), deferred, pass(map) :: get_all_keys - procedure(get_other), deferred, pass(map) :: get_other_data - procedure(init_map), deferred, pass(map) :: init - procedure(key_test), deferred, pass(map) :: key_test - procedure(loading), deferred, pass(map) :: loading - procedure(map_entry), deferred, pass(map) :: map_entry - procedure(rehash_map), deferred, pass(map) :: rehash - procedure(remove_entry), deferred, pass(map) :: remove - procedure(set_other), deferred, pass(map) :: set_other_data - procedure(total_depth), deferred, pass(map) :: total_depth + procedure, non_overridable, pass(map) :: slots_bits + procedure(get_all_keys), deferred, pass(map) :: get_all_keys + procedure(init_map), deferred, pass(map) :: init + procedure(loading), deferred, pass(map) :: loading + procedure(rehash_map), deferred, pass(map) :: rehash + procedure(total_depth), deferred, pass(map) :: total_depth + + !! Generic interfaces for key types. + procedure(key_key_test), deferred, pass(map) :: key_key_test + procedure, non_overridable, pass(map) :: int8_key_test + procedure, non_overridable, pass(map) :: int32_key_test + procedure, non_overridable, pass(map) :: char_key_test + + procedure(key_map_entry), deferred, pass(map) :: key_map_entry + procedure, non_overridable, pass(map) :: int8_map_entry + procedure, non_overridable, pass(map) :: int32_map_entry + procedure, non_overridable, pass(map) :: char_map_entry + + procedure(key_get_other_data), deferred, pass(map) :: key_get_other_data + procedure, non_overridable, pass(map) :: int8_get_other_data + procedure, non_overridable, pass(map) :: int32_get_other_data + procedure, non_overridable, pass(map) :: char_get_other_data + + procedure(key_remove_entry), deferred, pass(map) :: key_remove_entry + procedure, non_overridable, pass(map) :: int8_remove_entry + procedure, non_overridable, pass(map) :: int32_remove_entry + procedure, non_overridable, pass(map) :: char_remove_entry + + procedure(key_set_other_data), deferred, pass(map) :: key_set_other_data + procedure, non_overridable, pass(map) :: int8_set_other_data + procedure, non_overridable, pass(map) :: int32_set_other_data + procedure, non_overridable, pass(map) :: char_set_other_data + + generic, public :: key_test => key_key_test, int8_key_test, int32_key_test, char_key_test + generic, public :: map_entry => key_map_entry, int8_map_entry, int32_map_entry, char_map_entry + generic, public :: get_other_data => key_get_other_data, int8_get_other_data, int32_get_other_data, char_get_other_data + generic, public :: remove => key_remove_entry, int8_remove_entry, int32_remove_entry, char_remove_entry + generic, public :: set_other_data => key_set_other_data, int8_set_other_data, int32_set_other_data, char_set_other_data + end type hashmap_type ``` @@ -1028,21 +1067,21 @@ as follows: ```fortran type, extends(hashmap_type) :: chaining_hashmap_type private - type(chaining_map_entry_pool), pointer :: cache => null() - type(chaining_map_entry_type), pointer :: free_list => null() - type(chaining_map_entry_ptr), allocatable :: inverse(:) + type(chaining_map_entry_pool), pointer :: cache => null() + type(chaining_map_entry_type), pointer :: free_list => null() + type(chaining_map_entry_ptr), allocatable :: inverse(:) type(chaining_map_entry_ptr), allocatable :: slots(:) contains procedure :: get_all_keys => get_all_chaining_keys - procedure :: get_other_data => get_other_chaining_data + procedure :: key_get_other_data => get_other_chaining_data procedure :: init => init_chaining_map - procedure :: key => chaining_key_test procedure :: loading => chaining_loading - procedure :: map_entry => map_chain_entry + procedure :: key_map_entry => map_chain_entry procedure :: rehash => rehash_chaining_map - procedure :: remove => remove_chaining_entry - procedure :: set_other_data => set_other_chaining_data + procedure :: key_remove_entry => remove_chaining_entry + procedure :: key_set_other_data => set_other_chaining_data procedure :: total_depth => total_chaining_depth + procedure :: key_key_test => chaining_key_test final :: free_chaining_map end type chaining_hashmap_type ``` @@ -1103,24 +1142,24 @@ It also implements all of the deferred procedures of the as follows: ```fortran - type, extends(hashmap_type) :: open_hashmap_type - private + type, extends(hashmap_type) :: open_hashmap_type + private integer(int_index) :: index_mask = 2_int_index**default_bits-1 type(open_map_entry_pool), pointer :: cache => null() - type(open_map_entry_list), pointer :: free_list => null() - type(open_map_entry_ptr), allocatable :: inverse(:) - integer(int_index), allocatable :: slots(:) + type(open_map_entry_list), pointer :: free_list => null() + type(open_map_entry_ptr), allocatable :: inverse(:) + integer(int_index), allocatable :: slots(:) contains procedure :: get_all_keys => get_all_open_keys - procedure :: get_other_data => get_other_open_data + procedure :: key_get_other_data => get_other_open_data procedure :: init => init_open_map - procedure :: key_test => open_key_test procedure :: loading => open_loading - procedure :: map_entry => map_open_entry + procedure :: key_map_entry => map_open_entry procedure :: rehash => rehash_open_map - procedure :: remove => remove_open_entry - procedure :: set_other_data => set_other_open_data + procedure :: key_remove_entry => remove_open_entry + procedure :: key_set_other_data => set_other_open_data procedure :: total_depth => total_open_depth + procedure :: key_key_test => open_key_test final :: free_open_map end type open_hashmap_type ``` @@ -1323,8 +1362,8 @@ Subroutine `intent(inout)` argument. It will be the hash map used to store and access the other data. -`key`: shall be a scalar expression of type `key_type`. It - is an `intent(in)` argument. +`key`: shall be a of type `key_type` scalar, `character` scalar, `int8` array +or `int32` array. It is an `intent(in)` argument. `other`: shall be a variable of type `other_data`. It is an `intent(out)` argument. It is the other data associated @@ -1435,9 +1474,9 @@ Subroutine. It is an `intent(inout)` argument. It is the hash map whose entries are examined. -`key`: shall be a scalar expression of type `key_type`. It -is an `intent(in)` argument. It is a `key` whose presence in the `map` -is being examined. +`key`: shall be a of type `key_type` scalar, `character` scalar, `int8` array +or `int32` array. It is an `intent(in)` argument. It is a `key` whose +presence in the `map` is being examined. `present` (optional): shall be a scalar variable of type default `logical`. It is an intent(out) argument. It is a logical flag where @@ -1516,9 +1555,9 @@ Subroutine is an `intent(inout)` argument. It is the hash map to receive the entry. -`key`: shall be a scalar expression of type `key_type`. - It is an `intent(in)` argument. It is the key for the entry to be - placed in the table. +`key`: shall be a of type `key_type` scalar, `character` scalar, `int8` array +or `int32` array. It is an `intent(in)` argument. It is the key for the entry +to be placed in the table. `other` (optional): shall be a scalar expression of type `other_type`. It is an `intent(in)` argument. If present it is the other data to be @@ -1677,9 +1716,9 @@ Subroutine It is an `intent(inout)` argument. It is the hash map with the element to be removed. -`key`: shall be a scalar expression of type `key_type`. It -is an `intent(in)` argument. It is the `key` identifying the entry -to be removed. +`key`: shall be a of type `key_type` scalar, `character` scalar, `int8` array +or `int32` array. It is an `intent(in)` argument. It is the `key` identifying +the entry to be removed. `existed` (optional): shall be a scalar variable of type default logical. It is an `intent(out)` argument. If present with the value @@ -1719,9 +1758,9 @@ Subroutine is an `intent(inout)` argument. It will be a hash map used to store and access the entry's data. -`key`: shall be a scalar expression of type `key_type`. It -is an `intent(in)` argument. It is the `key` to the entry whose -`other` data is to be replaced. +`key`: shall be a of type `key_type` scalar, `character` scalar, `int8` array +or `int32` array. It is an `intent(in)` argument. It is the `key` to the +entry whose `other` data is to be replaced. `other`: shall be a scalar expression of type `other_type`. It is an `intent(in)` argument. It is the data to be stored as diff --git a/example/hashmaps/example_hashmaps_get_all_keys.f90 b/example/hashmaps/example_hashmaps_get_all_keys.f90 index 2188fb181..2a91cd1ab 100644 --- a/example/hashmaps/example_hashmaps_get_all_keys.f90 +++ b/example/hashmaps/example_hashmaps_get_all_keys.f90 @@ -1,7 +1,7 @@ program example_hashmaps_get_all_keys use stdlib_kinds, only: int32 use stdlib_hashmaps, only: chaining_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher, & + use stdlib_hashmap_wrappers, only: fnv_1_hasher, get, & key_type, other_type, set implicit none type(chaining_hashmap_type) :: map @@ -10,6 +10,8 @@ program example_hashmaps_get_all_keys type(key_type), allocatable :: keys(:) integer(int32) :: i + + character(:), allocatable :: str call map%init(fnv_1_hasher) @@ -33,20 +35,11 @@ program example_hashmaps_get_all_keys !Number of keys in the hashmap = 3 do i = 1, size(keys) - print '("Value of key ", I0, " = ", A)', i, key_to_char(keys(i)) + call get( keys(i), str ) + print '("Value of key ", I0, " = ", A)', i, str end do !Value of key 1 = initial key !Value of key 2 = second key !Value of key 3 = last key -contains - !Converts key type to character type - pure function key_to_char(key) result(str) - type(key_type), intent(in) :: key - character(:), allocatable :: str - character(:), allocatable :: str_mold - - allocate( character(len=size(key%value)) :: str_mold ) - str = transfer(key%value, str_mold) - end function key_to_char end program example_hashmaps_get_all_keys diff --git a/example/hashmaps/example_hashmaps_get_other_data.f90 b/example/hashmaps/example_hashmaps_get_other_data.f90 index 1b2df31d7..195857bb7 100644 --- a/example/hashmaps/example_hashmaps_get_other_data.f90 +++ b/example/hashmaps/example_hashmaps_get_other_data.f90 @@ -1,5 +1,5 @@ program example_get_other_data - use stdlib_kinds, only: int8 + use stdlib_kinds, only: int8, int64 use stdlib_hashmaps, only: chaining_hashmap_type, int_index use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type, set, get implicit none @@ -8,15 +8,23 @@ program example_get_other_data type(other_type) :: other type(chaining_hashmap_type) :: map type dummy_type - integer(int8) :: value(4) + integer :: value(4) end type dummy_type type(dummy_type) :: dummy - class(*), allocatable :: data - dummy%value = [4_int8, 3_int8, 2_int8, 1_int8] - allocate (data, source=dummy) + class(*), allocatable :: data + integer(int8), allocatable :: key_array(:) + integer :: int_scalar + + ! Initialize hashmap call map%init(fnv_1_hasher) - call set(key, [0_int8, 1_int8, 2_int8, 3_int8, 4_int8]) - call set(other, data) + + ! Hashmap functions are setup to store scalar value types (other). Use a dervied + ! type wrapper to store arrays. + dummy%value = [4, 3, 2, 1] + call set(other, dummy) + + ! Explicitly set key type using set function + call set(key, [0, 1]) call map%map_entry(key, other, conflict) if (.not. conflict) then call map%get_other_data(key, other) @@ -30,4 +38,68 @@ program example_get_other_data class default print *, 'Invalid data type in other' end select + +! Also can use map_entry and get_other_data generic key interfaces. +! This is an exmple with integer arrays. + call map%map_entry( [2,3], other, conflict) + if (.not. conflict) then + call map%get_other_data( [2,3], other) + else + error stop 'Key is already present in the map.' + end if + call get(other, data) + select type (data) + type is (dummy_type) + print *, 'Other data % value = ', data%value + class default + print *, 'Invalid data type in other' + end select + + ! Integer scalars need to be passed as an array. + int_scalar = 2 + call map%map_entry( [int_scalar], other, conflict) + if (.not. conflict) then + call map%get_other_data( [int_scalar], other) + else + error stop 'Key is already present in the map.' + end if + call get(other, data) + select type (data) + type is (dummy_type) + print *, 'Other data % value = ', data%value + class default + print *, 'Invalid data type in other' + end select + + ! Example using character type key interface + call map%map_entry( 'key_string', other, conflict) + if (.not. conflict) then + call map%get_other_data( 'key_string', other) + else + error stop 'Key is already present in the map.' + end if + call get(other, data) + select type (data) + type is (dummy_type) + print *, 'Other data % value = ', data%value + class default + print *, 'Invalid data type in other' + end select + +! Transfer to int8 arrays to generate key for unsupported types. + key_array = transfer( [0_int64, 1_int64], [0_int8] ) + call map%map_entry( key_array, other, conflict) + if (.not. conflict) then + call map%get_other_data( key_array, other) + else + error stop 'Key is already present in the map.' + end if + call get(other, data) + select type (data) + type is (dummy_type) + print *, 'Other data % value = ', data%value + class default + print *, 'Invalid data type in other' + end select + end program example_get_other_data diff --git a/example/hashmaps/example_hashmaps_map_entry.f90 b/example/hashmaps/example_hashmaps_map_entry.f90 index 0136931e9..9ad2e7b7a 100644 --- a/example/hashmaps/example_hashmaps_map_entry.f90 +++ b/example/hashmaps/example_hashmaps_map_entry.f90 @@ -1,5 +1,5 @@ program example_map_entry - use, intrinsic:: iso_fortran_env, only: int8 + use, intrinsic:: iso_fortran_env, only: int8, int64 use stdlib_hashmaps, only: chaining_hashmap_type use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type, set implicit none @@ -7,11 +7,37 @@ program example_map_entry type(key_type) :: key logical :: conflict type(other_type) :: other - class(*), allocatable :: dummy - allocate (dummy, source=4) + integer :: int_scalar + + ! Initialize hashmap with 2^10 slots. + ! Hashmap will dynamically increase size if needed. call map%init(fnv_1_hasher, slots_bits=10) - call set(key, [5_int8, 7_int8, 4_int8, 13_int8]) - call set(other, dummy) + ! Initialize other type with data to store. + call set(other, 4) + + ! Explicitly set key using set function + call set(key, [1, 2, 3]) call map%map_entry(key, other, conflict) print *, 'CONFLICT = ', conflict + + ! Using map_entry int32 array interface + call map%map_entry( [4, 5, 6], other, conflict) + print *, 'CONFLICT = ', conflict + + ! Integer scalars need to be passed as an array. + int_scalar = 1 + call map%map_entry( [int_scalar], other, conflict) + print *, 'CONFLICT = ', conflict + + ! Using map_entry character interface + call map%map_entry( 'key_string', other, conflict) + print *, 'CONFLICT = ', conflict + + ! Transfer unsupported key types to int8 arrays. + call map%map_entry( transfer( [1_int64, 2_int64, 3_int64], [0_int8] ), other, conflict) + print *, 'CONFLICT = ', conflict + +! Keys can be mapped alone without a corresponding value (other). + call map%map_entry( [7, 8, 9], conflict=conflict) + print *, 'CONFLICT = ', conflict end program example_map_entry diff --git a/example/hashmaps/example_hashmaps_remove.f90 b/example/hashmaps/example_hashmaps_remove.f90 index 7a7c39a5d..3bac098f5 100644 --- a/example/hashmaps/example_hashmaps_remove.f90 +++ b/example/hashmaps/example_hashmaps_remove.f90 @@ -1,5 +1,5 @@ program example_remove - use stdlib_kinds, only: int8 + use stdlib_kinds, only: int8, int64 use stdlib_hashmaps, only: open_hashmap_type, int_index use stdlib_hashmap_wrappers, only: fnv_1_hasher, & fnv_1a_hasher, key_type, other_type, set @@ -8,12 +8,39 @@ program example_remove type(key_type) :: key type(other_type) :: other logical :: existed - class(*), allocatable :: dummy - allocate (dummy, source=4.0) + integer :: int_scalar + + ! Initialize hashmap with 2^10 slots. + ! Hashmap will dynamically increase size if needed. call map%init(fnv_1_hasher, slots_bits=10) - call set(key, [5_int8, 7_int8, 4_int8, 13_int8]) - call set(other, dummy) + + ! Initialize other type with data to store. + call set(other, 4.0) + + ! Explicitly set key type using set function + call set(key, [1, 2, 3]) call map%map_entry(key, other) call map%remove(key, existed) print *, "Removed key existed = ", existed + + ! Using map_entry and remove int32 generic interface. + call map%map_entry([1, 2, 3], other) + call map%remove([1, 2, 3], existed) + print *, "Removed key existed = ", existed + + ! Integer scalars need to be passed as an array. + int_scalar = 1 + call map%map_entry( [int_scalar], other) + call map%remove( [int_scalar], existed) + print *, "Removed key existed = ", existed + + ! Using map_entry and remove character generic interface. + call map%map_entry('key_string', other) + call map%remove('key_string', existed) + print *, "Removed key existed = ", existed + + ! Use transfer to int8 arrays for unsupported key types. + call map%map_entry( transfer( [1_int64, 2_int64], [0_int8] ), other) + call map%remove( transfer( [1_int64,2_int64], [0_int8] ), existed) + print *, "Removed key existed = ", existed end program example_remove diff --git a/example/hashmaps/example_hashmaps_set_other_data.f90 b/example/hashmaps/example_hashmaps_set_other_data.f90 index fbc3863f7..133ab994e 100644 --- a/example/hashmaps/example_hashmaps_set_other_data.f90 +++ b/example/hashmaps/example_hashmaps_set_other_data.f90 @@ -8,15 +8,16 @@ program example_set_other_data type(open_hashmap_type) :: map type(key_type) :: key type(other_type) :: other - class(*), allocatable :: dummy + + ! Initialize hashmap with 2^10 slots. + ! Hashmap will dynamically increase size if needed. call map%init(fnv_1_hasher, slots_bits=10) - allocate (dummy, source='A value') - call set(key, [5_int8, 7_int8, 4_int8, 13_int8]) - call set(other, dummy) + call set(key, [5, 7, 4, 13]) + call set(other, 'A value') call map%map_entry(key, other) - deallocate (dummy) - allocate (dummy, source='Another value') - call set(other, dummy) + + call set(other, 'Another value') call map%set_other_data(key, other, exists) print *, 'The entry to have its other data replaced exists = ', exists + end program example_set_other_data diff --git a/src/stdlib_hashmaps.f90 b/src/stdlib_hashmaps.f90 index 4b3044583..d7da35dea 100644 --- a/src/stdlib_hashmaps.f90 +++ b/src/stdlib_hashmaps.f90 @@ -16,7 +16,24 @@ module stdlib_hashmaps int32, & int64 - use stdlib_hashmap_wrappers + use stdlib_hashmap_wrappers, only: & + 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, & + key_type, & + other_type, & + int_hash implicit none @@ -88,23 +105,52 @@ module stdlib_hashmaps !! Hash function contains - procedure, non_overridable, pass(map) :: calls procedure, non_overridable, pass(map) :: entries procedure, non_overridable, pass(map) :: map_probes procedure, non_overridable, pass(map) :: num_slots procedure, non_overridable, pass(map) :: slots_bits - procedure(get_all_keys), deferred, pass(map) :: get_all_keys - procedure(get_other), deferred, pass(map) :: get_other_data - procedure(init_map), deferred, pass(map) :: init - procedure(key_test), deferred, pass(map) :: key_test - procedure(loading), deferred, pass(map) :: loading - procedure(map_entry), deferred, pass(map) :: map_entry - procedure(rehash_map), deferred, pass(map) :: rehash - procedure(remove_entry), deferred, pass(map) :: remove - procedure(set_other), deferred, pass(map) :: set_other_data - procedure(total_depth), deferred, pass(map) :: total_depth - + procedure(get_all_keys), deferred, pass(map) :: get_all_keys + procedure(init_map), deferred, pass(map) :: init + procedure(loading), deferred, pass(map) :: loading + procedure(rehash_map), deferred, pass(map) :: rehash + procedure(total_depth), deferred, pass(map) :: total_depth + + !! Key_test procedures. + procedure(key_key_test), deferred, pass(map) :: key_key_test + procedure, non_overridable, pass(map) :: int8_key_test + procedure, non_overridable, pass(map) :: int32_key_test + procedure, non_overridable, pass(map) :: char_key_test + generic, public :: key_test => key_key_test, int8_key_test, int32_key_test, char_key_test + + ! Map_entry procedures + procedure(key_map_entry), deferred, pass(map) :: key_map_entry + procedure, non_overridable, pass(map) :: int8_map_entry + procedure, non_overridable, pass(map) :: int32_map_entry + procedure, non_overridable, pass(map) :: char_map_entry + generic, public :: map_entry => key_map_entry, int8_map_entry, int32_map_entry, char_map_entry + + ! Get_other_data procedures + procedure(key_get_other_data), deferred, pass(map) :: key_get_other_data + procedure, non_overridable, pass(map) :: int8_get_other_data + procedure, non_overridable, pass(map) :: int32_get_other_data + procedure, non_overridable, pass(map) :: char_get_other_data + generic, public :: get_other_data => key_get_other_data, int8_get_other_data, int32_get_other_data, char_get_other_data + + ! Key_remove_entry procedures + procedure(key_remove_entry), deferred, pass(map) :: key_remove_entry + procedure, non_overridable, pass(map) :: int8_remove_entry + procedure, non_overridable, pass(map) :: int32_remove_entry + procedure, non_overridable, pass(map) :: char_remove_entry + generic, public :: remove => key_remove_entry, int8_remove_entry, int32_remove_entry, char_remove_entry + + ! Set_other_data procedures + procedure(key_set_other_data), deferred, pass(map) :: key_set_other_data + procedure, non_overridable, pass(map) :: int8_set_other_data + procedure, non_overridable, pass(map) :: int32_set_other_data + procedure, non_overridable, pass(map) :: char_set_other_data + generic, public :: set_other_data => key_set_other_data, int8_set_other_data, int32_set_other_data, char_set_other_data + end type hashmap_type @@ -125,7 +171,7 @@ subroutine get_all_keys(map, all_keys) type(key_type), allocatable, intent(out) :: all_keys(:) end subroutine get_all_keys - subroutine get_other( map, key, other, exists ) + subroutine key_get_other_data( map, key, other, exists ) !! Version: Experimental !! !! Returns the other data associated with the inverse table index @@ -140,7 +186,7 @@ subroutine get_other( map, key, other, exists ) type(key_type), intent(in) :: key type(other_type), intent(out) :: other logical, intent(out), optional :: exists - end subroutine get_other + end subroutine key_get_other_data subroutine init_map( map, & hasher, & @@ -171,7 +217,7 @@ subroutine init_map( map, & integer(int32), intent(out), optional :: status end subroutine init_map - subroutine key_test(map, key, present) + subroutine key_key_test(map, key, present) !! Version: Experimental !! !! Returns a logical flag indicating whether KEY exists in the hash map @@ -186,8 +232,9 @@ subroutine key_test(map, key, present) class(hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key logical, intent(out) :: present - end subroutine key_test - + end subroutine key_key_test + + pure function loading( map ) !! Version: Experimental !! @@ -201,7 +248,7 @@ pure function loading( map ) real :: loading end function loading - subroutine map_entry(map, key, other, conflict) + subroutine key_map_entry(map, key, other, conflict) !! Version: Experimental !! !! Inserts an entry into the hash table @@ -212,7 +259,7 @@ subroutine map_entry(map, key, other, conflict) type(key_type), intent(in) :: key type(other_type), intent(in), optional :: other logical, intent(out), optional :: conflict - end subroutine map_entry + end subroutine key_map_entry subroutine rehash_map( map, hasher ) !! Version: Experimental @@ -227,7 +274,7 @@ subroutine rehash_map( map, hasher ) procedure(hasher_fun) :: hasher end subroutine rehash_map - subroutine remove_entry(map, key, existed) ! Chase's delent + subroutine key_remove_entry(map, key, existed) ! Chase's delent !! Version: Experimental !! !! Remove the entry, if any, that has the key @@ -241,9 +288,9 @@ subroutine remove_entry(map, key, existed) ! Chase's delent class(hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key logical, intent(out), optional :: existed - end subroutine remove_entry + end subroutine key_remove_entry - subroutine set_other( map, key, other, exists ) + subroutine key_set_other_data( map, key, other, exists ) !! Version: Experimental !! !! Change the other data associated with the key @@ -260,7 +307,7 @@ subroutine set_other( map, key, other, exists ) type(key_type), intent(in) :: key type(other_type), intent(in) :: other logical, intent(out), optional :: exists - end subroutine set_other + end subroutine key_set_other_data function total_depth( map ) !! Version: Experimental @@ -336,15 +383,15 @@ end function total_depth !! Array of bucket lists Note # slots=size(slots) contains procedure :: get_all_keys => get_all_chaining_keys - procedure :: get_other_data => get_other_chaining_data + procedure :: key_get_other_data => get_other_chaining_data procedure :: init => init_chaining_map procedure :: loading => chaining_loading - procedure :: map_entry => map_chain_entry + procedure :: key_map_entry => map_chain_entry procedure :: rehash => rehash_chaining_map - procedure :: remove => remove_chaining_entry - procedure :: set_other_data => set_other_chaining_data + procedure :: key_remove_entry => remove_chaining_entry + procedure :: key_set_other_data => set_other_chaining_data procedure :: total_depth => total_chaining_depth - procedure :: key_test => chaining_key_test + procedure :: key_key_test => chaining_key_test final :: free_chaining_map end type chaining_hashmap_type @@ -587,15 +634,15 @@ end function total_chaining_depth !! Array of indices to the inverse Note # slots=size(slots) contains procedure :: get_all_keys => get_all_open_keys - procedure :: get_other_data => get_other_open_data + procedure :: key_get_other_data => get_other_open_data procedure :: init => init_open_map procedure :: loading => open_loading - procedure :: map_entry => map_open_entry + procedure :: key_map_entry => map_open_entry procedure :: rehash => rehash_open_map - procedure :: remove => remove_open_entry - procedure :: set_other_data => set_other_open_data + procedure :: key_remove_entry => remove_open_entry + procedure :: key_set_other_data => set_other_open_data procedure :: total_depth => total_open_depth - procedure :: key_test => open_key_test + procedure :: key_key_test => open_key_test final :: free_open_map end type open_hashmap_type @@ -770,9 +817,348 @@ end function total_open_depth end interface -contains + + contains + + + subroutine int8_get_other_data( map, value, other, exists ) +!! Version: Experimental +!! +!! Int8 key generic interface for get_other_data function + + class(hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: value(:) + type(other_type), intent(out) :: other + logical, intent(out), optional :: exists + + type(key_type) :: key + + call set( key, value ) + + call map % key_get_other_data( key, other, exists ) + + end subroutine int8_get_other_data + + + subroutine int32_get_other_data( map, value, other, exists ) +!! Version: Experimental +!! +!! Int32 key generic interface for get_other_data function + + class(hashmap_type), intent(inout) :: map + integer(int32), intent(in) :: value(:) + type(other_type), intent(out) :: other + logical, intent(out), optional :: exists + + type(key_type) :: key + + call set( key, value ) + + call map % key_get_other_data( key, other, exists ) + + end subroutine int32_get_other_data + + + subroutine char_get_other_data( map, value, other, exists ) +!! Version: Experimental +!! +!! Character key generic interface for get_other_data function + + class(hashmap_type), intent(inout) :: map + character(*), intent(in) :: value + type(other_type), intent(out) :: other + logical, intent(out), optional :: exists + + type(key_type) :: key + + call set( key, value ) + + call map % key_get_other_data( key, other, exists ) + + end subroutine char_get_other_data + + + subroutine int8_remove_entry(map, value, existed) ! Chase's delent +!! Version: Experimental +!! +!! Remove the entry, if any, that has the key +!! Arguments: +!! map - the table from which the entry is to be removed +!! value - the int8 array key to an entry +!! existed - a logical flag indicating whether an entry with the key +!! was present in the original map +! + class(hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: value(:) + logical, intent(out), optional :: existed + + type(key_type) :: key + + call set( key, value ) + + call map % key_remove_entry( key, existed ) + + end subroutine int8_remove_entry + + + subroutine int32_remove_entry(map, value, existed) ! Chase's delent +!! Version: Experimental +!! +!! 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(hashmap_type), intent(inout) :: map + integer(int32), intent(in) :: value(:) + logical, intent(out), optional :: existed + + type(key_type) :: key + + call set( key, value ) + + call map % key_remove_entry( key, existed ) + + end subroutine int32_remove_entry + + + subroutine char_remove_entry(map, value, existed) ! Chase's delent +!! Version: Experimental +!! +!! 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(hashmap_type), intent(inout) :: map + character(*), intent(in) :: value + logical, intent(out), optional :: existed + + type(key_type) :: key + + call set( key, value ) + + call map % key_remove_entry( key, existed ) + + end subroutine char_remove_entry + + + subroutine int8_map_entry(map, value, other, conflict) + !! Version: Experimental + !! Int8 generic interface for map entry + !! ([Specifications](../page/specs/stdlib_hashmaps.html#map_entry-inserts-an-entry-into-the-hash-map)) + !! + class(hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: value(:) + type(other_type), intent(in), optional :: other + logical, intent(out), optional :: conflict + + type(key_type) :: key + + call set( key, value ) + + call map % key_map_entry( key, other, conflict ) + + end subroutine int8_map_entry + + + subroutine int32_map_entry(map, value, other, conflict) +!! Version: Experimental +!! +!! Inserts an entry into the hash table +!! ([Specifications](../page/specs/stdlib_hashmaps.html#map_entry-inserts-an-entry-into-the-hash-map)) +!! + class(hashmap_type), intent(inout) :: map + integer(int32), intent(in) :: value(:) + type(other_type), intent(in), optional :: other + logical, intent(out), optional :: conflict + + type(key_type) :: key + + call set( key, value ) + + call map % key_map_entry( key, other, conflict ) + + end subroutine int32_map_entry + + + subroutine char_map_entry(map, value, other, conflict) +!! Version: Experimental +!! +!! Inserts an entry into the hash table +!! ([Specifications](../page/specs/stdlib_hashmaps.html#map_entry-inserts-an-entry-into-the-hash-map)) +!! + class(hashmap_type), intent(inout) :: map + character(len=*), intent(in) :: value + type(other_type), intent(in), optional :: other + logical, intent(out), optional :: conflict + + type(key_type) :: key + + call set( key, value ) + + call map % key_map_entry( key, other, conflict ) + + end subroutine char_map_entry + + + subroutine int8_key_test(map, value, present) +!! Version: Experimental +!! +!! Returns a logical flag indicating whether KEY exists in the hash map +!! ([Specifications](../page/specs/stdlib_hashmaps.html#key_test-indicates-whether-key-is-present)) +!! +!! Arguments: +!! map - the hash map of interest +!! value - int8 array that is the key to lookup. +!! present - a flag indicating whether key is present in the map +! + class(hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: value(:) + logical, intent(out) :: present + + type(key_type) :: key + + ! Generate key from int8 array. + call set( key, value ) + + ! Call key test procedure. + call map % key_key_test( key, present ) + + end subroutine int8_key_test + + + subroutine int32_key_test(map, value, present) +!! Version: Experimental +!! +!! Returns a logical flag indicating whether KEY exists in the hash map +!! ([Specifications](../page/specs/stdlib_hashmaps.html#key_test-indicates-whether-key-is-present)) +!! +!! Arguments: +!! map - the hash map of interest +!! value - int32 array that is the key to lookup. +!! present - a flag indicating whether key is present in the map +! + class(hashmap_type), intent(inout) :: map + integer(int32), intent(in) :: value(:) + logical, intent(out) :: present + + type(key_type) :: key + + call set( key, value ) + + call map % key_key_test( key, present ) - pure function calls( map ) + end subroutine int32_key_test + + + subroutine char_key_test(map, value, present) +!! Version: Experimental +!! +!! Returns a logical flag indicating whether KEY exists in the hash map +!! ([Specifications](../page/specs/stdlib_hashmaps.html#key_test-indicates-whether-key-is-present)) +!! +!! Arguments: +!! map - the hash map of interest +!! value - char array that is the key to lookup. +!! present - a flag indicating whether key is present in the map +! + class(hashmap_type), intent(inout) :: map + character(*), intent(in) :: value + logical, intent(out) :: present + + type(key_type) :: key + + call set( key, value ) + + call map % key_key_test( key, present ) + + end subroutine char_key_test + + + subroutine int8_set_other_data( map, value, other, exists ) +!! Version: Experimental +!! +!! Change the other data associated with the key +!! Arguments: +!! map - the map with the entry of interest +!! value - the int8 array 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(hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: value(:) + type(other_type), intent(in) :: other + logical, intent(out), optional :: exists + + type(key_type) :: key + + call set( key, value ) + + call map % key_set_other_data( key, other, exists ) + + end subroutine int8_set_other_data + + + subroutine int32_set_other_data( map, value, other, exists ) +!! Version: Experimental +!! +!! Change the other data associated with the key +!! Arguments: +!! map - the map with the entry of interest +!! value - the int32 array 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(hashmap_type), intent(inout) :: map + integer(int32), intent(in) :: value(:) + type(other_type), intent(in) :: other + logical, intent(out), optional :: exists + + type(key_type) :: key + + call set( key, value ) + + call map % key_set_other_data( key, other, exists ) + + end subroutine int32_set_other_data + + + subroutine char_set_other_data( map, value, other, exists ) +!! Version: Experimental +!! +!! Change the other data associated with the key +!! Arguments: +!! map - the map with the entry of interest +!! value - the char value 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(hashmap_type), intent(inout) :: map + character(*), intent(in) :: value + type(other_type), intent(in) :: other + logical, intent(out), optional :: exists + + type(key_type) :: key + + call set( key, value ) + + call map % key_set_other_data( key, other, exists ) + + end subroutine char_set_other_data + + + pure function calls( map ) !! Version: Experimental !! !! Returns the number of subroutine calls on an open hash map @@ -780,14 +1166,14 @@ pure function calls( map ) !! !! Arguments: !! map - an open hash map - class(hashmap_type), intent(in) :: map - integer(int_calls) :: calls + class(hashmap_type), intent(in) :: map + integer(int_calls) :: calls - calls = map % call_count + calls = map % call_count - end function calls + end function calls - pure function entries( map ) + pure function entries( map ) !! Version: Experimental !! !! Returns the number of entries in a hash map @@ -795,15 +1181,15 @@ pure function entries( map ) !! !! Arguments: !! map - an open hash map - class(hashmap_type), intent(in) :: map - integer(int_index) :: entries + class(hashmap_type), intent(in) :: map + integer(int_index) :: entries - entries = map % num_entries + entries = map % num_entries - end function entries + end function entries - pure function map_probes( map ) + pure function map_probes( map ) !! Version: Experimental !! !! Returns the total number of table probes on a hash map @@ -811,15 +1197,15 @@ pure function map_probes( map ) !! !! Arguments: !! map - an open hash map - class(hashmap_type), intent(in) :: map - integer(int_calls) :: map_probes + class(hashmap_type), intent(in) :: map + integer(int_calls) :: map_probes - map_probes = map % total_probes + map % probe_count + map_probes = map % total_probes + map % probe_count - end function map_probes + end function map_probes - pure function num_slots( map ) + pure function num_slots( map ) !! Version: Experimental !! !! Returns the number of allocated slots in a hash map @@ -827,15 +1213,15 @@ pure function num_slots( map ) !! !! Arguments: !! map - an open hash map - class(hashmap_type), intent(in) :: map - integer(int_index) :: num_slots + class(hashmap_type), intent(in) :: map + integer(int_index) :: num_slots - num_slots = 2**map % nbits + num_slots = 2**map % nbits - end function num_slots + end function num_slots - pure function slots_bits( map ) + pure function slots_bits( map ) !! Version: Experimental !! !! Returns the number of bits used to specify the number of allocated @@ -844,12 +1230,12 @@ pure function slots_bits( map ) !! !! Arguments: !! map - an open hash map - class(hashmap_type), intent(in) :: map - integer :: slots_bits + class(hashmap_type), intent(in) :: map + integer :: slots_bits - slots_bits = map % nbits + slots_bits = map % nbits - end function slots_bits + end function slots_bits end module stdlib_hashmaps diff --git a/test/hashmaps/test_maps.fypp b/test/hashmaps/test_maps.fypp index 5498ebc2e..4de9aa334 100644 --- a/test/hashmaps/test_maps.fypp +++ b/test/hashmaps/test_maps.fypp @@ -24,11 +24,13 @@ module test_stdlib_chaining_maps integer, parameter :: test_size = rand_size*4 integer, parameter :: test_16 = 2**4 integer, parameter :: test_256 = 2**8 - ! key_type = 2 to support int8 and int32 key types tested. Can be + ! key_type = 5 to support int8 and int32 key types tested. Can be ! increased to generate additional unique int8 vectors additional key types. - integer, parameter :: key_types = 2 + integer, parameter :: key_types = 5 + character(len=16) :: char_size public :: collect_stdlib_chaining_maps + contains !> Collect all exported unit tests @@ -129,7 +131,19 @@ contains ! Use transfer to create int32 vector from generated int8 vector. call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), [0_int32] ) ) call map % map_entry( key, other, conflict ) - call check(error, .not.conflict, "Unable to map int32 entry because of a key conflict.") + call check(error, .not.conflict, "Unable to map chaining int32 entry because of a key conflict.") + + ! Test int8 key generic interface + call map % map_entry( test_8_bits( index2:index2+test_block-1, 3 ), other, conflict ) + call check(error, .not.conflict, "Unable to map chaining int8 generic interface") + + ! Test int32 key generic interface + call map % map_entry( transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ), other, conflict ) + call check(error, .not.conflict, "Unable to map chaining int32 generic interface") + + ! Test char key generic interface + call map % map_entry( transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ), other, conflict ) + call check(error, .not.conflict, "Unable to map chaining character generic interface") if (allocated(error)) return end do @@ -154,6 +168,15 @@ contains call map % key_test( key, present ) call check(error, present, "Int32 KEY not found in map KEY_TEST.") + call map % key_test( test_8_bits( index2:index2+test_block-1, 3 ), present ) + call check(error, present, "Int8 KEY generic interface not found in map KEY_TEST.") + + call map % key_test( transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ), present ) + call check(error, present, "Int32 KEY generic interface not found in map KEY_TEST.") + + call map % key_test( transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ), present ) + call check(error, present, "Char KEY generic interface not found in map KEY_TEST.") + if (allocated(error)) return end do @@ -177,6 +200,15 @@ contains call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), [0_int32] ) ) call map % get_other_data( key, other, exists ) call check(error, exists, "Unable to get data because int32 key not found in map.") + + call map % get_other_data( test_8_bits( index2:index2+test_block-1, 3 ), other, exists ) + call check(error, exists, "Unable to get data because int8 generic interface key not found in map.") + + call map % get_other_data( transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ) , other, exists ) + call check(error, exists, "Unable to get data because int32 generic interface key not found in map.") + + call map % get_other_data( transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ) , other, exists ) + call check(error, exists, "Unable to get data because character generic interface key not found in map.") end do end subroutine @@ -198,6 +230,15 @@ contains call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), [0_int32] ) ) call map % remove(key, existed) call check(error, existed, "Int32 Key not found in entry removal.") + + call map % remove(test_8_bits( index2:index2+test_block-1, 3 ), existed) + call check(error, existed, "Int8 Key generic interface not found in entry removal.") + + call map % remove(transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ), existed) + call check(error, existed, "Int32 Key generic interface not found in entry removal.") + + call map % remove(transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ), existed) + call check(error, existed, "Character Key generic interface not found in entry removal.") end do end subroutine @@ -277,9 +318,10 @@ module test_stdlib_open_maps integer, parameter :: test_size = rand_size*4 integer, parameter :: test_16 = 2**4 integer, parameter :: test_256 = 2**8 - ! key_type = 2 to support int8 and int32 key types tested. Can be + ! key_type = 5 to support int8 and int32 key types tested. Can be ! increased to generate additional unique int8 vectors additional key types. - integer, parameter :: key_types = 2 + integer, parameter :: key_types = 5 + character(len=16) :: char_size public :: collect_stdlib_open_maps @@ -386,6 +428,18 @@ contains call map % map_entry( key, other, conflict ) call check(error, .not.conflict, "Unable to map int32 entry because of a key conflict.") + ! Test int8 generic key interface + call map % map_entry( test_8_bits( index2:index2+test_block-1, 3 ), other, conflict ) + call check(error, .not.conflict, "Unable to map int8 generic key interface entry because of a key conflict.") + + ! Test int32 key generic interface + call map % map_entry( transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ), other, conflict ) + call check(error, .not.conflict, "Unable to map open int32 generic key interface entry because of a key conflict.") + + ! Test character key generic interface + call map % map_entry( transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ), other, conflict ) + call check(error, .not.conflict, "Unable to map open character generic key interface entry because of a key conflict.") + if (allocated(error)) return end do @@ -410,6 +464,15 @@ contains call map % key_test( key, present ) call check(error, present, "Int32 KEY not found in map KEY_TEST.") + call map % key_test( test_8_bits( index2:index2+test_block-1, 3 ), present ) + call check(error, present, "Int8 KEY generic interface not found in map KEY_TEST.") + + call map % key_test( transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ), present ) + call check(error, present, "Int32 KEY generic interface not found in map KEY_TEST.") + + call map % key_test( transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ), present ) + call check(error, present, "Character KEY generic interface not found in map KEY_TEST.") + if (allocated(error)) return end do @@ -433,6 +496,15 @@ contains call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), [0_int32] ) ) call map % get_other_data( key, other, exists ) call check(error, exists, "Unable to get data because int32 key not found in map.") + + call map % get_other_data( test_8_bits( index2:index2+test_block-1, 3 ), other, exists ) + call check(error, exists, "Unable to get data because int8 generic interface key not found in map.") + + call map % get_other_data( transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ), other, exists ) + call check(error, exists, "Unable to get data because int32 generic interface key not found in map.") + + call map % get_other_data( transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ), other, exists ) + call check(error, exists, "Unable to get data because character generic interface key not found in map.") end do end subroutine @@ -454,6 +526,15 @@ contains call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), [0_int32] ) ) call map % remove(key, existed) call check(error, existed, "Int32 Key not found in entry removal.") + + call map % remove( test_8_bits( index2:index2+test_block-1, 3 ), existed) + call check(error, existed, "Int8 Key generic interface not found in entry removal.") + + call map % remove(transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ), existed) + call check(error, existed, "Int32 Key generic interface not found in entry removal.") + + call map % remove(transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ), existed) + call check(error, existed, "Character Key generic interface not found in entry removal.") end do end subroutine