diff --git a/doc/specs/index.md b/doc/specs/index.md
index 95f08a31f..efc601d0d 100644
--- a/doc/specs/index.md
+++ b/doc/specs/index.md
@@ -4,7 +4,7 @@ title: Specifications (specs)
# Fortran stdlib Specifications (specs)
-This is and index/directory of the specifications (specs) for each new module/feature as described in the
+This is an index/directory of the specifications (specs) for each new module/feature as described in the
[workflow document](../Workflow.html).
[TOC]
@@ -16,7 +16,8 @@ This is and index/directory of the specifications (specs) for each new module/fe
- [bitsets](./stdlib_bitsets.html) - Bitset data types and procedures
- [error](./stdlib_error.html) - Catching and handling errors
- [hash](./stdlib_hash_procedures.html) - Hashing integer
- vectors or character strings
+ vectors or character strings
+ - [hashmaps](./stdlib_hashmaps.html) - Hash maps/tables
- [io](./stdlib_io.html) - Input/output helper & convenience
- [kinds](./stdlib_kinds.html) - Kind parameters
- [linalg](./stdlib_linalg.html) - Linear Algebra
diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md
new file mode 100644
index 000000000..abe6b92c8
--- /dev/null
+++ b/doc/specs/stdlib_hashmaps.md
@@ -0,0 +1,2127 @@
+---
+title: Hash maps
+---
+
+# The `stdlib_hashmap_wrappers`, and `stdlib_hashmaps` modules
+
+[TOC]
+
+## Overview of hash maps
+
+A hash map (hash table) is a data structure that maps *keys* to
+*values*. It uses a hash function to compute a hash code from the *key*
+that serves as an index into a linear array of *slots* (buckets) from
+which the desired *value* can be extracted.
+Each key ideally maps to a unique slot, but most hash functions are
+imperfect and can map multiple keys to the same *slot* resulting in
+collisions. Hash maps differ in how they deal with such collisions.
+This document discusses the hash maps in the Fortran Standard Library.
+
+## Licensing
+
+The Fortran Standard Library is distributed under the MIT License.
+However components of the library should be evaluated as to whether
+they are compatible with the MTI License.
+The current hash maps were inspired by an
+[implementation](http://chasewoerner.org/src/hasht/) of David
+Chase. While the code has been greatly modified from his
+implementation, he has give permission for the unrestricted use of
+his code.
+
+## The hash map modules
+
+The Fortran Standard Library provides two modules for the
+implementation of simple hash maps. These maps only accept hash
+functions with a single argument, the key, and yield a 32 bit
+hash code. The modules will need to be modified if it is desired to
+use hash functions with a different API. The two modules are:
+`stdlib_hashmap_wrappers`, and `stdlib_hashmaps` corresponding to the
+files: `stdlib_hashmap_wrappers.f90`, and `stdlib_hashmaps.f90`
+
+The module `stdlib_hashmap_wrappers` provides types and procedures for
+use by `stdlib_hashmaps`. It provides an
+interface to the 32 bit hash functions of the Standard Library module,
+`stdlib_hash_32bit`, and provides wrappers to some of the
+hash functions so that they no longer need to be supplied seeds. It
+also defines two data types used to store information in the hash
+maps, the `key_type` and the `other_type`. The `key_type` is used to
+define keys that, in turn, are used to identify the data entered into
+a hash map. The `other_type` is intended to contain the other data
+associated with the key.
+
+The module `stdlib_hashmaps` defines the API for a parent datatype,
+`hashmap_type` and two extensions of that hash map type:
+`chaining_hashmap_type` and `open_hashmap_type`.
+
+The `hashmap_type` defines the Application Programmers
+Interface (API) for the procedures used by its two extensions. It
+explicitly defines five non-overridable procedures. It also defines
+the interfaces for eleven deferred procedures. It does not define the
+finalization routines for the two extension types, or one routine
+provided by the `open_hashmap_type`.
+
+The `chaining_hashmap_type` uses separate chaining with linked
+lists to deal with hash index collisions. In separate chaining the
+colliding indices are handled by using linked lists with their roots
+at the hash index. The `chaining_hashmap_type` procedures are
+implemented in the module `stdlib_hashmap_chaining` corresponding
+to the file, `stdlib_hashmap_chaining.f90`.
+
+The `open_hashmap_type`
+uses linear open addressing to deal with hash index collisions. In
+linear open addressing the colliding indices are
+handled by searching from the initial hash index in increasing
+steps of one (modulo the hash map size) for an open map slot.
+The `open_hashmap_type` procedures are implemented in the submodule
+`stdlib_hashmap_open` corresponding to the file
+`stdlib_hashmap_open.f90`.
+
+The maps use powers of two for their slot sizes, so that the function,
+`fibonacci_hash`, can
+be used to map the hash codes to indices in the map. This is
+expected to be more efficient than prime number mapping using a
+modulo operation, and reduces the requirement that the hash
+function need to do a good job randomizing its lower order bits.
+They do require a good randomizing hash method for good performance.
+Both adjust the map size to reduce collisions, based on
+the ratio of the number of hash map probes to the number of subroutine
+calls.
+Wile the maps make extensive use of pointers internally, a private
+finalization subroutine avoids memory leaks.
+The maps can take entry keys of type `key_type`, and other data of the
+type `other_type`.
+The maps allow the addition, removal, and lookup of entries, and the
+inclusion of data in addition to the entry key.
+
+## The `stdlib_hashmap_wrappers` module
+
+The `stdlib_hashmap_wrappers` module provides data types to
+represent keys and associated data stored in a module, but is also, a
+wrapper for the `stdlib_hash_32bit` module. It allows
+direct access to the `stdlib_hash_32bit` procedures:
+`fibonacci_hash`, `fnv_1_hasher`, `fnv_1a_hasher`; and provides
+wrapper functions, `seeded_nmhash32_hasher`,
+`seeded_nmhash32x_hasher`, and `seeded_water_hasher` to the hash
+functions: `nmhash32`, `nmhash32x`, and `water_hash`, respectively. It
+defines an interface, `hasher_fun`, compatible with the hash functions
+that take a `non-scalar key`. It defines one integer constant used
+as a kind value,`int_hash`. It also defines two types, `key_type` and
+`other_type`, and associated procedures, for storing and manipulating
+keys and their associated data.
+
+### The `stdlib_hashmap_wrappers`'s constant, `int_hash`
+
+The constant `int_hash` is used to define the integer kind value for
+the returned hash codes and variables used to access them. It
+currently is imported from `stdlib_hash_32bit` where it has the
+value, `int32`.
+
+### The `stdlib_hashmap_wrappers`' module's derived types
+
+The `stdlib_hashmap_wrappers` module defines two derived types:
+`key_type`, and `other_type`. The `key_type` is intended to be used
+for the search keys of hash tables. The `other_type` is intended to
+store additional data associated with a key. Both types are
+opaque. Their current representations are as follows
+
+```fortran
+ type :: key_type
+ private
+ integer(int8), allocatable :: value(:)
+ end type key_type
+
+ type :: other_type
+ private
+ class(*), allocatable :: value
+ end type other_type
+```
+
+The module also defines six procedures for those types: `copy_key`,
+`copy_other`, `equal_keys`, `free_key`, `free_other`, `get`, and
+`set`, and one operator, `==`,
+for use by the hash maps to manipulate or inquire of components of
+those types.
+
+### Table of `stdlib_hashmap_wrappers` procedures
+
+The `stdlib_hashmap_wrappers` module provides procedures in
+several categories: procedures to manipulate data of the `key_type`;
+procedures to manipulate data of the `other_type`, and 32 bit hash
+functions for keys. The procedures in each category are listed
+below. It also provides an operator to compare two key type values for
+equality.
+
+Procedures to manipulate `key_type` data:
+
+* `copy_key( key_in, key_out )` - Copies the contents of the key,
+ `key_in`, to contents of the key, `key_out`.
+
+* `get( key, value )` - extracts the contents of `key` into `value`,
+ an `int8` array or character string.
+
+* `free_key( key )` - frees the memory in `key`.
+
+* `set( key, value )` - sets the content of `key` to `value`.
+
+Procedures to manipulate `other_type` data:
+
+* `copy_other( other_in, other_out )` - Copies the contents of the
+ other data, `other_in`, to the contents of the other data,
+ `other_out`.
+
+* `get( other, value )` - extracts the contents of `other` into the
+ `class(*)` variable `value`.
+
+* `set( other, value )` - sets the content of `other` to the `class(*)`
+ variable `value`.
+
+* `free_other( other )` - frees the memory in `other`.
+
+Procedures to hash keys to 32 bit integers:
+
+* `fnv_1_hasher( key )` - hashes a `key` using the FNV-1 algorithm.
+
+* `fnv_1a_hasher( key )` - hashes a `key` using the FNV-1a algorithm.
+
+* `seeded_nmhash32_hasher( key )` - hashes a `key` using the nmhash32
+ algorithm.
+
+* `seeded_nmhash32x_hasher( key )` - hashes a `key` using the nmhash32x
+ algorithm.
+
+* `seeded_water_hasher( key )` - hashes a `key` using the waterhash
+ algorithm.
+
+Operator to compare two `key_type` values for equality
+
+* `key1 == key2` - compares `key1` with `key2` for equality
+
+### Specifications of the `stdlib_hashmap_wrappers` procedures
+
+#### `copy_key` - Returns a copy of the key
+
+##### Status
+
+Experimental
+
+##### Description
+
+Returns a copy of an input of type `key_type`.
+
+##### Syntax
+
+`call [[stdlib_hashmap_wrappers:copy_key]]( old_key, new_key )`
+
+##### Class
+
+Subroutine.
+
+##### Arguments
+
+`old_key`: shall be a scalar expression of type `key_type`. It
+is an `intent(in)` argument.
+
+`new_key`: shall be a scalar variable of type `key_type`. It
+is an `intent(out)` argument.
+
+##### Example
+
+```fortran
+ program demo_copy_key
+ use stdlib_hashmap_wrappers, only: &
+ copy_key, operator(==), key_type
+ use iso_fortran_env, only: int8
+ implicit none
+ integer(int8) :: i, value(15)
+ type(key_type) :: old_key, new_key
+ value = [(i, i = 1, 15)]
+ call set( key_out, value )
+ call copy_key( key_out, new_key )
+ print *, "old_key == new_key = ", old_key == new_key
+ end program demo_copy_key
+```
+
+#### `copy_other` - Returns a copy of the other data
+
+##### Status
+
+Experimental
+
+##### Description
+
+Returns a copy of an input of type `other_type`.
+
+##### Syntax
+
+`call [[stdlib_hashmap_wrappers:copy_other]]( other_in, other_out )`
+
+##### Class
+
+Subroutine.
+
+##### Arguments
+
+`other_in`: shall be a scalar expression of type `other_type`. It
+is an `intent(in)` argument.
+
+`other_out`: shall be a scalar variable of type `other_type`. It
+is an `intent(out)` argument.
+
+##### Example
+
+```fortran
+ program demo_copy_other
+ use stdlib_hashmap_wrappers, only: &
+ copy_other, get, other_type, set
+ use iso_fortran_env, only: int8
+ implicit none
+ type(other_type) :: other_in, other_out
+ integer(int_8) :: i
+ class(*), allocatable :: dummy
+ type dummy_type
+ integer(int8) :: value(15)
+ end type
+ type(dummy_type) :: dummy_val
+ do i=1, 15
+ dummy_val % value1(i) = i
+ end do
+ allocate(other_in % value, source=dummy_val)
+ call copy_other( other_in, other_out )
+ select type(other_out)
+ type(dummy_type)
+ print *, "other_in == other_out = ", &
+ all( dummy_val % value == other_out % value )
+ end select
+ end program demo_copy_other
+```
+
+
+#### `fibonacci_hash` - maps an integer to a smaller number of bits
+
+##### Status
+
+Experimental
+
+##### Description
+
+`fibonacci_hash` is just a re-export of the function of the same name
+implemented in
+[`stdlib_hash_32bit`](https://stdlib.fortran-lang.org/page/spec/stdlib_hash_functions.html#fibonacci_hash-maps-an-integer-to-a-smaller-number-of-bits).
+It reduces the value of a 32 bit integer to a smaller number of bits.
+
+
+#### `fnv_1_hasher`- calculates a hash code from a key
+
+##### Status
+
+Experimental
+
+##### Description
+
+Calculates a 32 bit hash code from an input of type `key_type`.
+
+##### Syntax
+
+`code = [[stdlib_hashmap_wrappers:fnv_1_hasher]]( key )`
+
+##### Class
+
+Pure function
+
+##### Argument
+
+`key`: Shall be a scalar expression of type `key_type`.
+It is an `intent(in)` argument.
+
+##### Result character
+
+The result is a scalar integer of kind `int32`.
+
+##### Result value
+
+The result is a hash code created using the FNV-1 algorithm.
+
+##### Note
+
+`fnv_1_hasher` is an implementation of the original FNV-1 hash code of
+Glenn Fowler, Landon Curt Noll, and Phong Vo.
+This code is relatively fast on short keys, and is small enough that
+it will often be retained in the instruction cache if hashing is
+intermittent.
+As a result it should give good performance for typical hash map
+applications.
+This code does not pass any of the SMHasher tests, but the resulting
+degradation in performance due to its larger number of collisions is
+expected to be minor compared to its faster hashing rate.
+
+
+##### Example
+
+```fortran
+ program demo_fnv_1_hasher
+ use stdlib_hashmap_wrappers, only: &
+ fnv_1_hasher, key_type, set
+ use iso_fortran_env, only: int32
+ implicit none
+ integer(int8), allocatable :: array1(:)
+ integer(int32) :: hash
+ type(key_type) :: key
+ array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ]
+ call set( key, array1 )
+ hash = fnv_1_hasher(key)
+ print *, hash
+ end program demo_fnv_1_hasher
+```
+
+
+#### `fnv_1a_hasher`- calculates a hash code from a key
+
+##### Status
+
+Experimental
+
+##### Description
+
+Calculates a 32 bit hash code from an input of type `key_type`.
+
+##### Syntax
+
+`code = [[stdlib_hashmap_wrappers:fnv_1a_hasher]]( key )`
+
+##### Class
+
+Pure function
+
+##### Argument
+
+`key`: Shall be a scalar expression of type `key_type`.
+It is an `intent(in)` argument.
+
+##### Result character
+
+The result is a scalar integer of kind `int32`.
+
+##### Result value
+
+The result is a hash code created using the FNV-1a algorithm.
+
+##### Note
+
+`fnv_1a_hasher` is an implementation of the original FNV-1A hash code
+of Glenn Fowler, Landon Curt Noll, and Phong Vo.
+This code is relatively fast on short keys, and is small enough that
+it will often be retained in the instruction cache if hashing is
+intermittent.
+As a result it should give good performance for typical hash map
+applications.
+This code does not pass any of the SMHasher tests, but the resulting
+degradation in performance due to its larger number of collisions is
+expected to be minor compared to its faster hashing rate.
+
+
+##### Example
+
+```fortran
+ program demo_fnv_1a_hasher
+ use stdlib_hashmap_wrappers, only: &
+ fnv_1a_hasher, key_type, set
+ use iso_fortran_env, only: int32
+ implicit none
+ integer(int8), allocatable :: array1(:)
+ integer(int32) :: hash
+ type(key_type) :: key
+ array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ]
+ call set( key, array1 )
+ hash = fnv_1a_hasher(key)
+ print *, hash
+ end program demo_fnv_1a_hasher
+```
+
+#### `free_key` - frees the memory associated with a key
+
+##### Status
+
+Experimental
+
+##### Description
+
+Deallocates the memory associated with a variable of type
+`key_type`.
+
+##### Syntax
+
+`call [[stdlib_hashmap_wrappers:free_key]]( key )`
+
+##### Class
+
+Subroutine.
+
+##### Argument
+
+`key`: shall be a scalar variable of type `key_type`. It
+is an `intent(out)` argument.
+
+##### Example
+
+```fortran
+ program demo_free_key
+ use stdlib_hashmap_wrappers, only: &
+ copy_key, free_key, key_type, set
+ use iso_fortran_env, only: int8
+ implicit none
+ integer(int8) :: i, value(15)
+ type(key_type) :: old_key, new_key
+ value = [(i, i=1, 15)]
+ call set( old_key, value )
+ call copy_key( old_key, new_key )
+ call free_key( old_key )
+ end program demo_free_key
+```
+
+#### `free_other` - frees the memory associated with other data
+
+##### Status
+
+Experimental
+
+##### Description
+
+Deallocates the memory associated with a variable of type
+`other_type`.
+
+##### Syntax
+
+`call [[stdlib_hashmap_wrappers:free_other]]( other )`
+
+##### Class
+
+Subroutine.
+
+##### Argument
+
+`other`: shall be a scalar variable of type `other_type`. It
+is an `intent(out)` argument.
+
+##### Example
+
+```fortran
+ program demo_free_other
+ use stdlib_hashmap_wrappers, only: &
+ copy_other, free_other, other_type, set
+ use iso_fortran_env, only: int8
+ implicit none
+ type dummy_type
+ integer(int8) :: value(15)
+ end type dummy_type
+ typer(dummy_type) :: dummy_val
+ type(other_type), allocatable :: other_in, other_out
+ integer(int_8) :: i
+ do i=1, 15
+ dummy_val % value(i) = i
+ end do
+ allocate(other_in, source=dummy_val)
+ call copy_other( other_in, other_out )
+ call free_other( other_out )
+ end program demo_free_other
+```
+
+
+#### `get` - extracts the data from a derived type
+
+##### Status
+
+Experimental
+
+##### Description
+
+Extracts the data from a `key_type` or `other_type` and stores it
+in the variable `value`.
+
+##### Syntax
+
+`call [[stdlib_hashmap_wrappers:get]]( key, value )`
+
+or
+
+`call [[stdlib_hashmap_wrappers:get]]( other, value )`
+
+##### Class
+
+Subroutine.
+
+##### Argument
+
+`key`: shall be a scalar expression of type `key_type`. It
+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`,
+otherwise the first argument is of `other_type` and `value` shall be
+an allocatable of `class(*)`. It is an `intent(out)` argument.
+
+##### Example
+
+```fortran
+ program demo_get
+ use stdlib_hashmap_wrappers, only: &
+ get, key_type, set
+ use iso_fortran_env, only: int8
+ implicit none
+ integer(int8), allocatable :: value(:), result(:)
+ type(key_type) :: key
+ integer(int_8) :: i
+ allocate( value(1:15) )
+ do i=1, 15
+ value(i) = i
+ end do
+ call set( key, value )
+ call get( key, result )
+ print *, 'RESULT == VALUE = ', all( value == result )
+ end program demo_get
+```
+
+
+#### `hasher_fun`- serves aa a function prototype.
+
+##### Status
+
+Experimental
+
+##### Description
+
+Serves as a prototype for hashing functions with a single, `key`,
+argument of type `key_type` returning an `int32` hash value.
+
+##### Syntax
+
+`type([[stdlib_hashmap_wrappers:hasher_fun]]), pointer :: fun_pointer`
+
+##### Class
+
+Pure function prototype
+
+##### Argument
+
+`key`: Shall be a rank one array expression of type `integer(int8)`.
+It is an `intent(in)` argument.
+
+##### Result character
+
+The result is a scalar integer of kind `int32`.
+
+##### Result value
+
+The result is a hash code.
+
+##### Note
+
+`hasher_fun` is a prototype for defining dummy arguments and function
+pointers intended for use as a hash function for the hash maps.
+
+##### Example
+
+```fortran
+ program demo_hasher_fun
+ use stdlib_hashmap_wrappers, only: &
+ fnv_1a_hasher, hasher_fun, set
+ use iso_fortran_env, only: int8, int32
+ implicit none
+ type(hasher_fun), pointer :: hasher_pointer
+ integer(int8), allocatable :: array1(:)
+ integer(int32) :: hash
+ type(key_type) :: key
+ hasher_pointer => fnv_1a_hasher
+ array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ]
+ call set( key, array1 )
+ hash = hasher_pointer(key)
+ print *, hash
+ end program demo_hasher_fun
+```
+
+#### `operator(==)` - Compares two keys for equality
+
+##### Status
+
+Experimental
+
+##### Description
+
+Returns `.true.` if two keys are equal, and `.false.` otherwise.
+
+##### Syntax
+
+`test = key1 == key2`
+
+##### Class
+
+Pure operator.
+
+##### Arguments
+
+`key1`: shall be a scalar expression of type `key_type`. It
+is an `intent(in)` argument.
+
+`key2`: shall be a scalar expression of type `key_type`. It
+is an `intent(in)` argument.
+
+##### Result character
+
+The result is a value of type default `logical`.
+
+##### Result value
+
+The result is `.true.` if the keys are equal, otherwise `.falss.`.
+
+##### Example
+
+```fortran
+ program demo_equal_keys
+ use stdlib_hashmap_wrappers, only: &
+ copy_key, operator(==), key_type, set
+ use iso_fortran_env, only: int8
+ implicit none
+ integer(int8) :: i, value(15)
+ type(key_type) :: old_key, new_key
+ do i=1, 15
+ value(i) = i
+ end do
+ call set( old_key, value )
+ call copy_key( old_key, new_key )
+ print *, "old_key == new_key = ", old_key == new_key
+ end program demo_equal_keys
+```
+
+#### `seeded_nmhash32_hasher`- calculates a hash code from a key
+
+##### Status
+
+Experimental
+
+##### Description
+
+Calculates a 32 bit hash code from an input of type `key_type`.
+
+##### Syntax
+
+`code = [[stdlib_hashmap_wrappers:seeded_nmhash32_hasher]]( key )`
+
+##### Class
+
+Pure function
+
+##### Argument
+
+`key`: Shall be a scalar expression of type `key_type`.
+It is an `intent(in)` argument.
+
+##### Result character
+
+The result is a scalar integer of kind `int32`.
+
+##### Result value
+
+The result is a hash code created using the `nmhash32` algorithm.
+
+##### Note
+
+`seeded_nmhash32_hasher` is a wrapper to the `NMHASH32_HASH` of the
+module `stdlib_hash_32bit`, which supplies a fixed seed
+to the wrapped function. `NMHASH32` is an implementation of the
+`nmhash32` hash code of James Z. M. Gao.
+This code has good, but not great, performance on long keys, poorer
+performance on short keys.
+As a result it should give fair performance for typical hash map
+applications.
+This code passes the SMHasher tests.
+
+
+##### Example
+
+```fortran
+ program demo_seeded_nmhash32_hasher
+ use stdlib_hashmap_wrappers, only: &
+ seeded_nmhash32_hasher, key_type, set
+ use iso_fortran_env, only: int32
+ implicit none
+ integer(int8), allocatable :: array1(:)
+ integer(int32) :: hash
+ type(key_type) :: key
+ array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ]
+ call set( key, array1 )
+ hash = seeded_nmhash32_hasher (key)
+ print *, hash
+ end program demo_seeded_nmhash32_hasher
+```
+
+#### `seeded_nmhash32x_hasher`- calculates a hash code from a key
+
+##### Status
+
+Experimental
+
+##### Description
+
+Calculates a 32 bit hash code from an input of type `key_type`.
+
+##### Syntax
+
+`code = [[stdlib_hashmap_wrappers:seeded_nmhash32x_hasher]]( key )`
+
+##### Class
+
+Pure function
+
+##### Argument
+
+`key`: Shall be a scalar expression of type `key_type`.
+It is an `intent(in)` argument.
+
+##### Result character
+
+The result is a scalar integer of kind `int32`.
+
+##### Result value
+
+The result is a hash code created using the `nmhash32x` algorithm.
+
+##### Note
+
+`seeded_nmhash32x_hasher` is a wrapper to the `nmhash32x_hash` of the
+module `stdlib_hash_32bit`, which supplies a fixed seed
+to the wrapped function. `nmhash32x` is an implementation of the
+`nmhash32x` hash code of James Z. M. Gao.
+This code has good, but not great, performance on long keys, poorer
+performance on short keys.
+As a result it should give fair performance for typical hash map
+applications.
+This code passes the SMHasher tests.
+
+##### Example
+
+```fortran
+ program demo_seeded_nmhash32x_hasher
+ use stdlib_hashmap_wrappers, only: &
+ seeded_nmhash32x_hasher, key_type, set
+ use iso_fortran_env, only: int32
+ implicit none
+ integer(int8), allocatable :: array1(:)
+ integer(int32) :: hash
+ type(key_type) :: key
+ array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ]
+ call set( key, array1 )
+ hash = seeded_nmhash32x_hasher (key)
+ print *, hash
+ end program demo_seeded_nmhash32x_hasher
+```
+
+#### `seeded_water_hasher`- calculates a hash code from a key
+
+##### Status
+
+Experimental
+
+##### Description
+
+Calculates a 32 bit hash code from an input of type `key_type`.
+
+##### Syntax
+
+`code = [[stdlib_hashmap_wrappers:seeded_water_hasher]]( key )`
+
+##### Class
+
+Pure function
+
+##### Argument
+
+`key`: Shall be a scalar expression of type `key_type`.
+It is an `intent(in)` argument.
+
+##### Result character
+
+The result is a scalar integer of kind `int32`.
+
+##### Result value
+
+The result is a hash code created using the `waterhash` algorithm.
+
+##### Note
+
+`seeded_water_hasher` is a wrapper to the `water_hash` of the
+module `stdlib_hash_32bit`, which supplies a fixed seed
+to the wrapped function. `water_hash` is an implementation of the
+`waterhash` hash code of Tommy Ettinger.
+This code has excellent performance on long keys, and good performance
+on short keys.
+As a result it should give reasonable performance for typical hash
+table applications.
+This code passes the SMHasher tests.
+
+
+##### Example
+
+```fortran
+ program demo_seeded_water_hasher
+ use stdlib_hashmap_wrappers, only: &
+ seeded_water_hasher, key_type, set
+ use iso_fortran_env, only: int32
+ implicit none
+ integer(int8), allocatable :: array1(:)
+ integer(int32) :: hash
+ type(key_type) :: key
+ array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ]
+ call set( key, array1 )
+ hash = seeded_water_hasher (key)
+ print *, hash
+ end program demo_seeded_water_hasher
+```
+
+
+#### `set` - places the data in a derived type
+
+##### Status
+
+Experimental
+
+##### Description
+
+Places the data from `value` in a `key_type` or an `other_type`.
+
+##### Syntax
+
+`call [[stdlib_hashmap_wrappers:set]]( key, value )`
+
+or
+
+`call [[stdlib_hashmap_wrappers:set]]( other, value )`
+
+
+##### Class
+
+Subroutine.
+
+##### Argument
+
+`key`: shall be a scalar variable of type `key_type`. It
+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
+and kind `int8`, while for a first argument of type `other` `value`
+shall be of type `class(*)`. It is an `intent(in)` argument.
+
+##### Note
+
+Values of types other than a scalar default character or an
+`int8` vector can be used as the basis of a `key` by transferring the
+value to an `int8` vector.
+
+##### Example
+
+```fortran
+ program demo_set
+ use stdlib_hashmap_wrappers, only: &
+ get, key_type, set
+ use iso_fortran_env, only: int8
+ implicit none
+ integer(int8), allocatable :: value(:), result(:)
+ type(key_type) :: key
+ integer(int_8) :: i
+ allocate( value(1:15) )
+ do i=1, 15
+ value(i) = i
+ end do
+ call set( key, value )
+ call get( key, result )
+ print *, 'RESULT == VALUE = ', all( value == result )
+ end program demo_set
+```
+
+
+## The `stdlib_hashmaps` module
+
+The `stdlib_hashmaps` module defines three public data types,
+associated procedures and constants that implement two simple hash map
+types using separate chaining hashing and open addressing hashing. The
+derived type `hashmap_type` is the parent type to its two
+extensions: `chaining_hashmap_type` and `open_hashmap_type`.
+The extension types provide
+procedures to manipulate the structure of a hash map object:
+`init`, `map_entry`, `rehash`, `remove`, and
+`set_other_data`. They also provide procedures to inquire about
+entries in the hash map: `get_other_data`, and
+`key_test`. Finally they provide procedures to inquire about the
+overall structure and performance of the hash map object:`calls`,
+`entries`, `get_other_data`, `loading`, `slots`, and
+`total_depth`. The module also defines a number of public constants:
+`probe_factor`, `load_factor`, `map_probe_factor`, `default_bits`,
+`max_bits`, `int_calls`, `int_depth`, `int_index`,
+`int_probes`, `success`, `alloc_fault`, and `array_size_error`.
+
+### The `stdlib_hashmaps` module's public constants
+
+The module defines several categories of public constants. Some are
+used to parameterize the empirical slot expansion code. Others
+parameterize the slots table size. Some are used to define
+integer kind values for different applications. Finally, some are used
+to report errors or success.
+
+The constants `probe_factor`, and `map_probe_factor` are used to
+parameterize the slot expansion code used to determine when in a
+in a procedure call the number
+of slots need to be increased to decrease the search path for an
+entry. The constant `probe_factor` is used to determine when
+the ratio of the number of map probes to map calls is too large and
+the slots need expansion. The constant `map_probe_factor` is used to
+determine when inserting a new entry the ratio of the number of map
+probes to map calls is too large and the slots need expansion.
+
+The constants `default_bits`, and
+`max_bits` are used to parameterize the table's slots size. The
+`default_bits` constant defines the default initial number of slots
+with a current value of 6 resulting in an initial `2**6 == 64`
+slots. This may optionally be overridden on hash map creation. The
+`max_bits` parameter sets the maximum table size as `2**max_bits` with
+a default value for `max_bits` of 30. The table will not work for a
+slots size greater than `2**30`.
+
+The constants `int_calls`, `int_depth`, `int_index`, and `int_probes`
+are used to define integer kind values for various contexts. The
+number of calls are reported and stored in entities of kind
+`int_calls`. Currently `int_calls` has the value of `int64`. The
+total depth, the number of inquiries needed to access all elements
+of the table, is reported and stored in entities of kind
+`int_depth`. Currently `int_depth` has the value of `int64`. The
+number of entries in the table, is reported and stored in entities of
+kind `int_index`. Currently `int_index` has the value of `int32`.
+The number of probes, hash map enquiries, are reported and stored in
+entities of kind `int_probes`. Currently `int_probes` has the value of
+`int64`.
+
+The constant `load_factor` is only used by the `open_hashmap_type`. It
+specifies the maximum fraction of the available slots that may be
+filled before expansion occurs. The current `load_factor = 0.5625` so
+the current implementation of `open_hashmap_type` can only hold a
+little more than `2**29` entries.
+
+Finally the error codes `success`, `alloc_fault`, and
+`array_size_error` are used to report the error status of certain
+procedure calls. The `succes` code indicates that no problems were
+found. The `alloc_fault` code indicates that a memory allocation
+failed. Finally the `array_size_error` indicates that on table
+creation `slots_bits` is less than `default_bits` or
+greater than `max_bits`.
+
+### The `stdlib_hashmaps` module's derived types
+
+The `stdlib_hashmaps` module defines three public derived types and
+seven private types used in the implementation of the public
+types. The public types are the abstract `hashmap_type` and its
+extensions: `chaining_hashmap_type` and `open_hashmap_type`. The three
+private derived types, `chaining_map_entry_type`,
+`chaining_map_entry_ptr`, and `chaining_map_entry_pool` are used in
+the implementation of the `chaining_hashmap_type` public type. The
+four private derived types, `open_map_entry_type`,
+`open_map_entry_list`, `open_map_entry_ptr`, and `open_map_entry_pool`
+are used in the implementation of the `open_hashmap_type` public
+type. Each of these types are described below.
+
+#### The `hashmap_type` abstract type
+
+The `hashmap_type` abstract type serves as the parent type for the two
+types `chaining_hashmap_type` and `open_hashmap_type`. It defines
+seven private components:
+
+* `call_count` - the number of procedure calls on the map;
+
+* `nbits` - the number of bits used to address the slots;
+
+* `num_entries` - the number of entries in the map;
+
+* `num_free` - the number of entries in the free list of removed
+ entries;
+
+* `probe_count` - the number of map probes since the last resizing or
+ initialization;
+
+* `total_probes` - the number of probes of the map up to the last
+ resizing or initialization; and
+
+* `hasher` - a pointer to the hash function used by the map.
+
+It also defines five non-overridable procedures:
+
+* `calls` - returns the number of procedure calls on the map;
+
+* `entries` - returns the number of entries in the map;
+
+* `map_probes` - returns the number of map probes since
+ initialization;
+
+* `num_slots` - returns the number of slots in the map; and
+
+* `slots_bits` - returns the number of bits used to address the slots;
+and eleven deferred procedures:
+
+* `get_other_data` - gets the other map data associated with the key;
+
+* `init` - initializes the hash map;
+
+* `key_test` - returns a logical flag indicating whether the key is
+ defined in the map.
+
+* `loading` - returns the ratio of the number of entries to the number
+ of slots;
+
+* `map_entry` - inserts a key and its other associated data into the
+ map;
+
+* `rehash` - rehashes the map with the provided hash function;
+
+* `remove` - removes the entry associated wit the key;
+
+* `set_other_data` - replaces the other data associated with the key;
+
+* `total_depth` - returns the number of probes needed to address all
+ the entries in the map;
+
+The type's definition is below:
+
+```fortran
+ type, abstract :: hashmap_type
+ private
+ integer(int_calls) :: call_count = 0
+ integer(int_calls) :: probe_count = 0
+ integer(int_calls) :: total_probes = 0
+ integer(int_index) :: num_entries = 0
+ 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_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
+ end type hashmap_type
+```
+
+
+#### The `chaining_map_entry_type` derived type
+
+Entities of the type `chaining_map_entry_type` are used to define
+a linked list structure that stores the
+key, its other data, the hash of the key, and the resulting index into
+the inverse table. The type's definition is below:
+
+```fortran
+ type :: chaining_map_entry_type ! Chaining hash map entry type
+ private
+ integer(int_hash) :: hash_val ! Full hash value
+ type(key_type) :: key ! The entry's key
+ type(other_type) :: other ! Other entry data
+ integer(int_index) :: index ! Index into inverse table
+ type(chaining_map_entry_type), pointer :: &
+ next => null() ! Next bucket
+ end type chaining_map_entry_type
+```
+Currently the `int_hash` and `int_index` have the value of `int32`.
+
+#### The `chaining_map_entry_ptr` derived type
+
+The type `chaining_map_entry_ptr` is used to define the elements of
+the hash map that are either empty or link to the linked lists
+containing the elements of the table. The type's definition is below:
+
+```fortran
+ type chaining_map_entry_ptr ! Wrapper for a pointer to a chaining
+ ! map entry type object
+ type(chaining_map_entry_type), pointer :: target => null()
+ end type chaining_map_entry_ptr
+```
+
+#### The `chaining_map_entry_pool` derived type
+
+The type `chaining_map_entry_pool` is used to implement a pool of
+allocated `chaining_map_entry_type` elements to save on allocation
+costs. The type's definition is below:
+
+```fortran
+ type :: chaining_map_entry_pool
+ ! Type implementing a pool of allocated
+ ! `chaining_map_entry_type` objects
+ private
+ ! Index of next bucket
+ integer(int_index) :: next = 0
+ type(chaining_map_entry_type), allocatable :: more_map_entries(:)
+ type(chaining_map_entry_pool), pointer :: lastpool => null()
+ end type chaining_map_entry_pool
+```
+
+
+#### The `chaining_hashmap_type` derived type
+
+The `chaining_hashmap_type` derived type extends the `hashmap_type` to
+implements a separate chaining hash map. In addition to the components
+of the `hashmap_type` it provides the four components:
+
+* `cache` - a pool of `chaining_map_entry_pool` objects used to reduce
+allocation costs;
+
+* `free_list` - a free list of map entries;
+
+* `inverse` - an array of `chaining_map_entry_ptr` bucket lists
+(inverses) storing entries at fixed locations once
+entered; and
+
+* `slots` - an array of bucket lists serving as the hash map.
+
+It also implements all of the deferred procedures of the
+`hashmap_type` and a finalizer for its maps. The type's definition is
+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_ptr), allocatable :: slots(:)
+ contains
+ procedure :: 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 :: rehash => rehash_chaining_map
+ procedure :: remove => remove_chaining_entry
+ procedure :: set_other_data => set_other_chaining_data
+ procedure :: total_depth => total_chaining_depth
+ final :: free_chaining_map
+ end type chaining_hashmap_type
+```
+
+#### The `open_map_entry_type` derived type
+
+Entities of the type `open_map_entry_type` are used to define
+a linked list structure that stores the
+key, its other data, the hash of the key, and the resulting index into
+the inverse table. The type's definition is below:
+
+```fortran
+ type :: open_map_entry_type ! Open hash map entry type
+ private
+ integer(int_hash) :: hash_val ! Full hash value
+ type(key_type) :: key ! The entry's key
+ type(other_type) :: other ! Other entry data
+ integer(int_index) :: index ! Index into inverse table
+ end type open_map_entry_type
+```
+
+Currently `int_hash` and `int_index` have the value of `int32`.
+
+#### The `open_map_entry_ptr` derived type
+
+The type `open_map_entry_ptr` is used to define the elements of
+the hash map that are either empty or link to the linked lists
+containing the elements of the table. The type's definition is below:
+
+```fortran
+ type open_map_entry_ptr ! Wrapper for a pointer to a open
+ ! map entry type object
+ type(open_map_entry_type), pointer :: target => null()
+ end type open_map_entry_ptr
+```
+
+#### The `open_hashmap_type` derived type
+
+The `open_hashmap_type` derived type extends the `hashmap_type` to
+implement an open addressing hash map. In addition to the components
+of the `hashmap_type` it provides the four components:
+
+* `cache` - a pool of `open_map_entry_pool` objects used to reduce
+allocation costs;
+
+* `free_list` - a free list of map entries;
+
+* `index_mask` - an `and` mask used in linear addressing;
+
+* `inverse` - an array of `open_map_entry_ptr` bucket lists
+(inverses) storing entries at fixed locations once
+entered; and
+
+* `slots` - an array of bucket lists serving as the hash map.
+
+It also implements all of the deferred procedures of the
+`hashmap_type` and a finalizer for its maps. The type's definition is
+as follows:
+
+```fortran
+ 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(:)
+ contains
+ procedure :: 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 :: rehash => rehash_open_map
+ procedure :: remove => remove_open_entry
+ procedure :: set_other_data => set_other_open_data
+ procedure :: total_depth => total_open_depth
+ final :: free_open_map
+ end type open_hashmap_type
+```
+
+### Table of `stdlib_hashmap` procedures
+
+The `stdlib_hashmap` module provides procedures in
+several categories: a procedure to initialize the map; a procedure to
+modify the structure of a map; procedures to modify the content of a
+map; procedures to report on the content of a map; and procedures
+to report on the structure of the map. The procedures in each category
+are listed below.
+
+Procedure to initialize a chaining hash map:
+
+* `map % init( hasher[, slots_bits, status] )` - Routine
+ to initialize a chaining hash map.
+
+Procedure to modify the structure of a map:
+
+* `map % rehash( hasher )` - Routine to change the hash function
+ for a map.
+
+Procedures to modify the content of a map:
+
+* `map % map_entry( key, other, conflict )` - Inserts an entry into the
+ hash map.
+
+* `map % remove( key, existed )` - Remove the entry, if any,
+ associated with the `key`.
+
+* `map % set_other_data( key, other, exists )` - Change the other data
+ associated with the entry.
+
+Procedures to report the content of a map:
+
+* `map % get_other_data( key, other, exists )` - Returns the other data
+ associated with the `key`;
+
+* `map % key_test( key, present)` - Returns a flag indicating whether
+ the `key` is present in the map.
+
+Procedures to report on the structure of the map:
+
+* `map % calls()` - the number of subroutine calls on the hash map.
+
+* `map % entries()`- the number of entries in a hash map.
+
+* `map % loading()` - the number of entries relative to the number of
+ slots in a hash map.
+
+* `map % map_probes()` - the total number of table probes on a hash
+ map.
+
+* `map % slots()` - Returns the number of allocated slots in a hash
+ map.
+
+* `map % total_depth()` - Returns the total number of one's based
+offsets of slot entries from their slot index
+
+
+### Specifications of the `stdlib_hashmaps` procedures
+
+#### `calls` - Returns the number of calls on the hash map
+
+##### Status
+
+Experimental
+
+##### Description
+
+Returns the number of procedure calls on a hash map.
+
+##### Syntax
+
+`value = map % [[hashmap_type(type):calls(bound)]]()`
+
+##### Class
+
+Pure function
+
+##### Argument
+
+`map` (pass) - shall be an expression of class `hashmap_type`.
+It is an `intent(in)` argument.
+
+##### Result character
+
+The result will be an integer of kind `int_calls`.
+
+##### Result value
+
+The result will be the number of procedure calls on the hash map.
+
+##### Example
+
+```fortran
+ program demo_calls
+ use stdlib_hashmaps, only: chaining_hashmap_type, int_calls
+ use stdlib_hashmap_wrappers, only: fnv_1_hasher
+ implicit none
+ type(chaining_hashmap_type) :: map
+ type(int_calls) :: initial_calls
+ call map % init( fnv_1_hasher )
+ initial_calls = map % calls()
+ print *, "INITIAL_CALLS = ", initial_calls
+ end program demo_calls
+```
+
+
+#### `entries` - Returns the number of entries in the hash map
+
+##### Status
+
+Experimental
+
+##### Description
+
+Returns the number of entries in a hash map.
+
+##### Syntax
+
+`value = map % [[hashmap_type(type):entries(bound)]]()`
+
+##### Class
+
+Pure function
+
+##### Argument
+
+`map` (pass) - shall be an expression of class `hashmap_type`.
+It is an `intent(in)` argument.
+
+##### Result character
+
+The result will be an integer of kind `int_index`.
+
+##### Result value
+
+The result will be the number of entries in the hash map.
+
+##### Example
+
+```fortran
+ program demo_entries
+ use stdlib_hashmaps, only: open_hashmap_type, int_index
+ use stdlib_hashmap_wrappers, only: fnv_1_hasher
+ implicit none
+ type(open_hashmap_type) :: map
+ type(int_index) :: initial_entries
+ call map % init( fnv_1_hasher )
+ initial_entries = map % entries ()
+ print *, "INITIAL_ENTRIES = ", initial_entries
+ end program demo_entries
+```
+
+
+#### `get_other_data` - Returns other data associated with the `key`
+
+##### Status
+
+Experimental
+
+##### Description
+
+Returns the other data associated with the `key`,
+
+##### Syntax
+
+`value = map % [[hashmap_type(type):get_other_data(bound)]]( key, other [, exists] )`
+
+##### Class
+
+Subroutine
+
+##### Arguments
+
+`map` (pass): shall be a scalar variable of class
+ `chaining_hashmap_type` or `open_hashmap_type`. It is an
+ `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.
+
+`other`: shall be a variable of type `other_data`.
+ It is an `intent(out)` argument. It is the other data associated
+ with the `key`.
+
+`exists` (optional): shall be a variable of type logical. It is an
+`intent(out)` argument. If `.true.` an entry with the given `key`
+exists in the map and `other` is defined. If `.false.` `other` is
+undefined.
+
+##### Example
+
+ The following is an example of the retrieval of other data
+ associated with a `key`:
+
+
+```fortran
+ program demo_get_other_data
+ use, intrinsic:: iso_fortran_env, only: &
+ int8
+ use stdlib_hashmaps, only: chaining_hashmap_type, int_index
+ use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type
+ logical :: conflict, exists
+ type(key_type) :: key
+ type(other_type) :: other
+ type(chaining_hashmap_type) :: map
+ type dummy_type
+ integer(int8) :: 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 )
+ call map % init( fnv_1_hasher )
+ call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] )
+ call set( other, data )
+ call map % map_entry( key, other, conflict )
+ if ( .not. conflict ) then
+ call map % get_other_data( key, other )
+ else
+ stop 'Key is already present in the map.'
+ end if
+ call get( other, data )
+ select type( data )
+ type (dummy_type)
+ print *, 'Other data % value = ', data % value
+ type default
+ print *, 'Invalid data type in other'
+ end select
+ end program demo_get_other_data
+```
+
+
+#### `init` - initializes a hash map
+
+##### Status
+
+Experimental
+
+##### Description
+
+Initializes a `hashmap_type` object.
+
+##### Syntax
+
+`call map % [[hashmap_type(type):init(bound)]]( hasher [, slots_bits, status ] )`
+
+##### Class
+
+Subroutine
+
+##### Arguments
+
+`map` (pass): shall be a scalar variable of class
+ `chaining_hashmap_type` or `open_hashmap_type`. It is an
+ `intent(out)` argument. It will
+ be a hash map used to store and access the entries.
+
+`hasher`: shall be a procedure with interface `hash_fun`.
+ It is an `intent(in)` argument. It is the procedure to be used to
+ generate the hashes for the table from the keys of the entries.
+
+`slots_bits` (optional): shall be a scalar default integer
+ expression. It is an `intent(in)` argument. The initial number of
+ slots in the table will be `2**slots_bits`.
+
+* `slots_bits` shall be a positive default integer less than
+ `max_bits`, otherwise processing stops with an informative
+ error code.
+
+* If `slots_bits` is absent then the effective value for `slots_bits`
+ is `default_slots_bits`.
+
+`status` (optional): shall be a scalar integer variable of kind
+`int32`. It is an `intent(out)` argument. On return if present it
+shall have an error code value.
+
+* If map was successfully initialized then `status` has the value
+`success`.
+
+* If allocation of memory for the `map` arrays fails then `status`
+has the value `alloc_fault`.
+
+* If `slot_bits < 6` or `slots_bits > max_bits` then `status`
+ has the value of `array_size_error`.
+
+* If `status` is absent, but `status` would have a value other than
+`success`, then processing stops with an informative stop code.
+
+##### Example
+
+```fortran
+ program demo_init
+ use stdlib_hashmaps, only: chaining_map_type
+ use stdlib_hashmap_wrappers, only: fnv_1_hasher
+ type(fnv_1a_type) :: fnv_1
+ type(chaining_map_type) :: map
+ call map % init( fnv_1a, slots_bits=10 )
+ end program demo_init
+```
+
+
+#### `key_test` - indicates whether `key` is present
+
+##### Status
+
+Experimental
+
+##### Description
+
+Returns a logical flag indicating whether `key` is present for an
+entry in the map.
+
+##### Syntax
+
+`call map % [[hashmap_type(type):key_test(bound)]]( key, present )`
+
+##### Class
+
+Subroutine.
+
+##### Arguments
+
+`map` (pass): shall be a scalar variable of class
+`chaining_hashmap_type` or `open_hashmap_type`.
+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.
+
+`present` (optional): shall be a scalar variable of type default
+`logical`. It is an intent(out) argument. It is a logical flag where
+`.true.` indicates that an entry with that `key` is present in the
+`map` and `.false.` indicates that no such entry is present.
+
+##### Example
+
+```fortran
+ program demo_key_test
+ use stdlib_kinds, only: int8
+ use stdlib_hashmaps, only: chaining_hashmap_type
+ use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type
+ implicit none
+ type(chaining_hashmap_type) :: map
+ type(key_type) :: key
+ logocal :: present
+ call map % init( fnv_1_hasher )
+ call set(key, [0_int8, 1_int8] )
+ call map % key_test ( key, present )
+ print *, "Initial key of 10 present for empty map = ", present
+ end program demo_key_test
+```
+
+
+#### `loading` - Returns the ratio of entries to slots
+
+##### Status
+
+Experimental
+
+##### Description
+
+Returns the ratio of the number of entries relative to the number of
+slots in the hash map.
+
+##### Syntax
+
+`value = map % [[hashmap_type(type):loading(bound)]]( )`
+
+##### Class
+
+Pure function
+
+##### Argument
+
+`map` (pass) - shall be an expression of class `chaining_hashmap_type`
+or `open_hashmap_type`. It is an `intent(in)` argument.
+
+##### Result character
+
+The result will be a default real.
+
+##### Result value
+
+The result will be the ratio of the number of entries relative to the
+number of slots in the hash map.
+
+##### Example
+
+```fortran
+ program demo_loading
+ use stdlib_hashmaps, only: open_hashmap_type
+ use stdlib_hashmap_wrappers, only: fnv_1_hasher
+ implicit none
+ type(open_hashmap_type) :: map
+ real :: ratio
+ call map % init( fnv_1_hasher )
+ ratio = map % loading ()
+ print *, "Initial loading = ", ratio
+ end program demo_loading
+```
+
+#### `map_entry` - inserts an entry into the hash map
+
+##### Status
+
+Experimental
+
+##### Description
+
+Inserts an entry into the hash map if it is not already present.
+
+##### Syntax
+
+`call map % [[hashmap_type(type):map_entry(bound)]]( key[, other, conflict ] )`
+
+
+##### Class
+
+Subroutine
+
+##### Arguments
+
+`map` (pass): shall be a scalar variable of class
+`chaining_hashmap_type` or `open_hashmap_type`. It
+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.
+
+`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
+ associated with the `key`.
+
+`conflict` (optional): shall be a scalar variable of type
+`logical`. It is an `intent(in)` argument. If present, a `.true.`
+value indicates that an entry with the value of `key` already exists
+and the entry was not entered into the map, a `.false.` value indicates
+that `key` was not present in the map and the entry was added to the
+map.
+
+* If `key` is already present in `map` then the presence of `other`
+is ignored.
+
+##### Example
+
+```fortran
+ program demo_map_entry
+ use, intrinsic:: iso_fortran_env, only: int8
+ use stdlib_hashmaps, only: chaining_hashmap_type
+ use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type
+ type(chaining_hashmap_type) :: map
+ type(key_type) :: key
+ logical :: conflict
+ type(other_type) :: other
+ class(*), allocatable :: dummy
+ allocate( dummy, source=4 )
+ call map % init( fnv_1_hasher, slots_bits=10 )
+ call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] )
+ call set( other, dummy )
+ call map % map_entry( key, other, conflict )
+ print *, 'CONFLICT = ', conflict
+ end program demo_map_entry
+```
+
+#### `map_probes` - returns the number of hash map probes
+
+##### Status
+
+Experimental
+
+##### Description
+
+Returns the total number of table probes on the hash map.
+
+##### Syntax
+
+`result = map % [[hashmap_type(type):map_probes(bound)]]( )`
+
+##### Class
+
+Pure function
+
+##### Argument
+
+`map` (pass): shall be a scalar expression of class
+`hashmap_type`. It is an `intent(in)`
+argument. It is the hash map of interest.
+
+##### Result character
+
+The result is a scalar integer of kind `int_probes`.
+
+##### Result value
+
+The result is the number of probes of `map` since initialization or
+rehashing.
+
+##### Example
+
+```fortran
+ program demo_probes
+ use stdlib_hashmaps, only: chaining_hashmap_type, int_index
+ use stdlib_hashmap_wrappers: fnv_1_hasher
+ implicit none
+ type(chaining_hashmap_type) :: map
+ real :: nprobes
+ call map % init( fnv_1_hasher )
+ nprobes = map % probes()
+ print *, "Initial probes = ", nprobes
+ end program demo_probes
+```
+
+#### `num_slots` - returns the number of hash map slots.
+
+##### Status
+
+Experimental
+
+##### Description
+
+Returns the total number of slots on a hash map
+
+##### Syntax
+
+`result = map % [[hashmap_type(type):num_slots(bound)]]( )`
+
+##### Class
+
+Pure function
+
+##### Argument
+
+`map`: shall be a scalar expression of class
+`hashmap_type`. It is an `intent(in)` argument. It is the
+hash map of interest.
+
+##### Result character
+
+The result is a scalar integer of kind `int_index`.
+
+##### Result value
+
+The result is the number of slots in `map`.
+
+##### Example
+
+```fortran
+ program demo_num_slots
+ use stdlib_hashmaps, only: chaining_hashmap_type, int_index
+ use stdlib_hashmap_wrappers, only: fnv_1_hasher
+ implicit none
+ type(chaining_hashmap_type) :: map
+ integer(int_index) :: initial_slots
+ call map % init( fnv_1_hasher )
+ initial_slots = map % num_slots ()
+ print *, "Initial slots = ", initial_slots
+ end program num_slots
+```
+
+
+#### `rehash` - changes the hashing function
+
+##### Status
+
+Experimental
+
+##### Description
+
+Changes the hashing function for the map entries to that of `hasher`.
+
+##### Syntax
+
+`call map % [[hashmap_type(type):rehash(bound)]]( hasher )`
+
+##### Class
+
+Subroutine
+
+##### Arguments
+
+`map` (pass): shall be a scalar variable of class
+`chaining_hashmap_type` or `open_hashmap_type`.
+It is an `intent(inout)` argument. It is the hash map whose hashing
+method is to be changed.
+
+`hasher`: shall be a function of interface `hasher_fun`.
+It is the hash method to be used by `map`.
+
+##### Example
+
+```fortran
+ program demo_rehash
+ use stdlib_hashmaps, only: open_hashmap_type
+ use stdlib_hasmap_wrappers, only: fnv_1_hasher, fnv_1a_hasher,&
+ key_type, other_type
+ type(openn_hashmap_type) :: map
+ type(key_type) :: key
+ type(other_type) :: other
+ class(*), allocatable :: dummy
+ allocate( dummy, source='a dummy value' )
+ call map % init( fnv_1_hasher, slots_bits=10 )
+ call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] )
+ call set( other, dummy )
+ call map % map_entry( key, other )
+ call map % rehash( fnv_1a_hasher )
+ end program demo_rehash
+```
+
+#### `remove` - removes an entry from the hash map
+
+##### Status
+
+Experimental
+
+##### Description
+
+Removes an entry from the hash map, `map`.
+
+##### Syntax
+
+`call map % [[hashmap_type(type):remove(bound)]]( key[, existed ])`
+
+##### Class
+
+Subroutine
+
+##### Arguments
+
+`map` (pass): shall be a scalar variable of class
+`chaining_hashmap_type` or `open_hashmap_type`.
+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.
+
+`existed` (optional): shall be a scalar variable of type default
+logical. It is an `intent(out)` argument. If present with the value
+`.true.` the entry existed in the map before removal, if `.false.` the
+entry was not present to be removed and the map is unchanged. If
+absent, the procedure returns with no entry with the given key.
+
+##### Example
+
+```fortran
+ program demo_remove
+ use stdlib_hashmaps, only: open_hashmap_type, int_index
+ use stdlib_hashmap_wrappers, only: fnv_1_hasher, &
+ fnv_1a_hasher, key_type, other_type
+ type(open_hashmap_type) :: map
+ type(key_type) :: key
+ type(other_type) :: other
+ logical :: existed
+ class(*), allocatable :: dummy
+ allocate( dummy, source=4.0 )
+ call map % init( fnv_1_hasher, slots_bits=10 )
+ call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] )
+ call set( other, dummy )
+ call map % map_entry( key, other )
+ call map % remove( key, existed )
+ print *, "Removed key existed = ", existed
+ end program demo_remove
+```
+
+#### `set_other_data` - replaces the other data for an entry
+
+##### Status
+
+Experimental
+
+##### Description
+
+Replaces the other data in the map for the entry with the key value,
+`key`.
+
+##### Syntax
+
+`call map % [[hashmap_type(type):set_other_data(bound)]]( key, other[, exists] )`
+
+##### Class
+
+Subroutine
+
+##### Arguments
+
+`map` (pass): shall be a scalar variable of class
+`chaining_hashmap_type` or `open_hashmap_type`. It
+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.
+
+`other`: shall be a scalar expression of type `other_type`.
+It is an `intent(in)` argument. It is the data to be stored as
+the other data for the entry with the key value, `key`.
+
+`exists` (optional): shall be a scalar variable of type default
+logical. It is an `intent(out)` argument. If present with the value
+`.true.` an entry with that `key` existed in the map and its `other`
+data was replaced, otherwise if `exists` is `.false.` the entry did
+not exist and nothing was done.
+
+
+##### Example
+
+```fortran
+ program demo_set_other_data
+ use stdlib_hashmaps, only: open_hashmap_type
+ use stdlib_hashmap_wrappers, only: fnv_1_hasher, &
+ fnv_1a_hasher, key_type, other_type, set
+ type(open_hashmap_type) :: map
+ type(key_type) :: key
+ type(other_type) :: other
+ class(*), allocatable :: dummy
+ 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 map % map_entry( key, other )
+ deallocate( dummy )
+ allocate( dummy, source='Another value` )
+ call set( other, dummy )
+ call map % set_other_data( key, other, exists )
+ print *, 'The entry to have its other data replaced exists = ', exists
+ end program demo_set_other_data
+```
+
+#### `slots_bits` - returns the number of bits used to address the hash map slots
+
+##### Status
+
+Experimental
+
+##### Description
+
+Returns the total number of bits used to address the hash map slots.
+
+##### Syntax
+
+`result = map % [[hashmap_type(type):slots_bits(bound)]]( )`
+
+##### Class
+
+Pure function
+
+##### Argument
+
+`map` (pass): shall be a scalar expression of class
+`hashmap_type`. It is an `intent(in)` argument. It is the
+hash map of interest.
+
+##### Result character
+
+The result is a scalar integer of kind `int_index`.
+
+##### Result value
+
+The result is the number of bits used in addressing the slots in `map`.
+
+##### Example
+
+```fortran
+ program demo_slots_bits
+ use stdlib_hashmaps, only: chaining_hashmap_type
+ use stdlib_hashmap_wrappers, only: fnv_1_hasher
+ implicit none
+ type(chaining_hashmap_type) :: map
+ integer :: bits
+ call map % init( fnv_1_hasher )
+ bits = map % slots_bits ()
+ print *, "Initial slot bits = ", bits
+ end program demo_slots_bits
+```
+
+
+#### `total_depth` - returns the total depth of the hash map entries
+
+##### Status
+
+Experimental
+
+##### Description
+
+Returns the total number of one's based offsets of slot entries from
+their slot index for a hash map
+
+##### Syntax
+
+`result = map % [[hashmap_type:total_depth]]( )`
+
+##### Class
+
+Pure function
+
+##### Argument
+
+`map` (pass): shall be a scalar expression of class
+`hashmap_type`. It is an `intent(in)` argument. It is the
+hash map of interest.
+
+##### Result character
+
+The result is a scalar integer of kind `int_depth`.
+
+##### Result value
+
+The result is the total number of one's based offsets of slot entries
+from their slot index the map.
+
+##### Example
+
+```fortran
+ program demo_total_depth
+ use stdlib_hashmaps, only: chaining_hashmap_type, int_depth
+ use stdlib_hashmap_wrappers, only: fnv_1_hasher
+ implicit none
+ type(chaining_hashmap_type) :: map
+ integer(int_depth) :: initial_depth
+ call map % init( fnv_1_hasher )
+ initial_depth = map % total_depth ()
+ print *, "Initial total depth = ", initial_depth
+ end program demo_total_depth
+```
diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt
index 40a5940a6..b79d920e9 100644
--- a/src/CMakeLists.txt
+++ b/src/CMakeLists.txt
@@ -84,6 +84,10 @@ fypp_f90("${fyppFlags}" "${fppFiles}" outFiles)
set(SRC
stdlib_array.f90
stdlib_error.f90
+ stdlib_hashmap_wrappers.f90
+ stdlib_hashmaps.f90
+ stdlib_hashmap_chaining.f90
+ stdlib_hashmap_open.f90
stdlib_logger.f90
stdlib_system.F90
stdlib_specialfunctions.f90
diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90
new file mode 100755
index 000000000..7db08861a
--- /dev/null
+++ b/src/stdlib_hashmap_chaining.f90
@@ -0,0 +1,849 @@
+!! The module STDLIB_HASHMAP_CHAINING implements a simple separate
+!! chaining hash map. The implementation is loosely based on a C
+!! implementation by David Chase, http://chasewoerner.org/src/hasht/, for
+!! which he has given permission to use in the Fortran Standard Library.
+
+! Note an error in the code caused attempts to deallocate already deallocated
+! entries. This did not cause stat to be non-zero, but did cause system errors,
+! on my Mac. I therefore decided to remove all deallocation error reporting.
+
+submodule(stdlib_hashmaps) stdlib_hashmap_chaining
+!! Version: Experimental
+!!
+!! Implements a simple separate chaining hash map.
+
+ implicit none
+
+! Error messages
+ character(len=*), parameter :: &
+ alloc_inv_fault = "CHAINING_HASHMAP_TYPE % INVERSE allocation " // &
+ "fault.", &
+ alloc_slots_fault = "CHAINING_HASHMAP_TYPE % SLOTS allocation " // &
+ "fault.", &
+ conflicting_key = "KEY already exists in MAP.", &
+ expand_slots_fail = "CHAINING_HASHMAP_TYPE % SLOTS allocation > " // &
+ "max bits.", &
+ init_slots_pow_fail = "SLOT_BITS is not between DEFAULT_BITS " // &
+ "and MAX_BITS.", &
+ invalid_inmap = "INMAP was not a valid INVERSE index.", &
+ map_consist_fault = "The hash map found a inconsistency."
+
+ character(len=*), parameter :: submodule_name = "STDLIB_HASHMAP_CHAINING"
+
+ interface expand_slots
+!! Version: Experimental
+!!
+!! Interface to internal procedure that expands the number of map slots.
+ module procedure expand_chaining_slots
+ end interface expand_slots
+
+ interface extend_map_entry_pool
+!! Version: Experimental
+!!
+!! Interface to internal procedure that expands a chaining map entry pool.
+ module procedure extend_chaining_map_entry_pool
+ end interface extend_map_entry_pool
+
+ interface free_map
+!! Version: Experimental
+!!
+!! Interface to procedure that finalizes a chaining hash map.
+ module procedure free_chaining_map
+ end interface free_map
+
+ interface free_map_entry_pool
+!! Version: Experimental
+!!
+!! Interface to internal procedure that finalizes a chaining hash map
+!! entry pool.
+ module procedure free_map_entry_pool
+ end interface free_map_entry_pool
+
+ interface get_other_data
+!! Version: Experimental
+!!
+!! Interface to procedure that gets an entry's other data.
+ module procedure get_other_chaining_data
+ end interface get_other_data
+
+ interface init
+!! Version: Experimental
+!!
+!! Interface to initialization procedure for a chaining hash map.
+ module procedure init_chaining_map
+ end interface init
+
+ interface rehash
+!! Version: Experimental
+!!
+!! Interface to a procedure that changes the hash function that
+!! is used to map the keys into a chaining hash map.
+ module procedure rehash_chaining_map
+ end interface rehash
+
+ interface remove
+!! Version: Experimental
+!!
+!! Interface to a procedure that removes the entry associated with a key
+ module procedure remove_chaining_entry ! Chase's delent
+ end interface remove
+
+ interface set_other_data
+!! Version: Experimental
+!!
+!! Interface to a procedure that changes the other data associated with a key
+ module procedure set_other_chaining_data
+ end interface set_other_data
+
+contains
+
+! Internal routine to make a duplicate map with more hash slots.
+! Note David Chase had pointer returning functions, but the logic did not
+! depend on the result value
+ subroutine expand_chaining_slots( map )
+!! Version: Experimental
+!!
+!! Internal routine to make a duplicate map with more hash slots.
+!! Doubles the size of the map % slots array
+!! Arguments:
+!! map - the hash map whose hash slots are to be expanded
+!
+ type(chaining_hashmap_type), intent(inout) :: map
+
+ type(chaining_map_entry_type), pointer :: current_entry
+ type(chaining_map_entry_ptr), allocatable :: dummy_slots(:)
+ integer(int_index) :: min_size, new_size
+ integer(int_index) :: old_size, &
+ slot_index
+ integer(int32) :: bits, &
+ stat
+ character(256) :: errmsg
+ character(*), parameter :: procedure = 'EXPAND_SLOTS'
+
+ if ( map % nbits == max_bits ) then
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ expand_slots_fail
+ end if
+
+ old_size = size(map % slots, kind=int_index)
+
+ determine_new_size: if ( map % num_entries <= old_size ) then
+! Expand by factor of two to improve efficiency
+ new_size = 2*old_size
+ bits = map % nbits + 1
+ else
+! Expand so the number of slots is no more than 2**max_bits but otherwise
+! at least the number of entries
+ min_size = map % num_entries
+ new_size = old_size
+ bits = map % nbits
+ do
+ bits = bits + 1
+ new_size = new_size * 2
+ if ( bits >= max_bits .OR. new_size >= min_size ) exit
+ end do
+ end if determine_new_size
+
+ allocate( dummy_slots(0:new_size-1), stat=stat, errmsg=errmsg )
+ if (stat /= 0) then
+ write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg)
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ alloc_slots_fault
+ end if
+
+ map % nbits = bits
+ do slot_index=0, new_size-1
+ dummy_slots(slot_index) % target => null() ! May be redundant
+ end do
+
+ map % total_probes = map % total_probes + map % probe_count
+ map % probe_count = 0
+
+! This maps old slots entries to new slots, but we could also map inverse
+! entries to new_slots
+ do slot_index=0, old_size-1
+ do while( associated(map % slots(slot_index) % target) )
+ current_entry => map % slots(slot_index) % target
+ map % slots(slot_index) % target => current_entry % next
+ call remap( dummy_slots, current_entry, map % nbits )
+ end do
+ end do
+
+ call move_alloc( dummy_slots, map % slots )
+
+ contains
+
+ subroutine remap(slots, gentry, bits)
+ type(chaining_map_entry_ptr), intent(inout) :: slots(0:)
+ type(chaining_map_entry_type), intent(inout), target :: gentry
+ integer(int_hash), intent(in) :: bits
+
+ integer(int_index) :: hash_index
+ type(chaining_map_entry_type), pointer :: where_loc
+
+ hash_index = fibonacci_hash( gentry % hash_val, bits )
+ where_loc => slots(hash_index) % target
+ gentry % next => null() ! May be redundant
+
+ if ( associated( where_loc ) ) then
+ do while ( associated(where_loc % next) )
+ where_loc => where_loc % next
+ end do
+ where_loc % next => gentry
+ else
+ slots(hash_index) % target => gentry
+ end if
+
+ end subroutine remap
+
+ end subroutine expand_chaining_slots
+
+
+ subroutine extend_chaining_map_entry_pool(map) ! gent_pool_new
+!! Version: Experimental
+!!
+!! Add more map_entrys to the pool head
+!! Arguments:
+!! pool - a chaining map entry pool
+ type(chaining_hashmap_type), intent(inout) :: map
+
+ type(chaining_map_entry_pool), pointer :: pool
+
+ allocate(pool)
+ allocate(pool % more_map_entries(0:pool_size-1))
+ pool % next = 0 ! may be redundant
+ pool % lastpool => map % cache
+ map % cache => pool
+
+ end subroutine extend_chaining_map_entry_pool
+
+
+! Internal final routine to free a map and its memory
+ module subroutine free_chaining_map( map )
+!! Version: Experimental
+!!
+!! Frees internal memory of an chaining map
+!! Arguments:
+!! map - the chaining hash map whose memory is to be freed
+!
+ type(chaining_hashmap_type), intent(inout) :: map
+
+ integer(int_index) :: i
+ type(chaining_map_entry_type), pointer :: next
+
+ if ( allocated( map % slots ) ) then
+ remove_slot_links: do i=0, size( map % slots ) - 1
+ if ( associated( map % slots(i) % target ) ) then
+ map % slots(i) % target => null()
+ end if
+ end do remove_slot_links
+ deallocate( map % slots )
+ end if
+
+ if ( allocated( map % inverse) ) then
+ remove_links: do i=1, size( map % inverse, kind=int_index )
+ if ( associated( map % inverse(i) % target ) ) then
+ map % inverse(i) % target % next => null()
+ end if
+ map % inverse(i) % target => null()
+ end do remove_links
+ deallocate( map % inverse )
+ end if
+
+ free_free_list: do
+ if ( associated( map % free_list) ) then
+ next => map % free_list % next
+ map % free_list => next
+ cycle free_free_list
+ else
+ map % num_free = 0
+ exit free_free_list
+ end if
+ end do free_free_list
+
+ if ( associated( map % cache ) ) call free_map_entry_pool(map % cache)
+
+ map % num_entries = 0
+
+ end subroutine free_chaining_map
+
+
+ recursive subroutine free_map_entry_pool(pool) ! gent_pool_free
+!! Version: Experimental
+!!
+!! Recursively descends map entry pool list freeing each element
+!! Arguments:
+!! pool The map entry pool whose elements are to be freed
+!
+ type(chaining_map_entry_pool), intent(inout), pointer :: pool
+
+ if ( .not. associated(pool) ) return
+ call free_map_entry_pool(pool % lastpool)
+ deallocate( pool )
+
+ end subroutine free_map_entry_pool
+
+
+ module subroutine get_other_chaining_data( map, key, other, exists )
+!! Version: Experimental
+!!
+!! Returns the other data associated with the inverse table index
+!! Arguments:
+!! map - a chaining hash map
+!! key - the key associated with a map entry
+!! other - the other data associated with the key
+!! exists - a logical flag indicating whether an entry with that key exists
+!
+ class(chaining_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(out) :: other
+ logical, intent(out), optional :: exists
+
+ integer(int_index) :: inmap
+ character(*), parameter :: procedure = 'GET_OTHER_DATA'
+
+ call in_chain_map(map, inmap, key)
+ if ( inmap <= 0 .or. &
+ inmap > size(map % inverse, kind=int_index ) ) then
+ if ( present(exists) ) then
+ exists = .false.
+ return
+ else
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ invalid_inmap
+ end if
+ else if ( associated( map % inverse(inmap) % target ) ) then
+ if (present(exists) ) exists = .true.
+ call copy_other( map % inverse(inmap) % target % other, other )
+ else
+ if ( present(exists) ) then
+ exists = .false.
+ return
+ else
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ map_consist_fault
+ end if
+ end if
+
+ end subroutine get_other_chaining_data
+
+
+ subroutine in_chain_map(map, inmap, key)
+!! Version: Experimental
+!!
+!! Returns the index into the INVERSE array associated with the KEY
+!! Arguments:
+!! map - the hash map of interest
+!! inmap - the returned index into the INVERSE array of entry pointers.
+!! A value of zero indicates that an entry with that key was not
+!! found.
+!! key - the key identifying the entry of interest
+!
+ class(chaining_hashmap_type), intent(inout) :: map
+ integer(int_index), intent(out) :: inmap
+ type(key_type), intent(in) :: key
+
+ integer(int_hash) :: hash_val, hash_index
+ type(chaining_map_entry_type), pointer :: gentry, pentry, sentry
+
+ if ( map % probe_count > inmap_probe_factor * map % call_count ) then
+ if ( map % nbits < max_bits .AND. &
+ map % num_entries > size( map % slots, kind=int_index ) ) then
+ call expand_slots(map)
+ end if
+ end if
+ map % call_count = map % call_count + 1
+ hash_val = map % hasher( key )
+ hash_index = fibonacci_hash( hash_val, map % nbits )
+ pentry => map % slots(hash_index) % target
+ sentry => pentry
+
+ climb_chain: do
+ gentry => pentry
+ map % probe_count = map % probe_count + 1
+ if (.not. associated( gentry ) ) then
+ inmap = 0
+ return
+ else if ( hash_val == gentry % hash_val ) then
+ if ( key == gentry % key ) then
+! The swap to front seems to confuse gfortran's pointers
+! if ( .not. associated( pentry, sentry ) ) then
+! ! swap to front
+! pentry => gentry % next
+! gentry % next => sentry
+! sentry => gentry
+! end if
+ inmap = gentry % inmap
+ return
+ end if
+ end if
+ pentry => gentry % next
+ end do climb_chain
+
+ end subroutine in_chain_map
+
+
+ module subroutine init_chaining_map( map, &
+ hasher, &
+ slots_bits, &
+ status )
+!! Version: Experimental
+!!
+!! Routine to allocate an empty map with HASHER as the hash function,
+!! 2**SLOTS_BITS initial SIZE(map % slots), and SIZE(map % slots) limited
+!! to a maximum of 2**MAX_BITS. All fields are initialized.
+!! Arguments:
+!! map - the chaining hash map to be initialized
+!! hasher - the hash function to be used to map keys to slots
+!! slots_bits - the bits of two used to initialize the number of slots
+!! status - an integer error status flag with the allowed values:
+!! success - no problems were found
+!! alloc_fault - map % slots or map % inverse could not be allocated
+!! array_size_error - slots_bits is less than default_bits or
+!! greater than max_bits
+!
+ class(chaining_hashmap_type), intent(out) :: map
+ procedure(hasher_fun) :: hasher
+ integer, intent(in), optional :: slots_bits
+ integer(int32), intent(out), optional :: status
+
+ character(256) :: errmsg
+ integer(int_index) :: index
+ character(*), parameter :: procedure = 'INIT'
+ integer(int_index) :: slots
+ integer(int32) :: stat
+
+ map % call_count = 0
+ map % probe_count = 0
+ map % total_probes = 0
+
+ map % hasher => hasher
+
+ call free_chaining_map( map )
+
+ if ( present(slots_bits) ) then
+ if ( slots_bits < 6 .OR. slots_bits > max_bits ) then
+ if ( present(status) ) then
+ status = array_size_error
+ return
+ else
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ init_slots_pow_fail
+ end if
+ end if
+ map % nbits = slots_bits
+ else
+ map % nbits = min( default_bits, max_bits )
+ end if
+
+ slots = 2_int_index**map % nbits
+
+ allocate( map % slots(0:slots-1), stat=stat, errmsg=errmsg )
+ if ( stat /= 0 ) then
+ if ( present(status) ) then
+ status = alloc_fault
+ return
+ else
+ write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg)
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ alloc_slots_fault
+ end if
+ end if
+ do index = 0, size( map % slots, kind=int_index )-1
+ map % slots(index) % target => null() ! May be redundant
+ end do
+
+! 5*s from Chase's g_new_map
+ allocate( map % inverse(1:slots), stat=stat, errmsg=errmsg )
+ if ( stat /= 0 ) then
+ if ( present( status ) ) then
+ status = alloc_fault
+ return
+ else
+ write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg)
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ alloc_inv_fault
+ end if
+ end if
+ do index=1, size(map % inverse, kind=int_index)
+ map % inverse(index) % target => null()
+ end do
+
+ call extend_map_entry_pool(map)
+
+ if (present(status) ) status = success
+
+ end subroutine init_chaining_map
+
+
+ pure module function chaining_loading( map )
+!! Version: Experimental
+!!
+!! Returns the number of entries relative to slots in a hash map
+!! Arguments:
+!! map - a chaining hash map
+ class(chaining_hashmap_type), intent(in) :: map
+ real :: chaining_loading
+
+ chaining_loading = real( map % num_entries ) / &
+ real( size( map % slots, kind=int_index ) )
+
+ end function chaining_loading
+
+
+ module subroutine map_chain_entry(map, key, other, conflict)
+!! Version: Experimental
+!!
+!! Inserts an entry into the hash table
+!! Arguments:
+!! map - the hash table of interest
+!! key - the key identifying the entry
+!! other - other data associated with the key
+!! conflict - logical flag indicating whether the entry key conflicts
+!! with an existing key
+!
+ class(chaining_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(in), optional :: other
+ logical, intent(out), optional :: conflict
+
+ integer(int_hash) :: hash_index
+ integer(int_hash) :: hash_val
+ integer(int_index) :: inmap
+ type(chaining_map_entry_type), pointer :: new_ent
+ type(chaining_map_entry_type), pointer :: gentry, pentry, sentry
+ character(*), parameter :: procedure = 'MAP_ENTRY'
+
+ hash_val = map % hasher( key )
+
+ if ( map % probe_count > map_probe_factor * map % call_count ) then
+ call expand_slots(map)
+ end if
+ map % call_count = map % call_count + 1
+ hash_index = fibonacci_hash( hash_val, map % nbits )
+ pentry => map % slots(hash_index) % target
+ sentry => pentry
+
+ do
+ gentry => pentry
+ map % probe_count = map % probe_count + 1
+ if ( .not. associated( gentry ) ) then
+ call allocate_chaining_map_entry( map, new_ent )
+ new_ent % hash_val = hash_val
+! Adding to tail of chain doesn't work on gfortran
+! new_ent % next => sentry
+! sentry => new_ent
+! Adding to head of chain works on gfortran
+ new_ent % next => map % slots(hash_index) % target
+ map % slots(hash_index) % target => new_ent
+ call copy_key( key, new_ent % key )
+ if ( present(other) ) call copy_other( other, new_ent % other )
+
+ if ( new_ent % inmap == 0 ) then
+ map % num_entries = map % num_entries + 1
+ inmap = map % num_entries
+ else
+ inmap = new_ent % inmap
+ end if
+
+ if ( inmap == size( map % inverse, kind=int_index ) ) then
+ call expand_inverse( map )
+ end if
+ new_ent % inmap = inmap
+ map % inverse(inmap) % target => new_ent
+ if ( present(conflict) ) conflict = .false.
+
+ return
+
+ else if ( hash_val == gentry % hash_val ) then
+ if ( key == gentry % key ) then
+ inmap = gentry % inmap
+ if ( .not. associated( pentry, sentry ) ) then
+ ! Swap to front
+ pentry => gentry % next
+ gentry % next => sentry
+ sentry => gentry
+ end if
+ if ( present(conflict) ) then
+ conflict = .true.
+ else
+ error stop submodule_name // ' % ' // procedure &
+ // ': ' // conflicting_key
+ end if
+ return
+ end if
+ end if
+ pentry => gentry % next
+
+ end do
+
+ contains
+
+ subroutine allocate_chaining_map_entry(map, bucket) ! Chases gent_malloc
+! allocates a hash bucket
+ type(chaining_hashmap_type), intent(inout) :: map
+ type(chaining_map_entry_type), pointer, intent(out) :: bucket
+
+ type(chaining_map_entry_pool), pointer :: pool
+
+ pool => map % cache
+ map % num_entries = map % num_entries + 1
+ if ( associated(map % free_list) ) then
+! Get hash bucket from free_list
+ bucket => map % free_list
+ map % free_list => bucket % next
+ map % num_free = map % num_free - 1
+ else
+! Get hash bucket from pool
+ if ( pool % next == pool_size ) then
+! Expand pool
+ call extend_map_entry_pool(map)
+ pool => map % cache
+ end if
+ bucket => pool % more_map_entries(pool % next)
+ pool % next = pool % next + 1 ! 0s based
+ if ( map % num_entries > &
+ size( map % inverse, kind=int_index ) ) &
+ then
+ call expand_inverse( map )
+ end if
+ bucket % inmap = map % num_entries
+ end if
+
+ end subroutine allocate_chaining_map_entry
+
+
+ subroutine expand_inverse(map)
+! Increase size of map % inverse
+ type(chaining_hashmap_type), intent(inout) :: map
+ type(chaining_map_entry_ptr), allocatable :: dummy_inverse(:)
+ integer(int32) :: stat
+ character(256) :: errmsg
+ character(*), parameter :: procedure = 'MAP_ENTRY'
+
+ allocate( dummy_inverse( 1:2*size(map % inverse, &
+ kind=int_index) ), &
+ stat=stat, &
+ errmsg=errmsg )
+ if ( stat /= 0 ) then
+ write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg)
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ alloc_inv_fault
+ end if
+
+ dummy_inverse(1:size(map % inverse, kind=int_index)) = &
+ map % inverse(:)
+
+ call move_alloc( dummy_inverse, map % inverse )
+
+ end subroutine expand_inverse
+
+ end subroutine map_chain_entry
+
+
+ module subroutine rehash_chaining_map( map, hasher )
+!! Version: Experimental
+!!
+!! Changes the hashing method of the table entries to that of HASHER.
+!! Arguments:
+!! map the table to be rehashed
+!! hasher the hasher function to be used for the table
+!
+ class(chaining_hashmap_type), intent(inout) :: map
+ procedure(hasher_fun) :: hasher
+
+ integer(int_hash) :: hash_val
+ integer(int_index) :: i
+ integer(int_index) :: index
+
+ map % hasher => hasher
+
+ do i=0, size( map % slots, kind=int_index ) - 1
+ map % slots(i) % target => null()
+ end do
+
+ do i=1, map % num_entries + map % num_free
+ if ( .not. associated( map % inverse(i) % target ) ) cycle
+ hash_val = map % hasher ( map % inverse(i) % target % key )
+ map % inverse(i) % target % hash_val = hash_val
+ index = fibonacci_hash( hash_val, map % nbits )
+ map % inverse(i) % target % inmap = i
+ if ( associated( map % slots(index) % target ) ) then
+ map % inverse(i) % target % next => map % slots(index) % target
+ map % slots(index) % target => map % inverse(i) % target
+ else
+ map % slots(index) % target => map % inverse(i) % target
+ map % slots(index) % target % next => null()
+ end if
+ end do
+
+ end subroutine rehash_chaining_map
+
+
+ module subroutine remove_chaining_entry(map, key, existed)
+!! Remove the entry, if any, that has the key
+!! Arguments:
+!! map - the table from which the entry is to be removed
+!! key - the key to an entry
+!! existed - a logical flag indicating whether an entry with the key
+!! was present in the original map
+!
+ class(chaining_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ logical, intent(out), optional :: existed
+
+ type(chaining_map_entry_type), pointer :: bucket, aentry, bentry, centry
+ integer(int_hash) :: hash_val
+ integer(int_index) :: inmap, k, level
+
+ call in_chain_map( map, inmap, key )
+ if ( inmap < 1 .or. inmap > size( map % inverse ) ) then
+ if ( present( existed ) ) existed = .false.
+ return
+ end if
+
+ bucket => map % inverse(inmap) % target
+ if ( .not. associated(bucket) ) then
+ if ( present( existed ) ) existed = .false.
+ return
+ end if
+ if ( present(existed) ) existed = .true.
+ hash_val = bucket % hash_val
+ k = fibonacci_hash( hash_val, map % nbits )
+ allocate(aentry)
+ aentry => map % slots(k) % target
+ if ( associated(aentry) ) then
+ if ( aentry % inmap == inmap ) then
+ bentry => aentry % next
+ map % slots(k) % target => bentry
+ aentry % next => map % free_list
+ map % free_list => aentry
+ map % inverse(inmap) % target => null()
+ map % num_free = map % num_free + 1
+ map % num_entries = map % num_entries - 1
+ return
+ end if
+ else
+ return
+ end if
+ level = 1
+ centry => map % slots(k) % target
+ aentry => aentry % next
+
+ FIND_SLOTS_ENTRY:do
+ if ( .not. associated(aentry) ) return
+ if ( aentry % inmap == inmap ) exit
+ centry => aentry
+ aentry => aentry % next
+ level = level + 1
+ end do FIND_SLOTS_ENTRY
+
+ bentry => aentry % next
+ aentry % next => map % free_list
+ map % free_list => aentry
+ centry % next => bentry
+ map % inverse(inmap) % target => null()
+ map % num_free = map % num_free + 1
+
+ end subroutine remove_chaining_entry
+
+
+ module subroutine set_other_chaining_data( map, key, other, exists )
+!! Version: Experimental
+!!
+!! Change the other data associated with the key
+!! Arguments:
+!! map - the map with the entry of interest
+!! key - the key to the entry inthe map
+!! other - the new data to be associated with the key
+!! exists - a logical flag indicating whether the key is already entered
+!! in the map
+!
+ class(chaining_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(in) :: other
+ logical, intent(out), optional :: exists
+
+ integer(int_index) :: inmap
+ character(*), parameter :: procedure = 'SET_OTHER_DATA'
+
+ call in_chain_map( map, inmap, key )
+ if ( inmap <= 0 .or. inmap > size( map % inverse, kind=int_index ) ) &
+ then
+ if ( present(exists) ) then
+ exists = .false.
+ return
+ else
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ invalid_inmap
+ end if
+ else if ( associated( map % inverse(inmap) % target ) ) then
+ associate( target => map % inverse(inmap) % target )
+ call copy_other( other, target % other )
+ if ( present(exists) ) exists = .true.
+ return
+ end associate
+ else
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ invalid_inmap
+ end if
+
+ end subroutine set_other_chaining_data
+
+
+ module function total_chaining_depth( map ) result(total_depth)
+!! Version: Experimental
+!!
+!! Returns the total number of ones based offsets of slot entries from
+!! their slot index for a hash map
+!! Arguments:
+!! map - an chaining hash map
+ class(chaining_hashmap_type), intent(in) :: map
+ integer(int_depth) :: total_depth
+
+ type(chaining_map_entry_type), pointer :: current_key
+ integer(int_index) :: slot, slots
+ integer(int_depth) :: index
+
+ total_depth = 0_int_depth
+ slots = size( map % slots, kind=int_index )
+ do slot=0, slots-1
+ current_key => map % slots(slot) % target
+ index = 0_int_depth
+ do while( associated(current_key) )
+ index = index + 1_int_depth
+ total_depth = total_depth + index
+ current_key => current_key % next
+ end do
+ end do
+
+ end function total_chaining_depth
+
+
+ module subroutine chaining_key_test(map, key, present)
+!! Version: Experimental
+!!
+!! Returns a logical flag indicating whether KEY is present in the hash map
+!! Arguments:
+!! map - the hash map of interest
+!! key - the key of interest
+!! present - a logical flag indicating whether key is present in map
+!
+ class(chaining_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ logical, intent(out) :: present
+
+ integer(int_index) :: inmap
+
+ call in_chain_map( map, inmap, key )
+ if ( inmap <= 0 .or. inmap > size( map % inverse, kind=int_index ) ) &
+ then
+ present = .false.
+ else
+ present = associated( map % inverse(inmap) % target )
+ end if
+
+ end subroutine chaining_key_test
+
+
+end submodule stdlib_hashmap_chaining
diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90
new file mode 100755
index 000000000..d27441548
--- /dev/null
+++ b/src/stdlib_hashmap_open.f90
@@ -0,0 +1,879 @@
+!! The module, STDLIB_HASHMAP_OPEN implements a simple open addressing hash
+!! map using linear addressing. The implementation is loosely based on a
+!! C implementation by David Chase, http://chasewoerner.org/src/hasht/, for
+!! which he has given permission to use in the Fortran Standard Library.
+
+! Note an error in the code caused attempts to deallocate already deallocated
+! entries. This did not cause stat to be non-zero, but did cause system errors,
+! on my Mac. I therefore decided to remove all deallocation error reporting.
+
+submodule(stdlib_hashmaps) stdlib_hashmap_open
+
+ use, intrinsic :: iso_fortran_env, only: &
+ character_storage_size, &
+ error_unit
+
+ use stdlib_hashmap_wrappers
+
+ implicit none
+
+! Error messages
+ character(len=*), parameter :: &
+ alloc_inv_fault = "OPEN_HASHMAP_TYPE % INVERSE allocation fault.", &
+ alloc_key_fault = "KEY allocation fault.", &
+ alloc_slots_fault = "OPEN_HASHMAP_TYPE % SLOTS allocation fault.", &
+ conflicting_key = "KEY already exists in MAP.", &
+ expand_slots_fail = "OPEN_HASHMAP_TYPE % SLOTS allocation > " // &
+ "MAX_BITS.", &
+ init_slots_pow_fail = "SLOTS_BITS is not between DEFAULT_BITS " // &
+ "and MAX_BITS.", &
+ invalid_inmap = "INMAP was not a valid INVERSE index.", &
+ map_consist_fault = "The hash map found an inconsistency."
+
+ character(*), parameter :: submodule_name = 'STDLIB_HASHMAP_OPEN'
+
+
+ interface expand_slots
+!! Version: Experimental
+!!
+!! Interface to internal procedure that expands an open map's slots.
+ module procedure expand_open_slots
+ end interface expand_slots
+
+ interface extend_map_entry_pool
+!! Version: Experimental
+!!
+!! Interface to internal procedure that expands an open map entry pool.
+ module procedure extend_open_map_entry_pool
+ end interface extend_map_entry_pool
+
+ interface free_map
+!! Version: Experimental
+!!
+!! Interface to procedure that finalizes an open hash map.
+ module procedure free_open_map
+ end interface free_map
+
+ interface free_map_entry_pool
+!! Version: Experimental
+!!
+!! Interface to internal procedure that finalizes an open hash map
+!! entry pool.
+ module procedure free_map_entry_pool
+ end interface free_map_entry_pool
+
+ interface get_other_data
+!! Version: Experimental
+!!
+!! Interface to procedure that gets an entry's other data.
+ module procedure get_other_open_data
+ end interface get_other_data
+
+ interface init
+!! Version: Experimental
+!!
+!! Interface to initialization procedure for an open hash map.
+ module procedure init_open_map
+ end interface init
+
+ interface rehash
+!! Version: Experimental
+!!
+!! Interface to a procedure that changes the hash function that
+!! is used to map the keys into an open hash map.
+ module procedure rehash_open_map
+ end interface rehash
+
+ interface remove
+!! Version: Experimental
+!!
+!! Interface to a procedure that removees an entry from an open hash map.
+ module procedure remove_open_entry
+ end interface remove
+
+ interface set_other_data
+!! Version: Experimental
+!!
+!! Interface to a procedure that changes the other data associated with a key
+ module procedure set_other_open_data
+ end interface set_other_data
+
+contains
+
+
+ subroutine expand_open_slots( map )
+!! Version: Experimental
+!!
+!! Internal routine to make a duplicate map with more hash slots.
+!! Doubles the size of the map % slots array
+!! Arguments:
+!! map - the hash table whose hash slots are to be expanded
+!
+ type(open_hashmap_type), intent(inout) :: map
+
+ integer(int_hash) :: base_slot
+ integer(int_index), allocatable :: dummy_slots(:)
+ integer(int_index) :: inv_index, &
+ new_size, &
+ offset, &
+ old_size, &
+ test_slot
+ integer(int32) :: bits, &
+ stat
+
+ character(256) :: errmsg
+ character(*), parameter :: procedure = 'EXPAND_SLOTS'
+
+ if ( map % nbits == max_bits ) then
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ expand_slots_fail
+ end if
+
+ old_size = size(map % slots, kind=int_index)
+
+ new_size = 2*old_size
+ bits = map % nbits + 1
+
+ allocate( dummy_slots(0:new_size-1), stat=stat, errmsg=errmsg )
+ if (stat /= 0) then
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ alloc_slots_fault
+ end if
+
+ map % nbits = bits
+
+ dummy_slots(:) = 0
+ map % index_mask = new_size-1
+
+ map % total_probes = map % total_probes + map % probe_count
+ map % probe_count = 0
+
+ REMAP_SLOTS: do inv_index=1_int_index, &
+ map % num_entries + map % num_free
+ associate( inverse => map % inverse(inv_index) )
+ if ( associated(inverse % target) ) then
+ base_slot = fibonacci_hash( inverse % target % hash_val, &
+ map % nbits )
+ offset = 0
+ FIND_EMPTY_SLOT: do
+ test_slot = iand( int( base_slot + offset, int_hash), &
+ map % index_mask )
+ if ( dummy_slots(test_slot) == 0 ) then
+ dummy_slots(test_slot) = inv_index
+ exit FIND_EMPTY_SLOT
+ end if
+ offset = offset + 1
+ end do FIND_EMPTY_SLOT
+ end if
+ end associate
+ end do REMAP_SLOTS
+
+ call move_alloc( dummy_slots, map % slots )
+
+ end subroutine expand_open_slots
+
+
+ subroutine extend_open_map_entry_pool(pool) ! gent_pool_new
+!! Version: Experimental
+!!
+!! Add more map_entrys to the pool head
+!! Arguments:
+!! pool - an open map entry pool
+ type(open_map_entry_pool), intent(inout), pointer :: pool
+
+ type(open_map_entry_pool), pointer :: map_entry_pool_head
+
+ allocate(map_entry_pool_head)
+ allocate(map_entry_pool_head % more_map_entries(0:pool_size-1))
+ map_entry_pool_head % lastpool => pool
+ pool => map_entry_pool_head
+ pool % next = 0
+
+ end subroutine extend_open_map_entry_pool
+
+
+ recursive subroutine free_map_entry_pool(pool) ! gent_pool_free
+!! Version: Experimental
+!! Note the freeing of allocated memory may be unnecessary
+!!
+!! Recursively descends map entry pool list freeing each element
+!! Arguments:
+!! pool The map entry pool whose elements are to be freed
+!
+ type(open_map_entry_pool), intent(inout), pointer :: pool
+
+ type(open_map_entry_pool), pointer :: lastpool
+
+ if ( associated(pool) ) then
+ lastpool => pool % lastpool
+ pool % lastpool => null()
+ deallocate( pool )
+! Trace component pointers/lists
+ call free_map_entry_pool( lastpool )
+ end if
+
+ end subroutine free_map_entry_pool
+
+
+ module subroutine free_open_map( map )
+!! Version: Experimental
+!!
+!! Frees internal memory of an open map
+!! Arguments:
+!! map - the open hash map whose memory is to be freed
+!
+ type(open_hashmap_type), intent(inout) :: map
+
+ type(open_map_entry_list), pointer :: free_list
+ integer(int_index) :: i
+
+ if ( allocated( map % slots ) ) then
+ deallocate( map % slots )
+ end if
+
+ if ( allocated( map % inverse ) ) then
+ remove_links: do i=1, size( map % inverse, kind=int_index )
+ map % inverse(i) % target => null()
+ end do remove_links
+ deallocate( map % inverse )
+ end if
+
+ free_free_list: do while( map % num_free > 0 )
+ free_list => map % free_list
+ map % free_list => map % free_list % next
+ free_list % next => null()
+ free_list % target => null()
+ map % num_free = map % num_free - 1
+ end do free_free_list
+ map % num_free = 0
+
+ if ( associated( map % cache ) ) call free_map_entry_pool(map % cache)
+
+ map % num_entries = 0
+
+ end subroutine free_open_map
+
+
+ module subroutine get_other_open_data( map, key, other, exists )
+!! Version: Experimental
+!!
+!! Returns the other data associated with the inverse table index
+!! Arguments:
+!! map - an open hash table
+!! key - the key associated with a map entry
+!! other - the other data associated with the key
+!! exists - a logical flag indicating whether an entry with that key exists
+!
+ class(open_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(out) :: other
+ logical, intent(out), optional :: exists
+
+ integer(int_index) :: inmap
+ character(*), parameter :: procedure = 'GET_OTHER_DATA'
+
+ call in_open_map(map, inmap, key)
+ if ( inmap <= 0 .or. &
+ inmap > map % num_entries + map % num_free ) then
+ if ( present(exists) ) then
+ exists = .false.
+ return
+ else
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ invalid_inmap
+ end if
+ else if ( associated( map % inverse(inmap) % target ) ) then
+ exists = .true.
+ call copy_other( map % inverse(inmap) % target % other, other )
+ else
+ if ( present(exists) ) then
+ exists = .false.
+ return
+ else
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ map_consist_fault
+ end if
+ end if
+
+ end subroutine get_other_open_data
+
+
+ subroutine in_open_map(map, inmap, key) ! Chase's inmap
+!! Version: Experimental
+!!
+!! Returns the index into the INVERSE array associated with the KEY
+!! Arguments:
+!! map - the hash map of interest
+!! inmap - the returned index into the INVERSE array of entry pointers
+!! key - the key identifying the entry of interest
+!
+ class(open_hashmap_type), intent(inout) :: map
+ integer(int_index), intent(out) :: inmap
+ type(key_type), intent(in) :: key
+
+ character(*), parameter :: procedure = 'IN_MAP'
+ integer(int_hash) :: &
+ base_slot, &
+ hash_val, &
+ test_slot
+ integer(int_index) :: &
+ offset
+
+ hash_val = map % hasher( key )
+
+ if ( map % probe_count > inmap_probe_factor * map % call_count .or. &
+ map % num_entries >= load_factor * &
+ size( map % slots, kind=int_index ) ) then
+ if ( map % nbits < max_bits ) &
+ call expand_slots(map)
+ end if
+
+ map % call_count = map % call_count + 1
+ base_slot = fibonacci_hash( hash_val, map % nbits )
+ offset = 0_int_index
+ PROBE_SLOTS: do
+ test_slot = iand( base_slot + offset, map % index_mask )
+ map % probe_count = map % probe_count + 1
+ inmap = map % slots( test_slot )
+ if ( inmap == 0 ) then
+ return
+ else if ( inmap < 0 .or. &
+ inmap > map % num_entries + map % num_free ) then
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ map_consist_fault
+ else if ( .not. associated( map % inverse(inmap) % target ) ) then
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ map_consist_fault
+ else
+ associate( inverse => map % inverse(inmap) )
+ if ( hash_val == inverse % target % hash_val ) then
+ if ( key == inverse % target % key ) then
+ return
+ end if
+ end if
+ end associate
+ end if
+ offset = offset + 1_int_index
+ end do PROBE_SLOTS
+
+ end subroutine in_open_map
+
+
+ module subroutine init_open_map( map, &
+ hasher, &
+ slots_bits, &
+ status )
+!! Version: Experimental
+!!
+!! Routine to allocate an empty map with HASHER as the hash function,
+!! 2**SLOTS_BITS initial SIZE(map % slots), and SIZE(map % slots) limited to a
+!! maximum of 2**MAX_BITS. All fields are initialized.
+!! Arguments:
+!! map - the open hash maap to be initialized
+!! hasher - the hash function to be used to map keys to slots
+!! slots_bits - the number of bits used to map to the slots
+!! status - an integer error status flag with the allowed values:
+!! success - no problems were found
+!! alloc_fault - map % slots or map % inverse could not be allocated
+!! array_size_error - slots_bits is less than default_bitd or
+!! greater than max_bits
+
+ class(open_hashmap_type), intent(out) :: map
+ procedure(hasher_fun) :: hasher
+ integer, intent(in), optional :: slots_bits
+ integer(int32), intent(out), optional :: status
+
+ character(256) :: errmsg
+ integer(int_index) :: i
+ character(*), parameter :: procedure = 'INIT'
+ integer(int_index) :: slots
+ integer(int32) :: stat
+ type(open_map_entry_pool), pointer :: map_entry_pool_head
+
+ map % call_count = 0
+ map % probe_count = 0
+ map % total_probes = 0
+
+ map % hasher => hasher
+
+ if ( present(slots_bits) ) then
+ if ( slots_bits < default_bits .OR. &
+ slots_bits > max_bits ) then
+ if ( present(status) ) then
+ status = array_size_error
+ return
+ else
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ init_slots_pow_fail
+ end if
+ end if
+ map % nbits = slots_bits
+ else
+ map % nbits = min( default_bits, max_bits )
+ end if
+
+ slots = 2_int32**map % nbits
+ map % index_mask = slots - 1
+
+ allocate( map % slots(0:slots-1), stat=stat, errmsg=errmsg )
+ if ( stat /= 0 ) then
+ if ( present(status) ) then
+ status = alloc_fault
+ return
+ else
+ write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg)
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ alloc_slots_fault
+ end if
+ end if
+
+ do i=0, size( map % slots, kind=int_index ) - 1
+ map % slots(i) = 0 ! May be redundant
+ end do
+
+!! 5*s from Chase's g_new_map
+ allocate( map % inverse(1:ceiling(load_factor*slots, &
+ kind=int_index)), &
+ stat=stat, &
+ errmsg=errmsg )
+ if ( stat /= 0 ) then
+ if ( present( status ) ) then
+ status = alloc_fault
+ return
+ else
+ write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg)
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ alloc_inv_fault
+ end if
+ end if
+
+ do i=1, size(map % inverse, kind=int_index)
+ map % inverse(i) % target => null()
+ end do
+
+ do while(associated(map % cache))
+ map_entry_pool_head => map % cache
+ map % cache => map_entry_pool_head % lastpool
+ map_entry_pool_head % lastpool => null()
+ deallocate( map_entry_pool_head % more_map_entries )
+ deallocate( map_entry_pool_head )
+ end do
+
+ call extend_map_entry_pool(map % cache)
+
+ if (present(status) ) status = success
+
+ end subroutine init_open_map
+
+
+ pure module function open_loading( map )
+!! Version: Experimental
+!!
+!! Returns the number of entries relative to slots in a hash map
+!! Arguments:
+!! map - an open hash map
+ class(open_hashmap_type), intent(in) :: map
+ real :: open_loading
+
+ open_loading = real( map % num_entries ) / &
+ size( map % slots, kind=int_index )
+
+ end function open_loading
+
+
+ module subroutine map_open_entry(map, key, other, conflict)
+!! Version: Experimental
+!!
+!! Inserts an entry into the hash table
+!! Arguments:
+!! map the hash table of interest
+!! key - the key identifying the entry
+!! other - other data associated with the key
+!! conflict - logical flag indicating whether the entry key conflicts
+!! with an existing key
+!
+ class(open_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(in), optional :: other
+ logical, intent(out), optional :: conflict
+
+ type(open_map_entry_type), pointer :: new_ent
+ integer(int_hash) :: base_slot
+ integer(int_hash) :: hash_val
+ integer(int_index) :: inmap, offset, test_slot
+ character(*), parameter :: procedure = 'MAP_ENTRY'
+
+ hash_val = map % hasher( key )
+
+ if ( map % probe_count > map_probe_factor * map % call_count .or. &
+ map % num_entries >= load_factor * size( map % slots, &
+ kind=int_index) ) then
+ call expand_slots(map)
+ end if
+ map % call_count = map % call_count + 1
+ base_slot = fibonacci_hash( hash_val, map % nbits )
+
+ offset = 0
+ PROBE_SUCCESSIVE_SLOTS: do
+ map % probe_count = map % probe_count + 1
+ test_slot = iand( base_slot + offset, map % index_mask )
+ inmap = map % slots(test_slot)
+ if ( inmap == 0 ) then
+ call allocate_open_map_entry(map, new_ent)
+ new_ent % hash_val = hash_val
+ call copy_key( key, new_ent % key )
+ if ( present( other ) ) &
+ call copy_other( other, new_ent % other )
+ inmap = new_ent % inmap
+ map % inverse( inmap ) % target => new_ent
+ map % slots( test_slot ) = inmap
+ if ( present(conflict) ) conflict = .false.
+ return
+ else if ( inmap < 0 .or. &
+ inmap > map % num_entries + map % num_free ) then
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ invalid_inmap
+ else if (.not. associated( map % inverse(inmap) % target ) ) then
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ invalid_inmap
+ else
+ associate( target => map % inverse(inmap) % target )
+ if ( hash_val == target % hash_val ) then
+ if ( key == target % key ) then
+ ! entry already exists
+ if ( present(conflict) ) then
+ conflict = .true.
+ else
+ error stop submodule_name // ' % ' // procedure &
+ // ': ' // conflicting_key
+ end if
+ return
+ end if
+ end if
+ end associate
+ end if
+ offset = offset + 1
+ end do PROBE_SUCCESSIVE_SLOTS
+
+ contains
+
+ subroutine allocate_open_map_entry(map, bucket)
+! allocates a hash bucket
+ type(open_hashmap_type), intent(inout) :: map
+ type(open_map_entry_type), pointer, intent(out) :: bucket
+ type(open_map_entry_list), pointer :: free_list
+ type(open_map_entry_pool), pointer :: pool
+ character(*), parameter :: procedure_name = "ALLOCATE_MAP_ENTRY"
+
+ pool => map % cache
+ map % num_entries = map % num_entries + 1
+ if ( associated(map % free_list) ) then
+! Get hash bucket from free_list
+ free_list => map % free_list
+ bucket => free_list % target
+ map % free_list => free_list % next
+ free_list % target => null()
+ free_list % next => null()
+ if (bucket % inmap <= 0) &
+ error stop submodule_name // " % " // procedure_name // &
+ ": Failed consistency check: BUCKET % INMAP <= 0"
+ map % num_free = map % num_free - 1
+ else
+! Get hash bucket from pool
+ if ( pool % next == pool_size ) then
+! Expand pool
+ call extend_map_entry_pool(map % cache)
+ pool => map % cache
+ end if
+ bucket => pool % more_map_entries(pool % next)
+ pool % next = pool % next + 1 ! 0s based -> post-increment
+ if ( map % num_entries > &
+ size( map % inverse, kind=int_index ) ) then
+ call expand_inverse( map )
+ end if
+ if ( map % num_entries <= 0 ) &
+ error stop submodule_name // " % " // procedure_name // &
+ ": Failed consistency check: MAP % NUM_ENTRIES <= 0."
+ bucket % inmap = map % num_entries
+ end if
+
+ end subroutine allocate_open_map_entry
+
+ subroutine expand_inverse(map)
+!! Increase size of map % inverse
+ type(open_hashmap_type), intent(inout) :: map
+ type(open_map_entry_ptr), allocatable :: dummy_inverse(:)
+
+ integer(int32) :: stat
+ character(256) :: errmsg
+
+ allocate( dummy_inverse(1:2*size(map % inverse, kind=int_index)), &
+ stat=stat, errmsg=errmsg )
+ if ( stat /= 0 ) then
+ write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg)
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ alloc_inv_fault
+ end if
+ dummy_inverse(1:size(map % inverse, kind=int_index)) = &
+ map % inverse(:)
+
+ call move_alloc( dummy_inverse, map % inverse )
+
+ end subroutine expand_inverse
+
+ end subroutine map_open_entry
+
+
+ module subroutine rehash_open_map( map, hasher )
+!! Version: Experimental
+!!
+!! Changes the hashing method of the table entries to that of HASHER.
+!! Arguments:
+!! map the table to be rehashed
+!! hasher the hasher function to be used for the table
+!
+ class(open_hashmap_type), intent(inout) :: map
+ procedure(hasher_fun) :: hasher
+
+ integer(int_hash) :: base_slot
+ integer(int_hash) :: hash_val
+ integer(int_index) :: i, test_slot, offset
+
+ map % hasher => hasher
+
+ map % slots = 0
+
+ do i=1, map % num_entries + map % num_free
+ if ( .not. associated( map % inverse(i) % target ) ) cycle
+ hash_val = map % hasher( map % inverse(i) % target % key )
+ map % inverse(i) % target % hash_val = hash_val
+ base_slot = fibonaccI_hash( hash_val, map % nbits )
+ offset = 0
+ FIND_EMPTY_SLOT: do
+ test_slot = iand( int( base_slot + offset, int_hash ), &
+ map % index_mask )
+ if ( map % slots(test_slot) == 0 ) then
+ map % slots(test_slot) = i
+ exit FIND_EMPTY_SLOT
+ end if
+ offset = offset + 1
+ end do FIND_EMPTY_SLOT
+ end do
+
+ end subroutine rehash_open_map
+
+
+ module subroutine remove_open_entry(map, key, existed)
+!! Remove the entry, if any, that has the key
+!! Arguments:
+!! map - the table from which the entry is to be removed
+!! key - the key to an entry
+!! existed - a logical flag indicating whether an entry with the key
+!! was present in the original map
+!
+ class(open_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ logical, intent(out), optional :: existed
+
+ type(open_map_entry_list), pointer :: aentry
+ type(open_map_entry_type), pointer :: bucket
+ integer(int_index) :: base_slot
+ integer(int_index) :: current_index
+ integer(int_index) :: current_slot
+ integer(int_index) :: empty_slot
+ integer(int_index) :: inmap
+ logical :: overlap
+ integer(int_index) :: slot_index
+
+ overlap = .false.
+ call in_open_map( map, inmap, key )
+ if ( inmap < 1 .or. inmap > size( map % inverse ) ) then
+ if ( present( existed ) ) existed = .false.
+ return
+ end if
+
+ bucket => map % inverse(inmap) % target
+ if ( associated(bucket) ) then
+ base_slot = fibonacci_hash( bucket % hash_val, map % nbits )
+ if ( present(existed) ) existed = .true.
+ else
+ if ( present( existed ) ) existed = .false.
+ return
+ end if
+
+! Find slot associated with inmap and nullify the pointer
+ current_slot = base_slot
+ search_for_inmap: do
+ slot_index = map % slots(current_slot)
+ if ( slot_index == inmap ) then
+ allocate(aentry)
+ aentry % target => map % inverse(inmap) % target
+ aentry % next => map % free_list
+ map % free_list => aentry
+ map % num_free = map % num_free + 1
+ map % slots( current_slot ) = 0
+ map % inverse(inmap) % target => null()
+ map % num_entries = map % num_entries - 1
+ empty_slot = current_slot
+ current_slot = iand( map % index_mask, current_slot + 1 )
+ if ( map % slots(current_slot) == 0 ) return
+ if ( current_slot == 0 ) overlap = .true.
+ exit search_for_inmap
+ else
+ if ( map % slots(current_slot) == 0 ) return
+ current_slot = iand( map % index_mask, current_slot + 1 )
+ if ( current_slot == 0 ) overlap = .true.
+ cycle search_for_inmap
+ end if
+ end do search_for_inmap
+
+! Have found slot and stored it in free_list, now may need to iteratively
+! swap to fill holes. First search backwards to find start of run.
+ find_run_start: do
+ base_slot = iand( map % index_mask, base_slot - 1 )
+ if ( base_slot == map % index_mask ) then
+ if ( map % slots(base_slot) == 0 ) then
+ base_slot = 0
+ exit find_run_start
+ else
+ overlap = .true.
+ cycle find_run_start
+ end if
+ else if ( map % slots(base_slot) == 0 ) then
+ base_slot = iand( map % index_mask, base_slot + 1 )
+ exit find_run_start
+ else
+ cycle find_run_start
+ end if
+ end do find_run_start
+
+! Search forward for entry to fill empty slot
+ fill_empty_slots: do
+ bucket => map % inverse(map % slots(current_slot) ) % target
+ current_index = fibonacci_hash( bucket % hash_val, &
+ map % nbits )
+ if ( overlap .and. empty_slot < base_slot ) then
+ if ( ( current_index >= base_slot .and. &
+ current_index <= map % index_mask ) .or. &
+ ( current_index >= 0 .and. &
+ current_index <= empty_slot ) ) then
+ map % slots( empty_slot ) = map % slots( current_slot )
+ map % slots( current_slot ) = 0
+ empty_slot = current_slot
+ end if
+ current_slot = iand( map % index_mask, current_slot + 1 )
+ else
+ if ( current_index >= base_slot .and. &
+ current_index <= empty_slot ) then
+ map % slots( empty_slot ) = map % slots( current_slot )
+ map % slots( current_slot ) = 0
+ empty_slot = current_slot
+ end if
+ current_slot = iand( map % index_mask, current_slot + 1 )
+ if ( current_slot == 0 ) overlap = .true.
+ end if
+ if ( map % slots( current_slot ) == 0 ) exit fill_empty_slots
+ end do fill_empty_slots
+
+ end subroutine remove_open_entry
+
+
+ module subroutine set_other_open_data( map, key, other, exists )
+!! Version: Experimental
+!!
+!! Change the other data associated with the key
+!! Arguments:
+!! map - the map with the entry of interest
+!! key - the key to the entry inthe map
+!! other - the new data to be associated with the key
+!! exists - a logical flag indicating whether the key is already entered
+!! in the map
+!
+ class(open_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(in) :: other
+ logical, intent(out),optional :: exists
+
+ integer(int_index) :: inmap
+
+ character(*), parameter :: procedure = 'SET_OTHER_DATA'
+
+ call in_open_map( map, inmap, key )
+ if ( inmap <= 0 .or. inmap > size( map % inverse, kind=int_index ) ) &
+ then
+ if ( present(exists) ) then
+ exists = .false.
+ return
+ else
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ invalid_inmap
+ end if
+ else if ( associated( map % inverse(inmap) % target ) ) then
+ associate( target => map % inverse(inmap) % target )
+ call copy_other( other, target % other )
+ if ( present(exists) ) exists = .true.
+ return
+ end associate
+ else
+ error stop submodule_name // ' % ' // procedure // ': ' // &
+ invalid_inmap
+ end if
+
+ end subroutine set_other_open_data
+
+
+ module function total_open_depth( map ) result(total_depth)
+!! Version: Experimental
+!!
+!! Returns the total number of ones based offsets of slot entries from
+!! their slot index for a hash map
+!! Arguments:
+!! map - an open hash map
+ class(open_hashmap_type), intent(in) :: map
+ integer(int64) :: total_depth
+
+ integer(int_index) :: inv_index, slot, slots
+ integer(int_hash) :: index
+
+ total_depth = 0_int64
+ slots = size( map % slots, kind=int_index )
+ do slot=0, slots-1
+ if ( map % slots( slot ) == 0 ) cycle
+ inv_index = map % slots( slot )
+ if ( inv_index <= 0 ) cycle
+ associate( inverse => map % inverse( inv_index ))
+ index = fibonacci_hash( inverse % target % hash_val, &
+ map % nbits )
+ end associate
+ total_depth = total_depth + &
+ iand( slot - index, map % index_mask ) + 1_int64
+ end do
+
+ end function total_open_depth
+
+
+ module subroutine open_key_test(map, key, present)
+!! Version: Experimental
+!!
+!! Returns a logical flag indicating whether KEY exists in the hash map
+!! Arguments:
+!! map - the hash map of interest
+!! key - the key of interest
+!
+ class(open_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ logical, intent(out) :: present
+
+ integer(int_index) :: inmap
+
+ call in_open_map( map, inmap, key )
+ if ( inmap <= 0 .or. inmap > size( map % inverse, kind=int_index ) ) &
+ then
+ present = .false.
+ else
+ present = associated( map % inverse(inmap) % target )
+ end if
+
+ end subroutine open_key_test
+
+end submodule stdlib_hashmap_open
diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90
new file mode 100755
index 000000000..67b13b96e
--- /dev/null
+++ b/src/stdlib_hashmap_wrappers.f90
@@ -0,0 +1,407 @@
+!! The module STDLIB_HASHMAP_WRAPPERS provides wrappers for various
+!! entities used by the hash map procedures. These include wrappers for the
+!! `key` and `other` data, and hashing procedures to operate on entities of
+!! the `key_type`.
+
+module stdlib_hashmap_wrappers
+
+ use, intrinsic :: iso_fortran_env, only : &
+ character_storage_size
+
+ use stdlib_hash_32bit
+
+ use stdlib_kinds, only : &
+ int8, &
+ int16, &
+ int32, &
+ int64, &
+ dp
+
+ implicit none
+
+ private
+
+!! Public procedures
+ public :: &
+ copy_key, &
+ copy_other, &
+ fibonacci_hash, &
+ fnv_1_hasher, &
+ fnv_1a_hasher, &
+ free_key, &
+ free_other, &
+ get, &
+ hasher_fun, &
+ operator(==), &
+ seeded_nmhash32_hasher, &
+ seeded_nmhash32x_hasher, &
+ seeded_water_hasher, &
+ set
+
+!! Public types
+ public :: &
+ key_type, &
+ other_type
+
+!! Public integers
+ public :: &
+ int_hash
+
+ integer, parameter :: &
+! Should be 8
+ bits_int8 = bit_size(0_int8)
+
+ integer, parameter :: &
+ bits_char = character_storage_size, &
+ bytes_char = bits_char/bits_int8
+
+ character(*), parameter :: module_name = "STDLIB_HASHMAP_WRAPPERS"
+
+ type :: key_type
+!! Version: Experimental
+!!
+!! A wrapper type for the key's true type
+! private
+ integer(int8), allocatable :: value(:)
+ end type key_type
+
+ abstract interface
+!! Version: Experimental
+!!
+!! Abstract interface to a 64 bit hash function operating on a KEY_TYPE
+ pure function hasher_fun( key ) result(hash_value)
+ import key_type, int_hash
+ type(key_type), intent(in) :: key
+ integer(int_hash) :: hash_value
+ end function hasher_fun
+ end interface
+
+ type :: other_type
+!! Version: Experimental
+!!
+!! A wrapper type for the other data's true type
+! private
+ class(*), allocatable :: value
+ end type other_type
+
+ interface get
+
+ module procedure get_char_key, &
+ get_int8_key
+
+ end interface get
+
+
+ interface operator(==)
+ module procedure equal_keys
+ end interface operator(==)
+
+ interface set
+
+ module procedure set_char_key, &
+ set_int8_key, &
+ set_other
+
+ end interface set
+
+contains
+
+
+ pure subroutine copy_key( old_key, new_key )
+!! Version: Experimental
+!!
+!! Copies the contents of the key, old_key, to the key, new_key
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#copy_key-returns-a-copy-of-the-key))
+!!
+!! Arguments:
+!! old_key - the input key
+!! new_key - the output copy of old_key
+ type(key_type), intent(in) :: old_key
+ type(key_type), intent(out) :: new_key
+
+ new_key % value = old_key % value
+
+ end subroutine copy_key
+
+
+ subroutine copy_other( other_in, other_out )
+!! Version: Experimental
+!!
+!! Copies the other data, other_in, to the variable, other_out
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#copy_other-returns-a-copy-of-the-other-data))
+!!
+!! Arguments:
+!! other_in - the input data
+!! other_out - the output data
+ type(other_type), intent(in) :: other_in
+ type(other_type), intent(out) :: other_out
+
+ allocate(other_out % value, source = other_in % value )
+
+ end subroutine copy_other
+
+
+ function equal_keys( key1, key2 ) result(test) ! Chase's tester
+!! Version: Experimental
+!!
+!! Compares two keys for equality
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#operator(==)-compares-two-keys-for-equality))
+!!
+!! Arguments:
+!! key1 - the first key
+!! key2 - the second key
+ logical :: test
+ type(key_type), intent(in) :: key1
+ type(key_type), intent(in) :: key2
+
+ if ( size(key1 % value, kind=int64) /= &
+ size(key2 % value, kind=int64) ) then
+ test = .false.
+ return
+ end if
+
+ if ( all( key1 % value == key2 % value ) ) then
+ test = .true.
+ else
+ test = .false.
+ end if
+
+ end function equal_keys
+
+
+ subroutine free_key( key )
+!! Version: Experimental
+!!
+!! Frees the memory in a key
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#free_key-frees-the-memory-associated-with-a-key))
+!!
+!! Arguments:
+!! key - the key
+ type(key_type), intent(inout) :: key
+
+ if ( allocated( key % value ) ) deallocate( key % value )
+
+ end subroutine free_key
+
+
+ subroutine free_other( other )
+!! Version: Experimental
+!!
+!! Frees the memory in the other data
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#free_other-frees-the-memory-associated-with-other-data))
+!!
+!! Arguments:
+!! other - the other data
+ type(other_type), intent(inout) :: other
+
+ if ( allocated( other % value) ) deallocate( other % value )
+
+ end subroutine free_other
+
+
+ subroutine get_char_key( key, value )
+!! Version: Experimental
+!!
+!! Gets the contents of the key as a CHARACTER string
+!! Arguments:
+!! key - the input key
+!! value - the contents of key mapped to a CHARACTER string
+ type(key_type), intent(in) :: key
+ character(:), allocatable, intent(out) :: value
+ character(*), parameter :: procedure = "GET"
+
+ integer(int64) :: key_as_char
+ integer(int64) :: key_size
+
+ key_size = size( key % value, kind=int64 )
+ select case( bytes_char )
+ case(1)
+ key_as_char = key_size
+ case(2)
+ if ( iand( key_size, 1_int64 ) > 0 ) then
+ error stop module_name // " % " // procedure // &
+ ": Internal Error at stdlib_hashmaps: " // &
+ "System uses 2 bytes per character, so " // &
+ "key_size can't be an odd number."
+ end if
+ key_as_char = ishft( key_size, -1 )
+ case(4)
+ if ( iand( key_size, 3_int64) > 0 ) then
+ error stop module_name // " % " // procedure // &
+ ": Internal Error at stdlib_hashmaps: " // &
+ "System uses 4 bytes per character, and " // &
+ "key_size is not a multiple of four."
+ end if
+ key_as_char = ishft( key_size, -2 )
+ case default
+ error stop module_name // " % " // procedure // &
+ ": Internal Error: " // &
+ "System doesn't use a power of two for its " // &
+ "character size as expected by stdlib_hashmaps."
+ end select
+
+ allocate( character( len=key_as_char ) :: value )
+
+ value(1:key_as_char) = transfer( key % value, value )
+
+ end subroutine get_char_key
+
+ subroutine get_other( other, value )
+!! Version: Experimental
+!!
+!! Gets the contents of the other as a CLASS(*) string
+!! Arguments:
+!! other - the input other data
+!! value - the contents of other mapped to a CLASS(*) variable
+ type(other_type), intent(in) :: other
+ class(*), allocatable, intent(out) :: value
+
+ allocate(value, source=other % value)
+
+ end subroutine get_other
+
+
+ subroutine get_int8_key( key, value )
+!! Version: Experimental
+!!
+!! Gets the contents of the key as an INTEGER(INT8) vector
+!! Arguments:
+!! key - the input key
+!! value - the contents of key mapped to an INTEGER(INT8) vector
+ type(key_type), intent(in) :: key
+ integer(int8), allocatable, intent(out) :: value(:)
+
+ value = key % value
+
+ end subroutine get_int8_key
+
+
+ subroutine set_char_key( key, value )
+!! Version: Experimental
+!!
+!! Sets the contents of the key from a CHARACTER string
+!! Arguments:
+!! key - the output key
+!! value - the input CHARACTER string
+ type(key_type), intent(out) :: key
+ character(*), intent(in) :: value
+
+ key % value = transfer( value, key % value, &
+ bytes_char * len( value ) )
+
+ end subroutine set_char_key
+
+
+ subroutine set_other( other, value )
+!! Version: Experimental
+!!
+!! Sets the contents of the other data from a CLASS(*) variable
+!! Arguments:
+!! other - the output other data
+!! value - the input CLASS(*) variable
+ type(other_type), intent(out) :: other
+ class(*), intent(in) :: value
+
+ allocate(other % value, source=value)
+
+ end subroutine set_other
+
+
+ subroutine set_int8_key( key, value )
+!! Version: Experimental
+!!
+!! Sets the contents of the key from an INTEGER(INT8) vector
+!! Arguments:
+!! key - the output key
+!! value - the input INTEGER(INT8) vector
+ type(key_type), intent(out) :: key
+ integer(int8), intent(in) :: value(:)
+
+ key % value = value
+
+ end subroutine set_int8_key
+
+
+ pure function fnv_1_hasher( key )
+!! Version: Experimental
+!!
+!! Hashes a key with the FNV_1 algorithm
+!! Arguments:
+!! key - the key to be hashed
+ type(key_type), intent(in) :: key
+ integer(int_hash) :: fnv_1_hasher
+
+ fnv_1_hasher = fnv_1_hash( key % value )
+
+ end function fnv_1_hasher
+
+
+ pure function fnv_1a_hasher( key )
+!! Version: Experimental
+!!
+!! Hashes a key with the FNV_1a algorithm
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#fnv_1a_hasher-calculates-a-hash-code-from-a-key))
+!!
+!! Arguments:
+!! key - the key to be hashed
+ type(key_type), intent(in) :: key
+ integer(int_hash) :: fnv_1a_hasher
+
+ fnv_1a_hasher = fnv_1a_hash( key % value )
+
+ end function fnv_1a_hasher
+
+
+ pure function seeded_nmhash32_hasher( key )
+!! Version: Experimental
+!!
+!! Hashes a key with the NMHASH32 hash algorithm
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#seeded_nmhash32_hasher-calculates-a-hash-code-from-a-key))
+!!
+!! Arguments:
+!! key - the key to be hashed
+!! seed - the seed (unused) for the hashing algorithm
+ type(key_type), intent(in) :: key
+ integer(int_hash) :: seeded_nmhash32_hasher
+
+ seeded_nmhash32_hasher = nmhash32( key % value, &
+ int( z'DEADBEEF', int32 ) )
+
+ end function seeded_nmhash32_hasher
+
+
+ pure function seeded_nmhash32x_hasher( key )
+!! Version: Experimental
+!!
+!! Hashes a key with the NMHASH32X hash algorithm
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#seeded_nmhash32x_hasher-calculates-a-hash-code-from-a-key))
+!! Arguments:
+!! key - the key to be hashed
+!! seed - the seed (unused) for the hashing algorithm
+ type(key_type), intent(in) :: key
+ integer(int_hash) :: seeded_nmhash32x_hasher
+
+ seeded_nmhash32x_hasher = nmhash32x( key % value, &
+ int( z'DEADBEEF', int32 ) )
+
+ end function seeded_nmhash32x_hasher
+
+
+ pure function seeded_water_hasher( key )
+!! Version: Experimental
+!!
+!! Hashes a key with the waterhash algorithm
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#seeded_water_hasher-calculates-a-hash-code-from-a-key))
+!!
+!! Arguments:
+!! key - the key to be hashed
+ type(key_type), intent(in) :: key
+ integer(int_hash) :: seeded_water_hasher
+
+ seeded_water_hasher = water_hash( key % value, &
+ int( z'DEADBEEF1EADBEEF', int64 ) )
+
+ end function seeded_water_hasher
+
+
+end module stdlib_hashmap_wrappers
diff --git a/src/stdlib_hashmaps.f90 b/src/stdlib_hashmaps.f90
new file mode 100644
index 000000000..f7f29c683
--- /dev/null
+++ b/src/stdlib_hashmaps.f90
@@ -0,0 +1,811 @@
+!! The module, STDLIB_HASH_MAPS, implements two hash maps:
+!! CHAINING_HASH_MAP_TYPE, a separate chaining hash map; and OPEN_HASH_MAP_TYPE,
+!! an open addressing hash map using linear addressing. The two hash maps are
+!! implementations of the abstract type, HASH_MAP_TYPE.
+
+module stdlib_hashmaps
+
+ use, intrinsic :: iso_fortran_env, only: &
+ character_storage_size, &
+ error_unit
+
+ use stdlib_kinds, only: &
+ dp, &
+ int8, &
+ int16, &
+ int32, &
+ int64
+
+ use stdlib_hashmap_wrappers
+
+ implicit none
+
+ private
+
+!! Public data_types
+ public :: &
+ chaining_hashmap_type, &
+ hashmap_type, &
+ open_hashmap_type
+
+!! Values that parameterize David Chase's empirical SLOT expansion code
+ integer, parameter :: &
+ inmap_probe_factor = 10, &
+ map_probe_factor = 5
+
+!! Values that parameterize the SLOTS table size
+ integer, parameter, public :: &
+ default_bits = 6, &
+ max_bits = 30
+
+!! KIND values used to parameterixe the hash map and its procedures
+ integer, parameter, public :: &
+ int_calls = int64, &
+ int_depth = int64, &
+ int_index = int32, &
+ int_probes = int64
+
+!! Error codes returned by the hash map procedures
+ integer, parameter, public :: &
+ success = 0, &
+ 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
+
+!! The size of the pools of allocated map entries
+ integer(int32), parameter :: pool_size = 64
+
+ character(*), parameter, private :: module_name = 'STDLIB_HASHMAPS'
+
+ type, abstract :: hashmap_type
+!! Version: Experimental
+!!
+!! Type implementing an abstract hash map
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-hashmap_type-abstract-type))
+ private
+ integer(int_calls) :: call_count = 0
+!! Number of calls
+ integer(int_calls) :: probe_count = 0
+!! Number of probes since last expansion
+ integer(int_calls) :: total_probes = 0
+!! Cumulative number of probes
+ integer(int_index) :: num_entries = 0
+!! Number of entries
+ integer(int_index) :: num_free = 0
+!! Number of elements in the free_list
+ integer(int32) :: nbits = default_bits
+!! Number of bits used to address the slots
+ procedure(hasher_fun), pointer, nopass :: hasher => fnv_1_hasher
+!! 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_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
+
+ end type hashmap_type
+
+
+ abstract interface
+
+ subroutine get_other( map, key, other, exists )
+!! Version: Experimental
+!!
+!! Returns the other data associated with the inverse table index
+!! Arguments:
+!! map - a hash map
+!! key - the key associated with a map entry
+!! other - the other data associated with the key
+!! exists - a logical flag indicating whether an entry with that key exists
+!
+ import hashmap_type, key_type, other_type
+ class(hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(out) :: other
+ logical, intent(out), optional :: exists
+ end subroutine get_other
+
+ subroutine init_map( map, &
+ hasher, &
+ slots_bits, &
+ status )
+!! Version: Experimental
+!!
+!! Routine to allocate an empty map with HASHER as the hash function,
+!! 2**SLOTS_BITS initial SIZE(map % slots), SIZE(map % slots) limited to a
+!! maximum of 2**MAX_BITS, and with up to LOAD_FACTOR * SIZE(map % slots),
+!! map % inverse elements. All fields are initialized.
+!! Arguments:
+!! map - the hash maap to be initialized
+!! hasher - the hash function to be used to map keys to slots
+!! slots_bits - the number of bits initially used to map to the slots
+!! status - an integer error status flag with the allowed values:
+!! success - no problems were found
+!! alloc_fault - map % slots or map % inverse could not be allocated
+!! array_size_error - slots_bits or max_bits is less than
+!! default_bits or greater than strict_max_bits
+!! real_value_error - load_factor is less than 0.375 or greater than
+!! 0.875
+!
+ import hashmap_type, hasher_fun, int32
+ class(hashmap_type), intent(out) :: map
+ procedure(hasher_fun) :: hasher
+ integer, intent(in), optional :: slots_bits
+ integer(int32), intent(out), optional :: status
+ end subroutine init_map
+
+ subroutine key_test(map, key, 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
+!! key - the key of interest
+!! present - a flag indicating whether key is present in the map
+!
+ import hashmap_type, key_type
+ class(hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ logical, intent(out) :: present
+ end subroutine key_test
+
+ pure function loading( map )
+!! Version: Experimental
+!!
+!! Returns the number of entries relative to slots in a hash map
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#loading-returns-the-ratio-of-entries-to-slots))
+!!
+!! Arguments:
+!! map - a hash map
+ import hashmap_type
+ class(hashmap_type), intent(in) :: map
+ real :: loading
+ end function loading
+
+ subroutine map_entry(map, key, 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))
+!!
+ import hashmap_type, key_type, other_type
+ class(hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(in), optional :: other
+ logical, intent(out), optional :: conflict
+ end subroutine map_entry
+
+ subroutine rehash_map( map, hasher )
+!! Version: Experimental
+!!
+!! Changes the hashing method of the table entries to that of HASHER.
+!! Arguments:
+!! map the table to be rehashed
+!! hasher the hasher function to be used for the table
+!
+ import hashmap_type, hasher_fun
+ class(hashmap_type), intent(inout) :: map
+ procedure(hasher_fun) :: hasher
+ end subroutine rehash_map
+
+ subroutine remove_entry(map, key, 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
+!
+ import hashmap_type, key_type
+ class(hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ logical, intent(out), optional :: existed
+ end subroutine remove_entry
+
+ subroutine set_other( map, key, other, exists )
+!! Version: Experimental
+!!
+!! Change the other data associated with the key
+!! Arguments:
+!! map - the map with the entry of interest
+!! key - the key to the entry inthe map
+!! other - the new data to be associated with the key
+!! exists - a logical flag indicating whether the key is already entered
+!! in the map
+!!
+!
+ import hashmap_type, key_type, other_type
+ class(hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(in) :: other
+ logical, intent(out), optional :: exists
+ end subroutine set_other
+
+ function total_depth( map )
+!! Version: Experimental
+!!
+!! Returns the total number of ones based offsets of slot entriesyy from
+!! their slot index for a hash map
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#total_depth-returns-the-total-depth-of-the-hash-map-entries))
+!! Arguments:
+!! map - a hash map
+ import hashmap_type, int64
+ class(hashmap_type), intent(in) :: map
+ integer(int64) :: total_depth
+ end function total_depth
+
+ end interface
+
+!! API for the chaining_hashmap_type
+
+ type :: chaining_map_entry_type ! Hash entry
+!! Version: Experimental
+!!
+!! Chaining hash map entry type
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-chaining_map_entry_type-derived-type))
+ private
+ integer(int_hash) :: hash_val
+!! Full hash value
+ type(key_type) :: key
+!! The entry's key
+ type(other_type) :: other
+!! Other entry data
+ integer(int_index) :: inmap
+!! Index into inverse table
+ type(chaining_map_entry_type), pointer :: next => null()
+!! Next bucket
+ end type chaining_map_entry_type
+
+
+ type chaining_map_entry_ptr
+!! Version: Experimental
+!!
+!! Wrapper for a pointer to a chaining map entry type object
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-chaining_map_entry_type_ptr-derived-type))
+ type(chaining_map_entry_type), pointer :: target => null()
+ end type chaining_map_entry_ptr
+
+
+ type :: chaining_map_entry_pool
+!! Version: Experimental
+!!
+!! Type implementing a pool of allocated `chaining_map_entry_type`
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-chaining_map_entry_pool-derived-type))
+ private
+! Index of next bucket
+ integer(int_index) :: next = 0
+ type(chaining_map_entry_type), allocatable :: more_map_entries(:)
+ type(chaining_map_entry_pool), pointer :: lastpool => null()
+ end type chaining_map_entry_pool
+
+
+ type, extends(hashmap_type) :: chaining_hashmap_type
+!! Version: Experimental
+!!
+!! Type implementing the `chaining_hashmap_type` types
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-chaining_hashmap_type-derived-type))
+ private
+ type(chaining_map_entry_pool), pointer :: cache => null()
+!! Pool of allocated chaining_map_entry_type objects
+ type(chaining_map_entry_type), pointer :: free_list => null()
+!! free list of map entries
+ type(chaining_map_entry_ptr), allocatable :: inverse(:)
+!! Array of bucket lists (inverses) Note max_elts=size(inverse)
+ type(chaining_map_entry_ptr), allocatable :: slots(:)
+!! Array of bucket lists Note # slots=size(slots)
+ contains
+ procedure :: get_other_data => get_other_chaining_data
+ procedure :: init => init_chaining_map
+ procedure :: loading => chaining_loading
+ procedure :: map_entry => map_chain_entry
+ procedure :: rehash => rehash_chaining_map
+ procedure :: remove => remove_chaining_entry
+ procedure :: set_other_data => set_other_chaining_data
+ procedure :: total_depth => total_chaining_depth
+ procedure :: key_test => chaining_key_test
+ final :: free_chaining_map
+ end type chaining_hashmap_type
+
+
+ interface
+
+ module subroutine free_chaining_map( map )
+!! Version: Experimental
+!!
+!! Frees internal memory of an chaining map
+!! Arguments:
+!! map - the chaining hash map whose memory is to be freed
+!
+ type(chaining_hashmap_type), intent(inout) :: map
+ end subroutine free_chaining_map
+
+
+ module subroutine get_other_chaining_data( map, key, other, exists )
+!! Version: Experimental
+!!
+!! Returns the other data associated with the inverse table index
+!! Arguments:
+!! map - a chaining hash table
+!! key - the key associated with a map entry
+!! other - the other data associated with the key
+!! exists - a logical flag indicating whether an entry with that key exists
+!
+ class(chaining_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(out) :: other
+ logical, intent(out), optional :: exists
+ end subroutine get_other_chaining_data
+
+
+ module subroutine init_chaining_map( map, &
+ hasher, &
+ slots_bits, &
+ status )
+!! Version: Experimental
+!!
+!! Routine to allocate an empty map with HASHER as the hash function,
+!! 2**SLOTS_BITS initial SIZE(map % slots), and SIZE(map % slots) limited
+!! to a maximum of 2**MAX_BITS. All fields are initialized.
+!! Arguments:
+!! map - the chaining hash map to be initialized
+!! hasher - the hash function to be used to map keys to slots
+!! slots_bits - the bits of two used to initialize the number of slots
+!! status - an integer error status flag with the allowed values:
+!! success - no problems were found
+!! alloc_fault - map % slots or map % inverse could not be allocated
+!! array_size_error - slots_bits is less than default_bits or
+!! greater than max_bits
+!
+ class(chaining_hashmap_type), intent(out) :: map
+ procedure(hasher_fun) :: hasher
+ integer, intent(in), optional :: slots_bits
+ integer(int32), intent(out), optional :: status
+ end subroutine init_chaining_map
+
+
+ module subroutine chaining_key_test(map, key, present)
+!! Version: Experimental
+!!
+!! Returns a logical flag indicating whether KEY is present in the hash map
+!! Arguments:
+!! map - the hash map of interest
+!! key - the key of interest
+!! present - a logical flag indicating whether key is present in map
+!
+ class(chaining_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ logical, intent(out) :: present
+ end subroutine chaining_key_test
+
+
+ pure module function chaining_loading( map )
+!! Version: Experimental
+!!
+!! Returns the number of entries relative to slots in a hash map
+!! Arguments:
+!! map - a chaining hash map
+ class(chaining_hashmap_type), intent(in) :: map
+ real :: chaining_loading
+ end function chaining_loading
+
+
+ module subroutine map_chain_entry(map, key, other, conflict)
+!
+! Inserts an entry innto the hash map
+! Arguments:
+!! map - the hash table of interest
+!! key - the key identifying the entry
+!! other - other data associated with the key
+!! conflict - logical flag indicating whether the entry key conflicts
+!! with an existing key
+!
+ class(chaining_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(in), optional :: other
+ logical, intent(out), optional :: conflict
+ end subroutine map_chain_entry
+
+
+ module subroutine rehash_chaining_map( map, hasher )
+!! Version: Experimental
+!!
+!! Changes the hashing method of the table entries to that of HASHER.
+!! Arguments:
+!! map the table to be rehashed
+!! hasher the hasher function to be used for the table
+!
+ class(chaining_hashmap_type), intent(inout) :: map
+ procedure(hasher_fun) :: hasher
+ end subroutine rehash_chaining_map
+
+
+ module subroutine remove_chaining_entry(map, key, existed)
+!! 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(chaining_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ logical, intent(out), optional :: existed
+ end subroutine remove_chaining_entry
+
+
+ module subroutine set_other_chaining_data( map, key, other, exists )
+!! Version: Experimental
+!!
+!! Change the other data associated with the key
+!! Arguments:
+!! map - the map with the entry of interest
+!! key - the key to the entry inthe map
+!! other - the new data to be associated with the key
+!! exists - a logical flag indicating whether the key is already entered
+!! in the map
+!
+ class(chaining_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(in) :: other
+ logical, intent(out), optional :: exists
+ end subroutine set_other_chaining_data
+
+
+ module function total_chaining_depth( map ) result(total_depth)
+!! Version: Experimental
+!!
+!! Returns the total number of ones based offsets of slot entries from
+!! their slot index for a hash map
+!! Arguments:
+!! map - an chaining hash map
+ class(chaining_hashmap_type), intent(in) :: map
+ integer(int_depth) :: total_depth
+ end function total_chaining_depth
+
+ end interface
+
+!! API for the open_hashmap_type
+
+ type :: open_map_entry_type
+!! Version: Experimental
+!!
+!! Open hash map entry type
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-open_map_entry_type-derived-type))
+ private
+ integer(int_hash) :: hash_val
+!! Full hash value
+ type(key_type) :: key
+!! Hash entry key
+ type(other_type) :: other
+!! Other entry data
+ integer(int_index) :: inmap
+!! Index into inverse table
+ end type open_map_entry_type
+
+ type :: open_map_entry_list
+!! Version: Experimental
+!!
+!! Open hash map entry type
+ private
+ type(open_map_entry_type), pointer :: target => null()
+ type(open_map_entry_list), pointer :: next => null()
+ end type open_map_entry_list
+
+
+ type open_map_entry_ptr
+!! Version: Experimental
+!!
+!! Wrapper for a pointer to an open hash map entry type object
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-open_map_entry_ptr-derived-type))
+ type(open_map_entry_type), pointer :: target => null()
+ end type open_map_entry_ptr
+
+
+ type :: open_map_entry_pool
+!! Version: Experimental
+!!
+!! Type implementing a pool of allocated `open_map_entry_type`
+ private
+ integer(int_index) :: next = 0
+!! Index of next bucket
+ type(open_map_entry_type), allocatable :: more_map_entries(:)
+ type(open_map_entry_pool), pointer :: lastpool => null()
+ end type open_map_entry_pool
+
+
+ type, extends(hashmap_type) :: open_hashmap_type
+!! Version: Experimental
+!!
+!! Type implementing an "open" hash map
+ private
+ integer(int_index) :: index_mask = 2_int_index**default_bits-1
+!! Mask used in linear addressing
+ type(open_map_entry_pool), pointer :: cache => null()
+!! Pool of allocated open_map_entry_type objects
+ type(open_map_entry_list), pointer :: free_list => null()
+!! free list of map entries
+ type(open_map_entry_ptr), allocatable :: inverse(:)
+!! Array of bucket lists (inverses) Note max_elts=size(inverse)
+ integer(int_index), allocatable :: slots(:)
+!! Array of indices to the inverse Note # slots=size(slots)
+ contains
+ procedure :: get_other_data => get_other_open_data
+ procedure :: init => init_open_map
+ procedure :: loading => open_loading
+ procedure :: map_entry => map_open_entry
+ procedure :: rehash => rehash_open_map
+ procedure :: remove => remove_open_entry
+ procedure :: set_other_data => set_other_open_data
+ procedure :: total_depth => total_open_depth
+ procedure :: key_test => open_key_test
+ final :: free_open_map
+ end type open_hashmap_type
+
+ interface
+
+ module subroutine free_open_map( map )
+!! Version: Experimental
+!!
+!! Frees internal memory of an open map
+!! Arguments:
+!! map - the open hash map whose memory is to be freed
+!
+ type(open_hashmap_type), intent(inout) :: map
+ end subroutine free_open_map
+
+
+ module subroutine get_other_open_data( map, key, other, exists )
+!! Version: Experimental
+!!
+!! Returns the other data associated with the inverse table index
+!! Arguments:
+!! map - an open hash table
+!! key - the key associated with a map entry
+!! other - the other data associated with the key
+!! exists - a logical flag indicating whether an entry with that key exists
+!
+ class(open_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(out) :: other
+ logical, intent(out), optional :: exists
+ end subroutine get_other_open_data
+
+
+ module subroutine init_open_map( map, &
+ hasher, &
+ slots_bits, &
+ status )
+!! Version: Experimental
+!!
+!! Routine to allocate an empty map with HASHER as the hash function,
+!! 2**SLOTS_BITS initial SIZE(map % slots), and SIZE(map % slots) limited to a
+!! maximum of 2**MAX_BITS. All fields are initialized.
+!! Arguments:
+!! map - the open hash maap to be initialized
+!! hasher - the hash function to be used to map keys to slots
+!! slots_bits - the number of bits used to map to the slots
+!! status - an integer error status flag with the allowed values:
+!! success - no problems were found
+!! alloc_fault - map % slots or map % inverse could not be allocated
+!! array_size_error - slots_bits is less than default_bitd or
+!! greater than max_bits
+
+ class(open_hashmap_type), intent(out) :: map
+ procedure(hasher_fun) :: hasher
+ integer, intent(in), optional :: slots_bits
+ integer(int32), intent(out), optional :: status
+ end subroutine init_open_map
+
+
+ module subroutine open_key_test(map, key, present)
+!! Version: Experimental
+!!
+!! Returns a logical flag indicating whether KEY exists in the hash map
+!! Arguments:
+!! map - the hash map of interest
+!! key - the key of interest
+!! present - a logical flag indicating whether KEY exists in the hash map
+!
+ class(open_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ logical, intent(out) :: present
+ end subroutine open_key_test
+
+
+ pure module function open_loading( map )
+!! Version: Experimental
+!!
+!! Returns the number of entries relative to slots in a hash map
+!! Arguments:
+!! map - an open hash map
+ class(open_hashmap_type), intent(in) :: map
+ real :: open_loading
+ end function open_loading
+
+
+ module subroutine map_open_entry(map, key, other, conflict)
+!! Version: Experimental
+!!
+!! Inserts an entry into the hash table
+!! Arguments:
+!! map - the hash table of interest
+!! key - the key identifying the entry
+!! other - other data associated with the key
+!! conflict - logical flag indicating whether the entry key conflicts
+!! with an existing key
+!
+ class(open_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(in), optional :: other
+ logical, intent(out), optional :: conflict
+ end subroutine map_open_entry
+
+
+ module subroutine rehash_open_map( map, hasher )
+!! Version: Experimental
+!!
+!! Changes the hashing method of the table entries to that of HASHER.
+!! Arguments:
+!! map the table to be rehashed
+!! hasher the hasher function to be used for the table
+!
+ class(open_hashmap_type), intent(inout) :: map
+ procedure(hasher_fun) :: hasher
+ end subroutine rehash_open_map
+
+
+ module subroutine remove_open_entry(map, key, existed)
+!! Remove the entry, if any, that has the key
+!! Arguments:
+!! map - the table from which the entry is to be removed
+!! key - the key to an entry
+!! existed - a logical flag indicating whether an entry with the key
+!! was present in the original map
+!
+ class(open_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ logical, intent(out), optional :: existed
+ end subroutine remove_open_entry
+
+
+ module subroutine set_other_open_data( map, key, other, exists )
+!! Version: Experimental
+!!
+!! Change the other data associated with the key
+!! Arguments:
+!! map - the map with the entry of interest
+!! key - the key to the entry inthe map
+!! other - the new data to be associated with the key
+!! exists - a logical flag indicating whether the key is already entered
+!! in the map
+!
+ class(open_hashmap_type), intent(inout) :: map
+ type(key_type), intent(in) :: key
+ type(other_type), intent(in) :: other
+ logical, intent(out), optional :: exists
+ end subroutine set_other_open_data
+
+
+ module function total_open_depth( map ) result(total_depth)
+!! Version: Experimental
+!!
+!! Returns the total number of ones based offsets of slot entries from
+!! their slot index for a hash map
+!! Arguments:
+!! map - an open hash map
+ class(open_hashmap_type), intent(in) :: map
+ integer(int64) :: total_depth
+ end function total_open_depth
+
+ end interface
+
+contains
+
+ pure function calls( map )
+!! Version: Experimental
+!!
+!! Returns the number of subroutine calls on an open hash map
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#calls-returns-the-number-of-calls-on-the-hash-map))
+!!
+!! Arguments:
+!! map - an open hash map
+ class(hashmap_type), intent(in) :: map
+ integer(int_calls) :: calls
+
+ calls = map % call_count
+
+ end function calls
+
+ pure function entries( map )
+!! Version: Experimental
+!!
+!! Returns the number of entries in a hash map
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#entries-returns-the-number-of-entries-in-the-hash-map))
+!!
+!! Arguments:
+!! map - an open hash map
+ class(hashmap_type), intent(in) :: map
+ integer(int_index) :: entries
+
+ entries = map % num_entries
+
+ end function entries
+
+
+ pure function map_probes( map )
+!! Version: Experimental
+!!
+!! Returns the total number of table probes on a hash map
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#map_probes-returns-the-number-of-hash-map-probes))
+!!
+!! Arguments:
+!! map - an open hash map
+ class(hashmap_type), intent(in) :: map
+ integer(int_calls) :: map_probes
+
+ map_probes = map % total_probes + map % probe_count
+
+ end function map_probes
+
+
+ pure function num_slots( map )
+!! Version: Experimental
+!!
+!! Returns the number of allocated slots in a hash map
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#num_slots-returns-the-number-of-hash-map-slots))
+!!
+!! Arguments:
+!! map - an open hash map
+ class(hashmap_type), intent(in) :: map
+ integer(int_index) :: num_slots
+
+ num_slots = 2**map % nbits
+
+ end function num_slots
+
+
+ pure function slots_bits( map )
+!! Version: Experimental
+!!
+!! Returns the number of bits used to specify the number of allocated
+!! slots in a hash map
+!! ([Specifications](../page/specs/stdlib_hashmaps.html#slots_bits-returns-the-number-of-bits-used-to-address-the-hash-map-slots))
+!!
+!! Arguments:
+!! map - an open hash map
+ class(hashmap_type), intent(in) :: map
+ integer :: slots_bits
+
+ slots_bits = map % nbits
+
+ end function slots_bits
+
+
+end module stdlib_hashmaps
diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt
index a4250d7ba..de332abb3 100644
--- a/src/tests/CMakeLists.txt
+++ b/src/tests/CMakeLists.txt
@@ -20,6 +20,7 @@ add_subdirectory(ascii)
add_subdirectory(bitsets)
add_subdirectory(hash_functions)
add_subdirectory(hash_functions_perf)
+add_subdirectory(hashmaps)
add_subdirectory(io)
add_subdirectory(linalg)
add_subdirectory(logger)
diff --git a/src/tests/hashmaps/CMakeLists.txt b/src/tests/hashmaps/CMakeLists.txt
new file mode 100755
index 000000000..7831dde7d
--- /dev/null
+++ b/src/tests/hashmaps/CMakeLists.txt
@@ -0,0 +1,13 @@
+### Pre-process: .fpp -> .f90 via Fypp
+
+# Create a list of the files to be preprocessed
+set(fppFiles
+ test_maps.fypp
+)
+
+fypp_f90("${fyppFlags}" "${fppFiles}" outFiles)
+
+ADDTEST(chaining_maps)
+ADDTEST(open_maps)
+ADDTEST(maps)
+
diff --git a/src/tests/hashmaps/Makefile.manual b/src/tests/hashmaps/Makefile.manual
new file mode 100755
index 000000000..254423a77
--- /dev/null
+++ b/src/tests/hashmaps/Makefile.manual
@@ -0,0 +1,5 @@
+PROGS_SRC = test_chaining_maps.f90 \
+ test_open_maps.f90
+
+
+include ../Makefile.manual.test.mk
diff --git a/src/tests/hashmaps/test_chaining_maps.f90 b/src/tests/hashmaps/test_chaining_maps.f90
new file mode 100755
index 000000000..d63346e3d
--- /dev/null
+++ b/src/tests/hashmaps/test_chaining_maps.f90
@@ -0,0 +1,294 @@
+program test_chaining_maps
+!! Test various aspects of the runtime system.
+!! Running this program may require increasing the stack size to above 48 MBytes
+!! or decreasing rand_power to 20 or less
+
+ use stdlib_kinds, only: &
+ dp, &
+ int8, &
+ int32
+
+ use stdlib_hashmaps, only : chaining_hashmap_type, int_depth, int_index
+ use stdlib_hashmap_wrappers
+
+ implicit none
+
+ type dummy_type
+ integer(int8), allocatable :: value(:)
+ end type dummy_type
+
+ integer(int32), parameter :: huge32 = huge(0_int32)
+ real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp
+ integer, parameter :: rand_power = 18
+ integer, parameter :: rand_size = 2**rand_power
+ integer, parameter :: test_size = rand_size*4
+ integer, parameter :: test_16 = 2**4
+ integer, parameter :: test_256 = 2**8
+
+ integer :: index
+ integer :: lun
+ type(chaining_hashmap_type) :: map
+ real(dp) :: rand2(2)
+ integer(int32) :: rand_object(rand_size)
+ integer(int8) :: test_8_bits(test_size)
+
+ open( newunit=lun, file="test_chaining_maps.txt", access="sequential", &
+ action="write", form="formatted", position="rewind" )
+ write(lun, '("| ", a17, " | ", a12, " | ", a15, " | ", a10, " |")') &
+ 'Algorithm', 'Process', 'Data Set', 'Time (s)'
+
+ do index=1, rand_size
+ call random_number(rand2)
+ if (rand2(1) < 0.5_dp) then
+ rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1
+ else
+ rand_object(index) = floor(rand2(2)*hugep1, int32)
+ end if
+ end do
+
+ test_8_bits(:) = transfer( rand_object, 0_int8, test_size )
+
+ call map % init( fnv_1_hasher, slots_bits=10 )
+ call input_random_data( map, test_16, 'FNV-1', "16 byte words" )
+ call test_inquire_data( map, test_16, 'FNV-1', "16 byte words" )
+ call test_get_data( map, test_16, 'FNV-1', '16 byte words' )
+ call report_rehash_times( map, fnv_1_hasher, 'FNV-1', '16 byte words' )
+ call report_hash_statistics( map, 'FNV-1', '16 byte words' )
+ call report_removal_times( map, test_16, 'FNV-1', '16 byte words' )
+
+ call map % init( fnv_1_hasher, slots_bits=10 )
+ call input_random_data( map, test_256, 'FNV-1', "256 byte words" )
+ call test_inquire_data( map, test_256, 'FNV-1', "256 byte words" )
+ call test_get_data( map, test_256, 'FNV-1', '256 byte words' )
+ call report_rehash_times( map, fnv_1_hasher, 'FNV-1', '256 byte words' )
+ call report_hash_statistics( map, 'FNV-1', '256 byte words' )
+ call report_removal_times( map, test_256, 'FNV-1', '256 byte words' )
+
+ call map % init( fnv_1a_hasher, slots_bits=10 )
+ call input_random_data( map, test_16, 'FNV-1A', "16 byte words" )
+ call test_inquire_data( map, test_16, 'FNV-1A', "16 byte words" )
+ call test_get_data( map, test_16, 'FNV-1A', '16 byte words' )
+ call report_rehash_times( map, fnv_1a_hasher, 'FNV-1', '16 byte words' )
+ call report_hash_statistics( map, 'FNV-1A', '16 byte words' )
+ call report_removal_times( map, test_16, 'FNV-1a', '16 byte words' )
+
+ call map % init( fnv_1a_hasher, slots_bits=10 )
+ call input_random_data( map, test_256, 'FNV-1A', "256 byte words" )
+ call test_inquire_data( map, test_256, 'FNV-1A', "256 byte words" )
+ call test_get_data( map, test_256, 'FNV-1A', '256 byte words' )
+ call report_rehash_times( map, fnv_1_hasher, 'FNV-1A', '256 byte words' )
+ call report_hash_statistics( map, 'FNV-1A', '256 byte words' )
+ call report_removal_times( map, test_256, 'FNV-1A', '256 byte words' )
+
+ call map % init( seeded_nmhash32_hasher, slots_bits=10 )
+ call input_random_data( map, test_16, 'Seeded_Nmhash32', "16 byte words" )
+ call test_inquire_data( map, test_16, 'Seeded_Nmhash32', "16 byte words" )
+ call test_get_data( map, test_16, 'Seeded_Nmhash32', '16 byte words' )
+ call report_rehash_times( map, seeded_nmhash32_hasher, 'Seeded_Nmhash32', &
+ '16 byte words' )
+ call report_hash_statistics( map, 'Seeded_Nmhash32', '16 byte words' )
+ call report_removal_times( map, test_16, 'Seeded_Nmhash32', &
+ '16 byte words' )
+
+ call map % init( seeded_nmhash32_hasher, slots_bits=10 )
+ call input_random_data( map, test_256, 'Seeded_Nmhash32', "256 byte words" )
+ call test_inquire_data( map, test_256, 'Seeded_Nmhash32', "256 byte words" )
+ call test_get_data( map, test_256, 'Seeded_Nmhash32', '256 byte words' )
+ call report_rehash_times( map, seeded_nmhash32_hasher, 'Seeded_Nmhash32', &
+ '256 byte words' )
+ call report_hash_statistics( map, 'Seeded_Nmhash32', '256 byte words' )
+ call report_removal_times( map, test_256, 'Seeded_Nmhash32', &
+ '256 byte words' )
+
+ call map % init( seeded_nmhash32x_hasher, slots_bits=10 )
+ call input_random_data( map, test_16, 'Seeded_Nmhash32x', "16 byte words" )
+ call test_inquire_data( map, test_16, 'Seeded_Nmhash32x', "16 byte words" )
+ call test_get_data( map, test_16, 'Seeded_Nmhash32x', '16 byte words' )
+ call report_rehash_times( map, seeded_nmhash32x_hasher, &
+ 'Seeded_Nmhash32x', '16 byte words' )
+ call report_hash_statistics( map, 'Seeded_Nmhash32x', '16 byte words' )
+ call report_removal_times( map, test_16, 'Seeded_Nmhash32x', &
+ '16 byte words' )
+
+ call map % init( seeded_nmhash32x_hasher, slots_bits=10 )
+ call input_random_data( map, test_256, 'Seeded_Nmhash32x', &
+ "256 byte words" )
+ call test_inquire_data( map, test_256, 'Seeded_Nmhash32x', &
+ "256 byte words" )
+ call test_get_data( map, test_256, 'Seeded_Nmhash32x', '256 byte words' )
+ call report_rehash_times( map, seeded_nmhash32x_hasher, &
+ 'Seeded_Nmhash32x', '256 byte words' )
+ call report_hash_statistics( map, 'Seeded_Nmhash32x', '256 byte words' )
+ call report_removal_times( map, test_256, 'Seeded_Nmhash32x', &
+ '256 byte words' )
+
+ call map % init( seeded_water_hasher, slots_bits=10 )
+ call input_random_data( map, test_16, 'Seeded_Water', "16 byte words" )
+ call test_inquire_data( map, test_16, 'Seeded_Water', "16 byte words" )
+ call test_get_data( map, test_16, 'Seeded_Water', '16 byte words' )
+ call report_rehash_times( map, seeded_water_hasher, &
+ 'Seeded_Water', '16 byte words' )
+ call report_hash_statistics( map, 'Seeded_Water', '16 byte words' )
+ call report_removal_times( map, test_16, 'Seeded_Water', &
+ '16 byte words' )
+
+ call map % init( seeded_water_hasher, slots_bits=10 )
+ call input_random_data( map, test_256, 'Seeded_Water', &
+ "256 byte words" )
+ call test_inquire_data( map, test_256, 'Seeded_Water', &
+ "256 byte words" )
+ call test_get_data( map, test_256, 'Seeded_Water', '256 byte words' )
+ call report_rehash_times( map, seeded_water_hasher, &
+ 'Seeded_Water', '256 byte words' )
+ call report_hash_statistics( map, 'Seeded_Water', '256 byte words' )
+ call report_removal_times( map, test_256, 'Seeded_Water', &
+ '256 byte words' )
+
+contains
+
+ subroutine input_random_data( map, test_block, hash_name, size_name )
+ type(chaining_hashmap_type), intent(inout) :: map
+ integer(int_index), intent(in) :: test_block
+ character(*), intent(in) :: hash_name
+ character(*), intent(in) :: size_name
+ class(*), allocatable :: dummy
+ type(dummy_type) :: dummy_val
+ integer :: index2
+ type(key_type) :: key
+ type(other_type) :: other
+ real :: t1, t2, tdiff
+ logical :: conflict
+
+ call cpu_time(t1)
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ if (allocated(dummy)) deallocate(dummy)
+ dummy_val % value = test_8_bits( index2:index2+test_block-1 )
+ allocate( dummy, source=dummy_val )
+ call set ( other, dummy )
+ call map % map_entry( key, other, conflict )
+ if (conflict) &
+ error stop "Unable to map entry because of a key conflict."
+ end do
+ call cpu_time(t2)
+ tdiff = t2-t1
+ write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
+ trim(hash_name), 'Enter data', size_name, tdiff
+
+ end subroutine input_random_data
+
+
+ subroutine test_inquire_data( map, test_block, hash_name, size_name )
+ type(chaining_hashmap_type), intent(inout) :: map
+ integer(int_index), intent(in) :: test_block
+ character(*), intent(in) :: hash_name, size_name
+ integer :: index2
+ logical :: present
+ type(key_type) :: key
+ real :: t1, t2, tdiff
+
+ call cpu_time(t1)
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ call map % key_test( key, present )
+ if (.not. present) &
+ error stop "KEY not found in map KEY_TEST."
+ end do
+ call cpu_time(t2)
+ tdiff = t2-t1
+ write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
+ trim(hash_name), 'Inquire data', size_name, tdiff
+
+ end subroutine test_inquire_data
+
+
+ subroutine test_get_data( map, test_block, hash_name, size_name )
+ type(chaining_hashmap_type), intent(inout) :: map
+ integer(int_index), intent(in) :: test_block
+ character(*), intent(in) :: hash_name, size_name
+ integer :: index2
+ type(key_type) :: key
+ type(other_type) :: other
+ logical :: exists
+ real :: t1, t2, tdiff
+
+ call cpu_time(t1)
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ call map % get_other_data( key, other, exists )
+ if (.not. exists) &
+ error stop "Unable to get data because key not found in map."
+ end do
+ call cpu_time(t2)
+ tdiff = t2-t1
+ write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
+ trim(hash_name), 'Get data', size_name, tdiff
+
+ end subroutine test_get_data
+
+
+ subroutine report_rehash_times( map, hasher, hash_name, size_name )
+ type(chaining_hashmap_type), intent(inout) :: map
+ procedure(hasher_fun) :: hasher
+ character(*), intent(in) :: hash_name, size_name
+ real :: t1, t2, tdiff
+
+ call cpu_time(t1)
+ call map % rehash( hasher )
+ call cpu_time(t2)
+ tdiff = t2-t1
+
+ write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
+ trim(hash_name), 'Rehash data', size_name, tdiff
+
+ end subroutine report_rehash_times
+
+
+ subroutine report_removal_times( map, test_block, hash_name, size_name )
+ type(chaining_hashmap_type), intent(inout) :: map
+ integer(int_index), intent(in) :: test_block
+ character(*), intent(in) :: hash_name, size_name
+ real :: t1, t2, tdiff
+ type(key_type) :: key
+ integer(int_index) :: index2
+ logical :: existed
+
+ call cpu_time(t1)
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ call map % remove(key, existed)
+ if ( .not. existed ) &
+ error stop "Key not found in entry removal."
+ end do
+ call cpu_time(t2)
+ tdiff = t2-t1
+
+ write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
+ trim(hash_name), 'Remove data', size_name, tdiff
+ flush(lun)
+
+ end subroutine report_removal_times
+
+
+ subroutine report_hash_statistics( map, hash_name, size_name )
+ type(chaining_hashmap_type), intent(inout) :: map
+ character(*), intent(in) :: hash_name, size_name
+ integer(int_depth) :: depth
+
+ write(lun, *)
+ write(lun, '("Statistics for chaining hash table with ",' // &
+ 'A, " hasher on ", A, ".")' ) hash_name, size_name
+ write(lun, '("Slots = ", I0)' ) map % num_slots()
+ write(lun, '("Calls = ", I0)' ) map % calls()
+ write(lun, '("Entries = ", I0)' ) map % entries()
+ write(lun, '("Total probes = ", I0)' ) map % map_probes()
+ write(lun, '("Loading = ", ES10.3)' ) map % loading()
+ depth = map % total_depth()
+ write(lun, '("Total depth = ", I0)' ) depth
+ write(lun, '("Relative depth = ", ES10.3)') &
+ real( depth ) / real( map % entries() )
+
+ end subroutine report_hash_statistics
+
+
+end program test_chaining_maps
diff --git a/src/tests/hashmaps/test_maps.fypp b/src/tests/hashmaps/test_maps.fypp
new file mode 100644
index 000000000..cd1e3a4ee
--- /dev/null
+++ b/src/tests/hashmaps/test_maps.fypp
@@ -0,0 +1,378 @@
+#:set HASH_NAME = ["fnv_1_hasher", "fnv_1a_hasher", "seeded_nmhash32_hasher", "seeded_nmhash32x_hasher", "seeded_water_hasher"]
+#:set SIZE_NAME = ["16", "256"]
+module test_stdlib_chaining_maps
+!! Test various aspects of the runtime system.
+!! Running this program may require increasing the stack size to above 48 MBytes
+!! or decreasing rand_power to 20 or less
+ use testdrive, only : new_unittest, unittest_type, error_type, check
+ use :: stdlib_kinds, only : dp, int8, int32
+ use stdlib_hashmaps, only : chaining_hashmap_type, int_depth, int_index
+ use stdlib_hashmap_wrappers
+
+ implicit none
+ private
+
+ type dummy_type
+ integer(int8), allocatable :: value(:)
+ end type dummy_type
+
+ integer(int32), parameter :: huge32 = huge(0_int32)
+ real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp
+ integer, parameter :: rand_power = 18
+ integer, parameter :: rand_size = 2**rand_power
+ integer, parameter :: test_size = rand_size*4
+ integer, parameter :: test_16 = 2**4
+ integer, parameter :: test_256 = 2**8
+
+ public :: collect_stdlib_chaining_maps
+
+contains
+
+ !> Collect all exported unit tests
+ subroutine collect_stdlib_chaining_maps(testsuite)
+ !> Collection of tests
+ type(unittest_type), allocatable, intent(out) :: testsuite(:)
+
+ testsuite = [ &
+ new_unittest("chaining-maps-fnv_1_hasher-16-byte-words", test_fnv_1_hasher_16_byte_words) &
+ #:for hash_ in HASH_NAME
+ #:for size_ in SIZE_NAME
+ , new_unittest("chaining-maps-${hash_}$-${size_}$-byte-words", test_${hash_}$_${size_}$_byte_words) &
+ #:endfor
+ #:endfor
+ ]
+
+ end subroutine collect_stdlib_chaining_maps
+
+ #:for hash_ in HASH_NAME
+ #:for size_ in SIZE_NAME
+ subroutine test_${hash_}$_${size_}$_byte_words(error)
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+
+ type(chaining_hashmap_type) :: map
+ integer(int8) :: test_8_bits(test_size)
+
+ call generate_vector(test_8_bits)
+
+ call map % init( ${hash_}$, slots_bits=10 )
+
+ call test_input_random_data(error, map, test_8_bits, test_${size_}$)
+ if (allocated(error)) return
+
+ call test_inquire_data(error, map, test_8_bits, test_${size_}$)
+ if (allocated(error)) return
+
+ call test_get_data(error, map, test_8_bits, test_${size_}$)
+ if (allocated(error)) return
+
+ call test_removal(error, map, test_8_bits, test_${size_}$)
+ if (allocated(error)) return
+
+ end subroutine
+ #:endfor
+ #:endfor
+
+
+ subroutine generate_vector(test_8_bits)
+ integer(int8), intent(out) :: test_8_bits(test_size)
+
+ integer :: index
+ real(dp) :: rand2(2)
+ integer(int32) :: rand_object(rand_size)
+
+ do index=1, rand_size
+ call random_number(rand2)
+ if (rand2(1) < 0.5_dp) then
+ rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1
+ else
+ rand_object(index) = floor(rand2(2)*hugep1, int32)
+ end if
+ end do
+
+ test_8_bits(:) = transfer( rand_object, 0_int8, test_size )
+
+ end subroutine
+
+ subroutine test_input_random_data(error, map, test_8_bits, test_block)
+ type(error_type), allocatable, intent(out) :: error
+ type(chaining_hashmap_type), intent(inout) :: map
+ integer(int8), intent(in) :: test_8_bits(test_size)
+ integer(int_index), intent(in) :: test_block
+ class(*), allocatable :: dummy
+ type(dummy_type) :: dummy_val
+ integer :: index2
+ type(key_type) :: key
+ type(other_type) :: other
+ logical :: conflict
+
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ if (allocated(dummy)) deallocate(dummy)
+ dummy_val % value = test_8_bits( index2:index2+test_block-1 )
+ allocate( dummy, source=dummy_val )
+ call set ( other, dummy )
+ call map % map_entry( key, other, conflict )
+ call check(error, .not.conflict, "Unable to map entry because of a key conflict.")
+ if (allocated(error)) return
+ end do
+
+ end subroutine
+
+ subroutine test_inquire_data(error, map, test_8_bits, test_block)
+ type(error_type), allocatable, intent(out) :: error
+ type(chaining_hashmap_type), intent(inout) :: map
+ integer(int8), intent(in) :: test_8_bits(test_size)
+ integer(int_index), intent(in) :: test_block
+ integer :: index2
+ logical :: present
+ type(key_type) :: key
+
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ call map % key_test( key, present )
+ call check(error, present, "KEY not found in map KEY_TEST.")
+ if (allocated(error)) return
+ end do
+
+ end subroutine
+
+ subroutine test_get_data(error, map, test_8_bits, test_block)
+ type(error_type), allocatable, intent(out) :: error
+ type(chaining_hashmap_type), intent(inout) :: map
+ integer(int8), intent(in) :: test_8_bits(test_size)
+ integer(int_index), intent(in) :: test_block
+ integer :: index2
+ type(key_type) :: key
+ type(other_type) :: other
+ logical :: exists
+
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ call map % get_other_data( key, other, exists )
+ call check(error, exists, "Unable to get data because key not found in map.")
+ end do
+
+ end subroutine
+
+ subroutine test_removal(error, map, test_8_bits, test_block)
+ type(error_type), allocatable, intent(out) :: error
+ type(chaining_hashmap_type), intent(inout) :: map
+ integer(int8), intent(in) :: test_8_bits(test_size)
+ integer(int_index), intent(in) :: test_block
+ type(key_type) :: key
+ integer(int_index) :: index2
+ logical :: existed
+
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ call map % remove(key, existed)
+ call check(error, existed, "Key not found in entry removal.")
+ end do
+
+ end subroutine
+
+end module
+
+module test_stdlib_open_maps
+!! Test various aspects of the runtime system.
+!! Running this program may require increasing the stack size to above 48 MBytes
+!! or decreasing rand_power to 20 or less
+ use testdrive, only : new_unittest, unittest_type, error_type, check
+ use :: stdlib_kinds, only : dp, int8, int32
+ use stdlib_hashmaps, only : open_hashmap_type, int_depth, int_index
+ use stdlib_hashmap_wrappers
+
+ implicit none
+ private
+
+ type dummy_type
+ integer(int8), allocatable :: value(:)
+ end type dummy_type
+
+ integer(int32), parameter :: huge32 = huge(0_int32)
+ real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp
+ integer, parameter :: rand_power = 18
+ integer, parameter :: rand_size = 2**rand_power
+ integer, parameter :: test_size = rand_size*4
+ integer, parameter :: test_16 = 2**4
+ integer, parameter :: test_256 = 2**8
+
+ public :: collect_stdlib_open_maps
+
+contains
+
+ !> Collect all exported unit tests
+ subroutine collect_stdlib_open_maps(testsuite)
+ !> Collection of tests
+ type(unittest_type), allocatable, intent(out) :: testsuite(:)
+
+ testsuite = [ &
+ new_unittest("open-maps-fnv_1_hasher-16-byte-words", test_fnv_1_hasher_16_byte_words) &
+ #:for hash_ in HASH_NAME
+ #:for size_ in SIZE_NAME
+ , new_unittest("open-maps-${hash_}$-${size_}$-byte-words", test_${hash_}$_${size_}$_byte_words) &
+ #:endfor
+ #:endfor
+ ]
+
+ end subroutine collect_stdlib_open_maps
+
+ #:for hash_ in HASH_NAME
+ #:for size_ in SIZE_NAME
+ subroutine test_${hash_}$_${size_}$_byte_words(error)
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+
+ type(open_hashmap_type) :: map
+ integer(int8) :: test_8_bits(test_size)
+
+ call generate_vector(test_8_bits)
+
+ call map % init( ${hash_}$, slots_bits=10 )
+
+ call test_input_random_data(error, map, test_8_bits, test_${size_}$)
+ if (allocated(error)) return
+
+ call test_inquire_data(error, map, test_8_bits, test_${size_}$)
+ if (allocated(error)) return
+
+ call test_get_data(error, map, test_8_bits, test_${size_}$)
+ if (allocated(error)) return
+
+ call test_removal(error, map, test_8_bits, test_${size_}$)
+ if (allocated(error)) return
+
+ end subroutine
+ #:endfor
+ #:endfor
+
+
+ subroutine generate_vector(test_8_bits)
+ integer(int8), intent(out) :: test_8_bits(test_size)
+
+ integer :: index
+ real(dp) :: rand2(2)
+ integer(int32) :: rand_object(rand_size)
+
+ do index=1, rand_size
+ call random_number(rand2)
+ if (rand2(1) < 0.5_dp) then
+ rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1
+ else
+ rand_object(index) = floor(rand2(2)*hugep1, int32)
+ end if
+ end do
+
+ test_8_bits(:) = transfer( rand_object, 0_int8, test_size )
+
+ end subroutine
+
+ subroutine test_input_random_data(error, map, test_8_bits, test_block)
+ type(error_type), allocatable, intent(out) :: error
+ type(open_hashmap_type), intent(inout) :: map
+ integer(int8), intent(in) :: test_8_bits(test_size)
+ integer(int_index), intent(in) :: test_block
+ class(*), allocatable :: dummy
+ type(dummy_type) :: dummy_val
+ integer :: index2
+ type(key_type) :: key
+ type(other_type) :: other
+ logical :: conflict
+
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ if (allocated(dummy)) deallocate(dummy)
+ dummy_val % value = test_8_bits( index2:index2+test_block-1 )
+ allocate( dummy, source=dummy_val )
+ call set ( other, dummy )
+ call map % map_entry( key, other, conflict )
+ call check(error, .not.conflict, "Unable to map entry because of a key conflict.")
+ if (allocated(error)) return
+ end do
+
+ end subroutine
+
+ subroutine test_inquire_data(error, map, test_8_bits, test_block)
+ type(error_type), allocatable, intent(out) :: error
+ type(open_hashmap_type), intent(inout) :: map
+ integer(int8), intent(in) :: test_8_bits(test_size)
+ integer(int_index), intent(in) :: test_block
+ integer :: index2
+ logical :: present
+ type(key_type) :: key
+
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ call map % key_test( key, present )
+ call check(error, present, "KEY not found in map KEY_TEST.")
+ if (allocated(error)) return
+ end do
+
+ end subroutine
+
+ subroutine test_get_data(error, map, test_8_bits, test_block)
+ type(error_type), allocatable, intent(out) :: error
+ type(open_hashmap_type), intent(inout) :: map
+ integer(int8), intent(in) :: test_8_bits(test_size)
+ integer(int_index), intent(in) :: test_block
+ integer :: index2
+ type(key_type) :: key
+ type(other_type) :: other
+ logical :: exists
+
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ call map % get_other_data( key, other, exists )
+ call check(error, exists, "Unable to get data because key not found in map.")
+ end do
+
+ end subroutine
+
+ subroutine test_removal(error, map, test_8_bits, test_block)
+ type(error_type), allocatable, intent(out) :: error
+ type(open_hashmap_type), intent(inout) :: map
+ integer(int8), intent(in) :: test_8_bits(test_size)
+ integer(int_index), intent(in) :: test_block
+ type(key_type) :: key
+ integer(int_index) :: index2
+ logical :: existed
+
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ call map % remove(key, existed)
+ call check(error, existed, "Key not found in entry removal.")
+ end do
+
+ end subroutine
+
+end module
+
+
+program tester
+ use, intrinsic :: iso_fortran_env, only : error_unit
+ use testdrive, only : run_testsuite, new_testsuite, testsuite_type
+ use test_stdlib_open_maps, only : collect_stdlib_open_maps
+ use test_stdlib_chaining_maps, only : collect_stdlib_chaining_maps
+ implicit none
+ integer :: stat, is
+ type(testsuite_type), allocatable :: testsuites(:)
+ character(len=*), parameter :: fmt = '("#", *(1x, a))'
+
+ stat = 0
+
+ testsuites = [ &
+ new_testsuite("stdlib-open-maps", collect_stdlib_open_maps) &
+ , new_testsuite("stdlib-chaining-maps", collect_stdlib_chaining_maps) &
+ ]
+
+ do is = 1, size(testsuites)
+ write(error_unit, fmt) "Testing:", testsuites(is)%name
+ call run_testsuite(testsuites(is)%collect, error_unit, stat)
+ end do
+
+ if (stat > 0) then
+ write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
+ error stop
+ end if
+end program
diff --git a/src/tests/hashmaps/test_open_maps.f90 b/src/tests/hashmaps/test_open_maps.f90
new file mode 100755
index 000000000..d569d238c
--- /dev/null
+++ b/src/tests/hashmaps/test_open_maps.f90
@@ -0,0 +1,295 @@
+program test_open_maps
+!! Test various aspects of the runtime system.
+!! Running this program may require increasing the stack size to above 48 MBytes
+!! or decreasing rand_power to 20 or less
+
+ use stdlib_kinds, only: &
+ dp, &
+ int8, &
+ int32
+
+ use stdlib_hashmaps, only : open_hashmap_type, int_depth, int_index
+ use stdlib_hashmap_wrappers
+
+ implicit none
+
+ type dummy_type
+ integer(int8), allocatable :: value(:)
+ end type dummy_type
+
+ integer(int32), parameter :: huge32 = huge(0_int32)
+ real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp
+ integer, parameter :: rand_power = 18
+ integer, parameter :: rand_size = 2**rand_power
+ integer, parameter :: test_size = rand_size*4
+ integer, parameter :: test_16 = 2**4
+ integer, parameter :: test_256 = 2**8
+
+ integer :: index
+ integer :: lun
+ type(open_hashmap_type) :: map
+ real(dp) :: rand2(2)
+ integer(int32) :: rand_object(rand_size)
+ integer(int8) :: test_8_bits(test_size)
+
+
+ open( newunit=lun, file="test_open_maps.txt", access="sequential", &
+ action="write", form="formatted", position="rewind" )
+ write(lun, '("| ", a17, " | ", a12, " | ", a15, " | ", a10, " |")') &
+ 'Algorithm', 'Process', 'Data Set', 'Time (s)'
+
+ do index=1, rand_size
+ call random_number(rand2)
+ if (rand2(1) < 0.5_dp) then
+ rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1
+ else
+ rand_object(index) = floor(rand2(2)*hugep1, int32)
+ end if
+ end do
+
+ test_8_bits(:) = transfer( rand_object, 0_int8, test_size )
+
+ call map % init( fnv_1_hasher, slots_bits=10 )
+ call input_random_data( map, test_16, 'FNV-1', "16 byte words" )
+ call test_inquire_data( map, test_16, 'FNV-1', "16 byte words" )
+ call test_get_data( map, test_16, 'FNV-1', '16 byte words' )
+ call report_rehash_times( map, fnv_1_hasher, 'FNV-1', '16 byte words' )
+ call report_hash_statistics( map, 'FNV-1', '16 byte words' )
+ call report_removal_times( map, test_16, 'FNV-1', '16 byte words' )
+
+ call map % init( fnv_1_hasher, slots_bits=10 )
+ call input_random_data( map, test_256, 'FNV-1', "256 byte words" )
+ call test_inquire_data( map, test_256, 'FNV-1', "256 byte words" )
+ call test_get_data( map, test_256, 'FNV-1', '256 byte words' )
+ call report_rehash_times( map, fnv_1_hasher, 'FNV-1', '256 byte words' )
+ call report_hash_statistics( map, 'FNV-1', '256 byte words' )
+ call report_removal_times( map, test_256, 'FNV-1', '256 byte words' )
+
+ call map % init( fnv_1a_hasher, slots_bits=10 )
+ call input_random_data( map, test_16, 'FNV-1A', "16 byte words" )
+ call test_inquire_data( map, test_16, 'FNV-1A', "16 byte words" )
+ call test_get_data( map, test_16, 'FNV-1A', '16 byte words' )
+ call report_rehash_times( map, fnv_1a_hasher, 'FNV-1', '16 byte words' )
+ call report_hash_statistics( map, 'FNV-1A', '16 byte words' )
+ call report_removal_times( map, test_16, 'FNV-1a', '16 byte words' )
+
+ call map % init( fnv_1a_hasher, slots_bits=10 )
+ call input_random_data( map, test_256, 'FNV-1A', "256 byte words" )
+ call test_inquire_data( map, test_256, 'FNV-1A', "256 byte words" )
+ call test_get_data( map, test_256, 'FNV-1A', '256 byte words' )
+ call report_rehash_times( map, fnv_1_hasher, 'FNV-1A', '256 byte words' )
+ call report_hash_statistics( map, 'FNV-1A', '256 byte words' )
+ call report_removal_times( map, test_256, 'FNV-1A', '256 byte words' )
+
+ call map % init( seeded_nmhash32_hasher, slots_bits=10 )
+ call input_random_data( map, test_16, 'Seeded_Nmhash32', "16 byte words" )
+ call test_inquire_data( map, test_16, 'Seeded_Nmhash32', "16 byte words" )
+ call test_get_data( map, test_16, 'Seeded_Nmhash32', '16 byte words' )
+ call report_rehash_times( map, seeded_nmhash32_hasher, 'Seeded_Nmhash32', &
+ '16 byte words' )
+ call report_hash_statistics( map, 'Seeded_Nmhash32', '16 byte words' )
+ call report_removal_times( map, test_16, 'Seeded_Nmhash32', &
+ '16 byte words' )
+
+ call map % init( seeded_nmhash32_hasher, slots_bits=10 )
+ call input_random_data( map, test_256, 'Seeded_Nmhash32', "256 byte words" )
+ call test_inquire_data( map, test_256, 'Seeded_Nmhash32', "256 byte words" )
+ call test_get_data( map, test_256, 'Seeded_Nmhash32', '256 byte words' )
+ call report_rehash_times( map, seeded_nmhash32_hasher, 'Seeded_Nmhash32', &
+ '256 byte words' )
+ call report_hash_statistics( map, 'Seeded_Nmhash32', '256 byte words' )
+ call report_removal_times( map, test_256, 'Seeded_Nmhash32', &
+ '256 byte words' )
+
+ call map % init( seeded_nmhash32x_hasher, slots_bits=10 )
+ call input_random_data( map, test_16, 'Seeded_Nmhash32x', "16 byte words" )
+ call test_inquire_data( map, test_16, 'Seeded_Nmhash32x', "16 byte words" )
+ call test_get_data( map, test_16, 'Seeded_Nmhash32x', '16 byte words' )
+ call report_rehash_times( map, seeded_nmhash32x_hasher, &
+ 'Seeded_Nmhash32x', '16 byte words' )
+ call report_hash_statistics( map, 'Seeded_Nmhash32x', '16 byte words' )
+ call report_removal_times( map, test_16, 'Seeded_Nmhash32x', &
+ '16 byte words' )
+
+ call map % init( seeded_nmhash32x_hasher, slots_bits=10 )
+ call input_random_data( map, test_256, 'Seeded_Nmhash32x', &
+ "256 byte words" )
+ call test_inquire_data( map, test_256, 'Seeded_Nmhash32x', &
+ "256 byte words" )
+ call test_get_data( map, test_256, 'Seeded_Nmhash32x', '256 byte words' )
+ call report_rehash_times( map, seeded_nmhash32x_hasher, &
+ 'Seeded_Nmhash32x', '256 byte words' )
+ call report_hash_statistics( map, 'Seeded_Nmhash32x', '256 byte words' )
+ call report_removal_times( map, test_256, 'Seeded_Nmhash32x', &
+ '256 byte words' )
+
+ call map % init( seeded_water_hasher, slots_bits=10 )
+ call input_random_data( map, test_16, 'Seeded_Water', "16 byte words" )
+ call test_inquire_data( map, test_16, 'Seeded_Water', "16 byte words" )
+ call test_get_data( map, test_16, 'Seeded_Water', '16 byte words' )
+ call report_rehash_times( map, seeded_water_hasher, &
+ 'Seeded_Water', '16 byte words' )
+ call report_hash_statistics( map, 'Seeded_Water', '16 byte words' )
+ call report_removal_times( map, test_16, 'Seeded_Water', &
+ '16 byte words' )
+
+ call map % init( seeded_water_hasher, slots_bits=10 )
+ call input_random_data( map, test_256, 'Seeded_Water', &
+ "256 byte words" )
+ call test_inquire_data( map, test_256, 'Seeded_Water', &
+ "256 byte words" )
+ call test_get_data( map, test_256, 'Seeded_Water', '256 byte words' )
+ call report_rehash_times( map, seeded_water_hasher, &
+ 'Seeded_Water', '256 byte words' )
+ call report_hash_statistics( map, 'Seeded_Water', '256 byte words' )
+ call report_removal_times( map, test_256, 'Seeded_Water', &
+ '256 byte words' )
+
+contains
+
+ subroutine input_random_data( map, test_block, hash_name, size_name )
+ type(open_hashmap_type), intent(inout) :: map
+ integer(int_index), intent(in) :: test_block
+ character(*), intent(in) :: hash_name
+ character(*), intent(in) :: size_name
+ class(*), allocatable :: dummy
+ type(dummy_type) :: dummy_val
+ integer :: index2
+ type(key_type) :: key
+ type(other_type) :: other
+ real :: t1, t2, tdiff
+ logical :: conflict
+
+ call cpu_time(t1)
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ if (allocated(dummy)) deallocate(dummy)
+ dummy_val % value = test_8_bits( index2:index2+test_block-1 )
+ allocate( dummy, source=dummy_val )
+ call set ( other, dummy )
+ call map % map_entry( key, other, conflict )
+ if (conflict) &
+ error stop "Unable to map entry because of a key conflict."
+ end do
+ call cpu_time(t2)
+ tdiff = t2-t1
+ write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
+ trim(hash_name), 'Enter data', size_name, tdiff
+
+ end subroutine input_random_data
+
+
+ subroutine test_inquire_data( map, test_block, hash_name, size_name )
+ type(open_hashmap_type), intent(inout) :: map
+ integer(int_index), intent(in) :: test_block
+ character(*), intent(in) :: hash_name, size_name
+ integer :: index2
+ logical :: present
+ type(key_type) :: key
+ real :: t1, t2, tdiff
+
+ call cpu_time(t1)
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ call map % key_test( key, present )
+ if (.not. present) &
+ error stop "KEY not found in map KEY_TEST."
+ end do
+ call cpu_time(t2)
+ tdiff = t2-t1
+ write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
+ trim(hash_name), 'Inquire data', size_name, tdiff
+
+ end subroutine test_inquire_data
+
+
+ subroutine test_get_data( map, test_block, hash_name, size_name )
+ type(open_hashmap_type), intent(inout) :: map
+ integer(int_index), intent(in) :: test_block
+ character(*), intent(in) :: hash_name, size_name
+ integer :: index2
+ type(key_type) :: key
+ type(other_type) :: other
+ logical :: exists
+ real :: t1, t2, tdiff
+
+ call cpu_time(t1)
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ call map % get_other_data( key, other, exists )
+ if (.not. exists) &
+ error stop "Unable to get data because key not found in map."
+ end do
+ call cpu_time(t2)
+ tdiff = t2-t1
+ write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
+ trim(hash_name), 'Get data', size_name, tdiff
+
+ end subroutine test_get_data
+
+
+ subroutine report_rehash_times( map, hasher, hash_name, size_name )
+ type(open_hashmap_type), intent(inout) :: map
+ procedure(hasher_fun) :: hasher
+ character(*), intent(in) :: hash_name, size_name
+ real :: t1, t2, tdiff
+
+ call cpu_time(t1)
+ call map % rehash( hasher )
+ call cpu_time(t2)
+ tdiff = t2-t1
+
+ write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
+ trim(hash_name), 'Rehash data', size_name, tdiff
+
+ end subroutine report_rehash_times
+
+
+ subroutine report_removal_times( map, test_block, hash_name, size_name )
+ type(open_hashmap_type), intent(inout) :: map
+ integer(int_index), intent(in) :: test_block
+ character(*), intent(in) :: hash_name, size_name
+ real :: t1, t2, tdiff
+ type(key_type) :: key
+ integer(int_index) :: index2
+ logical :: existed
+
+ call cpu_time(t1)
+ do index2=1, size(test_8_bits), test_block
+ call set( key, test_8_bits( index2:index2+test_block-1 ) )
+ call map % remove(key, existed)
+ if ( .not. existed ) &
+ error stop "Key not found in entry removal."
+ end do
+ call cpu_time(t2)
+ tdiff = t2-t1
+
+ write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
+ trim(hash_name), 'Remove data', size_name, tdiff
+ flush(lun)
+
+ end subroutine report_removal_times
+
+
+ subroutine report_hash_statistics( map, hash_name, size_name )
+ type(open_hashmap_type), intent(inout) :: map
+ character(*), intent(in) :: hash_name, size_name
+ integer(int_depth) :: depth
+
+ write(lun, *)
+ write(lun, '("Statistics for open hash table with ",' // &
+ 'A, " hasher on ", A, ".")' ) hash_name, size_name
+ write(lun, '("Slots = ", I0)' ) map % num_slots()
+ write(lun, '("Calls = ", I0)' ) map % calls()
+ write(lun, '("Entries = ", I0)' ) map % entries()
+ write(lun, '("Total probes = ", I0)' ) map % map_probes()
+ write(lun, '("Loading = ", ES10.3)' ) map % loading()
+ depth = map % total_depth()
+ write(lun, '("Total depth = ", I0)' ) depth
+ write(lun, '("Relative depth = ", ES10.3)') &
+ real( depth ) / real( map % entries() )
+
+ end subroutine report_hash_statistics
+
+
+end program test_open_maps