From 7fcc8e4e995385e244907aaa73c8c81ed457748b Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Mon, 28 Apr 2025 22:51:31 -0400 Subject: [PATCH 1/2] Initial commit --- doc/specs/stdlib_hashmaps.md | 94 +++--- .../example_hashmaps_get_all_keys.f90 | 9 +- .../example_hashmaps_get_other_data.f90 | 51 ++-- .../hashmaps/example_hashmaps_map_entry.f90 | 16 +- src/stdlib_hashmap_wrappers.f90 | 54 ++-- src/stdlib_hashmaps.f90 | 288 ++++++------------ 6 files changed, 198 insertions(+), 314 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 92de955c4..6409f7e2f 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -145,13 +145,12 @@ 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`. -* `set( key, value )` - sets the content of `key` to `value`. - Supported key types are `int8` array, `int32` array, and character - string. +* `set( key, value )` - sets key type `key` based on `value`. + Value may be a scalar or rank-1 array of any type. Procedures to hash keys to 32 bit integers: @@ -409,7 +408,7 @@ Pure function prototype ##### Argument -`key`: Shall be a rank one array expression of type `integer(int8)`. +`key`: Shall be a rank-1 array expression of type `integer(int8)`. It is an `intent(in)` argument. ##### Result character @@ -646,14 +645,13 @@ Subroutine. `key`: shall be a scalar variable of type `key_type`. It is an `intent(out)` argument. -`value`: shall be a default `character` string scalar expression, -or a vector expression of type `integer`and kind `int8` or `int32`. +`value`: shall be a scalar or rank-1 array of any type. It is an `intent(in)` argument. ##### Note -Values of types other than a scalar default character or and -`int8` or `int32` vector can be used as the basis of a `key` by transferring the +Values of types not supported such as rank-2 or higher arrays +can be used as the basis of a `key` by transferring the value to an `int8` vector. ##### Example @@ -684,12 +682,14 @@ overall structure and performance of the hash map object:`calls`, `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`. +`remove`, and `set_other_data` are povided so that scalar and rank-1 +values of any type can be provided as well as the base `key` type. +So for `key_test`, `scalar_key_test` and `rank_one_key_test` are the generic +interfaces for scalar and rank-1 values. A `key_type` will be generated +based on those values and passed to `key_key_test`. If a key_type already +is available, then `key_key_test` can be used instead of the generic `key_test` +interface and may have slightly better performance since there is no +select type construct used. ### The `stdlib_hashmaps` module's public constants @@ -850,37 +850,35 @@ The type's definition is below: procedure(rehash_map), deferred, pass(map) :: rehash procedure(total_depth), deferred, pass(map) :: total_depth - !! Generic interfaces for key types. + !! 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 + procedure, non_overridable, pass(map) :: scalar_key_test + procedure, non_overridable, pass(map) :: rank_one_key_test + generic, public :: key_test => scalar_key_test, rank_one_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 + procedure, non_overridable, pass(map) :: scalar_map_entry + procedure, non_overridable, pass(map) :: rank_one_map_entry + generic, public :: map_entry => scalar_map_entry, rank_one_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 + ! Get_other_data procedures + procedure(key_get_other_data), deferred, pass(map) :: key_get_other_data + procedure, non_overridable, pass(map) :: scalar_get_other_data + procedure, non_overridable, pass(map) :: rank_one_get_other_data + generic, public :: get_other_data => scalar_get_other_data, rank_one_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 + procedure, non_overridable, pass(map) :: scalar_remove_entry + procedure, non_overridable, pass(map) :: rank_one_remove_entry + generic, public :: remove => scalar_remove_entry, rank_one_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 :: 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 + procedure, non_overridable, pass(map) :: scalar_set_other_data + procedure, non_overridable, pass(map) :: rank_one_set_other_data + generic, public :: set_other_data => scalar_set_other_data, rank_one_set_other_data end type hashmap_type ``` @@ -1263,8 +1261,8 @@ Subroutine `intent(inout)` argument. It will be the hash map used to store and access the other data. -`key`: shall be a of type `key_type` scalar, `character` scalar, `int8` array -or `int32` array. It is an `intent(in)` argument. +`key`: shall be a scalar or rank-1 array of any type. +It is an `intent(in)` argument. `other`: shall be a allocatable unlimited polymorphic scalar. (class(*), allocatable) It is an `intent(out)` argument. @@ -1375,8 +1373,8 @@ Subroutine. It is an `intent(inout)` argument. It is the hash map whose entries are 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 +`key`: shall be a scalar or rank-1 array of any type. +It is an `intent(in)` argument. It is a `key` whose presence in the `map` is being examined. `present`: shall be a scalar variable of type `logical`. @@ -1456,8 +1454,8 @@ Subroutine is an `intent(inout)` argument. It is the hash map to receive the entry. -`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 +`key`: shall be a scalar or rank-1 array of any type. +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 of any type, including derived types. @@ -1621,8 +1619,8 @@ Subroutine It is an `intent(inout)` argument. It is the hash map with the element 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 +`key`: shall be a scalar or rank-1 array of any type. +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 @@ -1664,8 +1662,8 @@ 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 of type `key_type` scalar, `character` scalar, `int8` array -or `int32` array. It is an `intent(in)` argument. It is the `key` to the +`key`: shall be a scalar or rank-1 array of any type. +It is an `intent(in)` argument. It is the `key` to the entry whose `other` data is to be replaced. `other` (optional): shall be a scalar of any type, including derived types. diff --git a/example/hashmaps/example_hashmaps_get_all_keys.f90 b/example/hashmaps/example_hashmaps_get_all_keys.f90 index 14db2a714..54e8cb75a 100644 --- a/example/hashmaps/example_hashmaps_get_all_keys.f90 +++ b/example/hashmaps/example_hashmaps_get_all_keys.f90 @@ -12,14 +12,11 @@ program example_hashmaps_get_all_keys character(:), allocatable :: str ! adding key-value pairs to the map - call set(key, "initial key") - call map%map_entry(key, "value 1") + call map%map_entry("initial key", "value 1") - call set(key, "second key") - call map%map_entry(key, "value 2") + call map%map_entry("second key", "value 2") - call set(key, "last key") - call map%map_entry(key, "value 3") + call map%map_entry("last key", "value 3") ! getting all the keys in the map call map%get_all_keys(keys) diff --git a/example/hashmaps/example_hashmaps_get_other_data.f90 b/example/hashmaps/example_hashmaps_get_other_data.f90 index cab1271ee..35a1c09b9 100644 --- a/example/hashmaps/example_hashmaps_get_other_data.f90 +++ b/example/hashmaps/example_hashmaps_get_other_data.f90 @@ -12,7 +12,7 @@ program example_get_other_data type(dummy_type) :: dummy class(*), allocatable :: data integer(int8), allocatable :: key_array(:) - integer :: int_scalar + integer :: int_scalar, unsupported_key(3,3) ! Hashmap functions are setup to store scalar value types (other). Use a dervied ! type wrapper to store arrays. @@ -36,8 +36,7 @@ program example_get_other_data 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. +! Can also just provide key values direct to most hashmap routines. call map%map_entry( [2,3], dummy, conflict) if (.not. conflict) then call map%get_other_data( [2,3], data) @@ -46,26 +45,26 @@ program example_get_other_data end if select type (data) - type is (dummy_type) - print *, 'Other data % value = ', data%value - class default - print *, 'Invalid data type in other' + type is (dummy_type) + print *, 'Other data % value = ', data%value + class default + print *, 'Invalid data type in other' end select - ! Integer scalar keys need to be passed as an array. + ! Scalar and rank one objects of any type can be used as keys. int_scalar = 2 - call map%map_entry( [int_scalar], dummy, conflict) + call map%map_entry( int_scalar, dummy, conflict) if (.not. conflict) then - call map%get_other_data( [int_scalar], data) + call map%get_other_data( int_scalar, data) else error stop 'Key is already present in the map.' end if select type (data) - type is (dummy_type) - print *, 'Other data % value = ', data%value - class default - print *, 'Invalid data type in other' + 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 @@ -77,26 +76,26 @@ program example_get_other_data end if select type (data) - type is (dummy_type) - print *, 'Other data % value = ', data%value - class default - print *, 'Invalid data type in other' + 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, dummy, conflict) +! Rank 2 or higher keys not directly supported. Transfer to int8 arrays to generate keys. + call set(key, transfer(unsupported_key,[0_int8])) + call map%map_entry( key, dummy, conflict) if (.not. conflict) then - call map%get_other_data( key_array, data) + call map%get_other_data( key, data) else error stop 'Key is already present in the map.' end if select type (data) - type is (dummy_type) - print *, 'Other data % value = ', data%value - class default - print *, 'Invalid data type in other' + 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 706da77cc..a85743cef 100644 --- a/example/hashmaps/example_hashmaps_map_entry.f90 +++ b/example/hashmaps/example_hashmaps_map_entry.f90 @@ -6,7 +6,6 @@ program example_map_entry type(chaining_hashmap_type) :: map type(key_type) :: key logical :: conflict - integer :: int_scalar type :: array_data_wrapper integer, allocatable :: array(:) @@ -14,6 +13,8 @@ program example_map_entry type(array_data_wrapper) :: array_example + integer :: unsupported_key(3,3) + ! Initialize hashmap with 2^10 slots. ! Hashmap will dynamically increase size if needed. call map%init(slots_bits=10) @@ -23,21 +24,20 @@ program example_map_entry call map%map_entry(key, 4, conflict) print *, 'CONFLICT = ', conflict - ! Using map_entry int32 array interface + ! Using the set function is not required. Can input key into the map_entry key fied. call map%map_entry( [4, 5, 6], 4, conflict) print *, 'CONFLICT = ', conflict - ! Integer scalars need to be passed as an array. - int_scalar = 1 - call map%map_entry( [int_scalar], 4, conflict) + ! Scalars can also be used as keys. + call map%map_entry( 1, 4, conflict) print *, 'CONFLICT = ', conflict - ! Using map_entry character interface + ! Any type of scalar or rank 1 array can be used as a key. call map%map_entry( 'key_string', 4, conflict) print *, 'CONFLICT = ', conflict - ! Transfer unsupported key types to int8 arrays. - call map%map_entry( transfer( [1_int64, 2_int64, 3_int64], [0_int8] ), 4, conflict) + ! A rank 2 or higher array can used as a key by transfering to an int8 array. + call map%map_entry( transfer( unsupported_key, [0_int8] ), 4, conflict) print *, 'CONFLICT = ', conflict ! Keys can be mapped alone without a corresponding value (other) for 'Set' type functionality. diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index bedf414dc..7e63f1693 100644 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -89,9 +89,8 @@ end function hasher_fun interface set - module procedure set_char_key, & - set_int8_key, & - set_int32_key + module procedure set_scalar_key, & + set_rank_one_key end interface set @@ -236,50 +235,41 @@ pure subroutine get_int32_key( key, value ) end subroutine get_int32_key - subroutine set_char_key( key, value ) + subroutine set_scalar_key( key, value ) !! Version: Experimental !! -!! Sets the contents of the key from a CHARACTER string +!! Sets the contents of the key from a scalar of any type !! Arguments: !! key - the output key -!! value - the input CHARACTER string +!! value - the input scalar value of any type type(key_type), intent(out) :: key - character(*), intent(in) :: value + class(*), intent(in) :: value - key % value = transfer( value, key % value, & - bytes_char * len( value ) ) + key % value = transfer( value, key % value ) - end subroutine set_char_key + end subroutine set_scalar_key - subroutine set_int8_key( key, value ) + subroutine set_rank_one_key( key, value ) !! Version: Experimental !! -!! Sets the contents of the key from an INTEGER(INT8) vector +!! Sets the contents of the key from a rank one array of any type !! Arguments: !! key - the output key -!! value - the input INTEGER(INT8) vector +!! value - the input rank one array of any type type(key_type), intent(out) :: key - integer(int8), intent(in) :: value(:) - - key % value = value - - end subroutine set_int8_key - + class(*), intent(in) :: value(:) + + select type (value) + type is (integer(int8)) + key % value = value + + class default + key % value = transfer( value, key % value ) - 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 + end select + + end subroutine set_rank_one_key pure function fnv_1_hasher( key ) diff --git a/src/stdlib_hashmaps.f90 b/src/stdlib_hashmaps.f90 index d8afb23ec..8ee7d327a 100644 --- a/src/stdlib_hashmaps.f90 +++ b/src/stdlib_hashmaps.f90 @@ -6,7 +6,6 @@ module stdlib_hashmaps use, intrinsic :: iso_fortran_env, only: & - character_storage_size, & error_unit use stdlib_kinds, only: & @@ -58,12 +57,6 @@ module stdlib_hashmaps alloc_fault = 1, & array_size_error = 2 -! The number of bits used by various types - integer, parameter :: & -! Should be 8 - int8_bits = bit_size(0_int8), & - char_bits = character_storage_size - !! The hash map load factor real, parameter, public :: & load_factor = 0.5625 @@ -109,38 +102,33 @@ module stdlib_hashmaps !! 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 + procedure, non_overridable, pass(map) :: scalar_key_test + procedure, non_overridable, pass(map) :: rank_one_key_test + generic, public :: key_test => scalar_key_test, rank_one_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 + procedure, non_overridable, pass(map) :: scalar_map_entry + procedure, non_overridable, pass(map) :: rank_one_map_entry + generic, public :: map_entry => scalar_map_entry, rank_one_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 + procedure, non_overridable, pass(map) :: scalar_get_other_data + procedure, non_overridable, pass(map) :: rank_one_get_other_data + generic, public :: get_other_data => scalar_get_other_data, rank_one_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 + procedure, non_overridable, pass(map) :: scalar_remove_entry + procedure, non_overridable, pass(map) :: rank_one_remove_entry + generic, public :: remove => scalar_remove_entry, rank_one_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 + procedure, non_overridable, pass(map) :: scalar_set_other_data + procedure, non_overridable, pass(map) :: rank_one_set_other_data + generic, public :: set_other_data => scalar_set_other_data, rank_one_set_other_data end type hashmap_type @@ -812,64 +800,50 @@ end function total_open_depth contains - subroutine int8_get_other_data( map, value, other, exists ) + subroutine scalar_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(:) + class(*), intent(in) :: value class(*), allocatable, 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 + select type (value) + type is (key_type) + call map % key_get_other_data( value, other, exists ) + + class default + call set( key, value ) + call map % key_get_other_data( key, other, exists ) + + end select + + end subroutine scalar_get_other_data - subroutine int32_get_other_data( map, value, other, exists ) + subroutine rank_one_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(:) + class(*), intent(in) :: value(:) class(*), allocatable, 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 + end subroutine rank_one_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 - class(*), allocatable, 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 + subroutine scalar_remove_entry(map, value, existed) ! Chase's delent !! Version: Experimental !! !! Remove the entry, if any, that has the key @@ -880,19 +854,25 @@ subroutine int8_remove_entry(map, value, existed) ! Chase's delent !! was present in the original map ! class(hashmap_type), intent(inout) :: map - integer(int8), intent(in) :: value(:) + class(*), intent(in) :: value logical, intent(out), optional :: existed type(key_type) :: key - call set( key, value ) + select type (value) + type is (key_type) + call map % key_remove_entry( value, existed ) + + class default + call set( key, value ) + call map % key_remove_entry( key, existed ) + + end select - call map % key_remove_entry( key, existed ) - - end subroutine int8_remove_entry + end subroutine scalar_remove_entry - subroutine int32_remove_entry(map, value, existed) ! Chase's delent + subroutine rank_one_remove_entry(map, value, existed) ! Chase's delent !! Version: Experimental !! !! Remove the entry, if any, that has the key @@ -903,101 +883,62 @@ subroutine int32_remove_entry(map, value, existed) ! Chase's delent !! was present in the original map ! class(hashmap_type), intent(inout) :: map - integer(int32), intent(in) :: value(:) + class(*), 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 + end subroutine rank_one_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) + subroutine scalar_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(:) + class(*), intent(in) :: value class(*), 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 ) + select type (value) + type is (key_type) + call map % key_map_entry( value, other, conflict ) + + class default + call set( key, value ) + call map % key_map_entry( key, other, conflict ) + + end select - end subroutine int8_map_entry + end subroutine scalar_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(:) - class(*), 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) + subroutine rank_one_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 + class(*), intent(in) :: value(:) class(*), 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 + + end subroutine rank_one_map_entry - subroutine int8_key_test(map, value, present) + subroutine scalar_key_test(map, value, present) !! Version: Experimental !! !! Returns a logical flag indicating whether KEY exists in the hash map @@ -1009,21 +950,25 @@ subroutine int8_key_test(map, value, present) !! present - a flag indicating whether key is present in the map ! class(hashmap_type), intent(inout) :: map - integer(int8), intent(in) :: value(:) + class(*), 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 + select type (value) + type is (key_type) + call map % key_key_test( value, present ) + + class default + call set( key, value ) + call map % key_key_test( key, present ) + + end select + + end subroutine scalar_key_test - subroutine int32_key_test(map, value, present) + subroutine rank_one_key_test(map, value, present) !! Version: Experimental !! !! Returns a logical flag indicating whether KEY exists in the hash map @@ -1035,43 +980,18 @@ subroutine int32_key_test(map, value, present) !! present - a flag indicating whether key is present in the map ! class(hashmap_type), intent(inout) :: map - integer(int32), intent(in) :: value(:) + class(*), intent(in) :: value(:) logical, intent(out) :: present type(key_type) :: key call set( key, value ) - call map % key_key_test( key, present ) - 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 ) + end subroutine rank_one_key_test - call map % key_key_test( key, present ) - - end subroutine char_key_test - - subroutine int8_set_other_data( map, value, other, exists ) + subroutine scalar_set_other_data( map, value, other, exists ) !! Version: Experimental !! !! Change the other data associated with the key @@ -1084,20 +1004,27 @@ subroutine int8_set_other_data( map, value, other, exists ) !! ! class(hashmap_type), intent(inout) :: map - integer(int8), intent(in) :: value(:) + class(*), intent(in) :: value class(*), intent(in) :: other logical, intent(out), optional :: exists type(key_type) :: key - call set( key, value ) + select type (value) + type is (key_type) + call map % key_set_other_data( value, other, exists ) + + class default + call set( key, value ) + call map % key_set_other_data( key, other, exists ) + + end select - call map % key_set_other_data( key, other, exists ) - end subroutine int8_set_other_data + end subroutine scalar_set_other_data - subroutine int32_set_other_data( map, value, other, exists ) + subroutine rank_one_set_other_data( map, value, other, exists ) !! Version: Experimental !! !! Change the other data associated with the key @@ -1110,45 +1037,18 @@ subroutine int32_set_other_data( map, value, other, exists ) !! ! class(hashmap_type), intent(inout) :: map - integer(int32), intent(in) :: value(:) + class(*), intent(in) :: value(:) class(*), 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 + end subroutine rank_one_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 - class(*), 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 !! From c971053358135149e95f6735c5946f11f80be952 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Sat, 26 Jul 2025 17:56:45 -0400 Subject: [PATCH 2/2] Roll back rank_1 changes Roll back rank_1 unlimited polymorphic changes to work around a Gfortran bug that was causing those features to crash. Currently Gfortran seems to only support unlimited polymorphic scalar values for the transfer intrinsic. --- src/stdlib_hashmap_wrappers.f90 | 37 +++-- src/stdlib_hashmaps.f90 | 279 +++++++++++++++++++++++--------- 2 files changed, 224 insertions(+), 92 deletions(-) diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index 7e63f1693..61d5d9b18 100644 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -90,7 +90,8 @@ end function hasher_fun interface set module procedure set_scalar_key, & - set_rank_one_key + set_int8_key, & + set_int32_key end interface set @@ -250,28 +251,36 @@ subroutine set_scalar_key( key, value ) end subroutine set_scalar_key - subroutine set_rank_one_key( key, value ) + pure subroutine set_int8_key( key, value ) !! Version: Experimental !! -!! Sets the contents of the key from a rank one array of any type +!! Sets the contents of the key from an INTEGER(INT8) vector !! Arguments: !! key - the output key !! value - the input rank one array of any type type(key_type), intent(out) :: key - class(*), intent(in) :: value(:) - - select type (value) - type is (integer(int8)) - key % value = value - - class default - key % value = transfer( value, key % value ) + integer(int8), intent(in) :: value(:) - end select - - end subroutine set_rank_one_key + 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 !! diff --git a/src/stdlib_hashmaps.f90 b/src/stdlib_hashmaps.f90 index 8ee7d327a..190107571 100644 --- a/src/stdlib_hashmaps.f90 +++ b/src/stdlib_hashmaps.f90 @@ -103,32 +103,37 @@ module stdlib_hashmaps !! Key_test procedures. procedure(key_key_test), deferred, pass(map) :: key_key_test procedure, non_overridable, pass(map) :: scalar_key_test - procedure, non_overridable, pass(map) :: rank_one_key_test - generic, public :: key_test => scalar_key_test, rank_one_key_test + procedure, non_overridable, pass(map) :: int8_key_test + procedure, non_overridable, pass(map) :: int32_key_test + generic, public :: key_test => scalar_key_test, int8_key_test, int32_key_test ! Map_entry procedures procedure(key_map_entry), deferred, pass(map) :: key_map_entry procedure, non_overridable, pass(map) :: scalar_map_entry - procedure, non_overridable, pass(map) :: rank_one_map_entry - generic, public :: map_entry => scalar_map_entry, rank_one_map_entry + procedure, non_overridable, pass(map) :: int8_map_entry + procedure, non_overridable, pass(map) :: int32_map_entry + generic, public :: map_entry => scalar_map_entry, int8_map_entry, int32_map_entry ! Get_other_data procedures procedure(key_get_other_data), deferred, pass(map) :: key_get_other_data procedure, non_overridable, pass(map) :: scalar_get_other_data - procedure, non_overridable, pass(map) :: rank_one_get_other_data - generic, public :: get_other_data => scalar_get_other_data, rank_one_get_other_data + procedure, non_overridable, pass(map) :: int8_get_other_data + procedure, non_overridable, pass(map) :: int32_get_other_data + generic, public :: get_other_data => scalar_get_other_data, int8_get_other_data, int32_get_other_data ! Key_remove_entry procedures procedure(key_remove_entry), deferred, pass(map) :: key_remove_entry procedure, non_overridable, pass(map) :: scalar_remove_entry - procedure, non_overridable, pass(map) :: rank_one_remove_entry - generic, public :: remove => scalar_remove_entry, rank_one_remove_entry + procedure, non_overridable, pass(map) :: int8_remove_entry + procedure, non_overridable, pass(map) :: int32_remove_entry + generic, public :: remove => scalar_remove_entry, int8_remove_entry, int32_remove_entry ! Set_other_data procedures procedure(key_set_other_data), deferred, pass(map) :: key_set_other_data procedure, non_overridable, pass(map) :: scalar_set_other_data - procedure, non_overridable, pass(map) :: rank_one_set_other_data - generic, public :: set_other_data => scalar_set_other_data, rank_one_set_other_data + procedure, non_overridable, pass(map) :: int8_set_other_data + procedure, non_overridable, pass(map) :: int32_set_other_data + generic, public :: set_other_data => scalar_set_other_data, int8_set_other_data, int32_set_other_data end type hashmap_type @@ -800,6 +805,44 @@ end function total_open_depth 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(:) + class(*), allocatable, 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(:) + class(*), allocatable, 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 scalar_get_other_data( map, value, other, exists ) !! Version: Experimental !! @@ -825,24 +868,52 @@ subroutine scalar_get_other_data( map, value, other, exists ) end subroutine scalar_get_other_data - subroutine rank_one_get_other_data( map, value, other, exists ) + subroutine int8_remove_entry(map, value, existed) ! Chase's delent !! Version: Experimental !! -!! Int32 key generic interface for get_other_data function - +!! 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 - class(*), intent(in) :: value(:) - class(*), allocatable, intent(out) :: other - logical, intent(out), optional :: exists + integer(int8), intent(in) :: value(:) + logical, intent(out), optional :: existed type(key_type) :: key call set( key, value ) - call map % key_get_other_data( key, other, exists ) - end subroutine rank_one_get_other_data - + 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 scalar_remove_entry(map, value, existed) ! Chase's delent !! Version: Experimental !! @@ -872,28 +943,45 @@ subroutine scalar_remove_entry(map, value, existed) ! Chase's delent end subroutine scalar_remove_entry - subroutine rank_one_remove_entry(map, value, existed) ! Chase's delent + 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(:) + class(*), 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 !! -!! 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 - class(*), intent(in) :: value(:) - logical, intent(out), optional :: existed +!! 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(:) + class(*), intent(in), optional :: other + logical, intent(out), optional :: conflict - type(key_type) :: key + type(key_type) :: key call set( key, value ) - call map % key_remove_entry( key, existed ) - end subroutine rank_one_remove_entry - + call map % key_map_entry( key, other, conflict ) + end subroutine int32_map_entry + + subroutine scalar_map_entry(map, value, other, conflict) !! Version: Experimental !! Int8 generic interface for map entry @@ -919,24 +1007,55 @@ subroutine scalar_map_entry(map, value, other, conflict) end subroutine scalar_map_entry - subroutine rank_one_map_entry(map, value, other, conflict) + subroutine int8_key_test(map, value, present) !! Version: Experimental !! -!! Inserts an entry into the hash table -!! ([Specifications](../page/specs/stdlib_hashmaps.html#map_entry-inserts-an-entry-into-the-hash-map)) +!! 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)) !! - class(hashmap_type), intent(inout) :: map - class(*), intent(in) :: value(:) - class(*), intent(in), optional :: other - logical, intent(out), optional :: conflict +!! 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 + type(key_type) :: key + ! Generate key from int8 array. call set( key, value ) - call map % key_map_entry( key, other, conflict ) - - end subroutine rank_one_map_entry + + ! 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 ) + + end subroutine int32_key_test + subroutine scalar_key_test(map, value, present) !! Version: Experimental @@ -968,87 +1087,91 @@ subroutine scalar_key_test(map, value, present) end subroutine scalar_key_test - subroutine rank_one_key_test(map, value, present) + subroutine int8_set_other_data( map, value, other, exists ) !! 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)) -!! +!! Change the other data associated with the key !! 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 +!! 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 - class(*), intent(in) :: value(:) - logical, intent(out) :: present + integer(int8), intent(in) :: value(:) + class(*), intent(in) :: other + logical, intent(out), optional :: exists type(key_type) :: key call set( key, value ) - call map % key_key_test( key, present ) - - end subroutine rank_one_key_test + call map % key_set_other_data( key, other, exists ) + + end subroutine int8_set_other_data + - subroutine scalar_set_other_data( map, value, other, exists ) + 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 int8 array key to the entry inthe map +!! 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 - class(*), intent(in) :: value + integer(int32), intent(in) :: value(:) class(*), intent(in) :: other logical, intent(out), optional :: exists type(key_type) :: key - select type (value) - type is (key_type) - call map % key_set_other_data( value, other, exists ) - - class default - call set( key, value ) - call map % key_set_other_data( key, other, exists ) - - end select + call set( key, value ) + call map % key_set_other_data( key, other, exists ) + + end subroutine int32_set_other_data - end subroutine scalar_set_other_data - - subroutine rank_one_set_other_data( map, value, other, exists ) + subroutine scalar_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 +!! 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 - class(*), intent(in) :: value(:) + class(*), intent(in) :: value class(*), 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 ) + select type (value) + type is (key_type) + call map % key_set_other_data( value, other, exists ) + + class default + call set( key, value ) + call map % key_set_other_data( key, other, exists ) + + end select + - end subroutine rank_one_set_other_data + end subroutine scalar_set_other_data - + pure function calls( map ) !! Version: Experimental !!