Skip to content

Commit

Permalink
Merge pull request #13 from jvdp1/hash_maps_review
Browse files Browse the repository at this point in the history
Some additions to hash maps
  • Loading branch information
wclodius2 authored Jun 19, 2022
2 parents dd120fe + 45b92c7 commit f705430
Show file tree
Hide file tree
Showing 3 changed files with 47 additions and 8 deletions.
10 changes: 5 additions & 5 deletions doc/specs/stdlib_hashmaps.md
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,7 @@ 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 Programers
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
Expand Down Expand Up @@ -113,7 +113,7 @@ keys and their associated data.

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 haas the
currently is imported from `stdlib_hash_32bit` where it has the
value, `int32`.

### The `stdlib_hashmap_wrappers`' module's derived types
Expand Down Expand Up @@ -229,7 +229,7 @@ is an `intent(out)` argument.
```fortran
program demo_copy_key
use stdlib_hashmap_wrappers, only: &
copy_key, operator(==), equal_keys, key_type
copy_key, operator(==), key_type
use iso_fortran_env, only: int8
implicit none
integer(int8) :: i, value(15)
Expand Down Expand Up @@ -1043,7 +1043,7 @@ seven private components:

* `nbits` - the number of bits used to address the slots;

* `num_entries` - the humber of entries in the map;
* `num_entries` - the number of entries in the map;

* `num_free` - the number of entries in the free list of removed
entries;
Expand Down Expand Up @@ -1609,7 +1609,7 @@ entry in the map.

##### Syntax

`result = call map % [[hashmap_type(type):key_test(bound)]]( key, present )`
`call map % [[hashmap_type(type):key_test(bound)]]( key, present )`

##### Class

Expand Down
19 changes: 18 additions & 1 deletion src/stdlib_hashmap_wrappers.f90
Original file line number Diff line number Diff line change
Expand Up @@ -110,7 +110,9 @@ end function hasher_fun
pure subroutine copy_key( old_key, new_key )
!! Version: Experimental
!!
!! Copies the contents of the key, old_key, to the key, out_key
!! 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
Expand All @@ -126,6 +128,8 @@ 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
Expand All @@ -141,6 +145,8 @@ 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
Expand All @@ -167,6 +173,8 @@ 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
Expand All @@ -180,6 +188,8 @@ 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
Expand Down Expand Up @@ -330,6 +340,8 @@ 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
Expand All @@ -344,6 +356,8 @@ 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
Expand All @@ -360,6 +374,7 @@ 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
Expand All @@ -376,6 +391,8 @@ 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
Expand Down
26 changes: 24 additions & 2 deletions src/stdlib_hashmaps.f90
Original file line number Diff line number Diff line change
Expand Up @@ -70,6 +70,7 @@ module stdlib_hashmaps
!! 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
Expand Down Expand Up @@ -158,6 +159,8 @@ 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
Expand All @@ -173,6 +176,8 @@ 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
Expand All @@ -184,8 +189,8 @@ subroutine map_entry(map, key, other, conflict)
!! Version: Experimental
!!
!! Inserts an entry into the hash table
!! Arguments:
!
!! ([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
Expand Down Expand Up @@ -246,6 +251,7 @@ function total_depth( map )
!!
!! 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
Expand All @@ -261,6 +267,7 @@ end function total_depth
!! 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
Expand All @@ -279,6 +286,7 @@ end function total_depth
!! 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

Expand All @@ -287,6 +295,7 @@ end function total_depth
!! 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
Expand All @@ -299,6 +308,7 @@ end function total_depth
!! 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
Expand Down Expand Up @@ -487,6 +497,7 @@ end function total_chaining_depth
!! 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
Expand All @@ -512,6 +523,7 @@ end function total_chaining_depth
!! 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

Expand Down Expand Up @@ -720,6 +732,8 @@ 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
Expand All @@ -733,6 +747,8 @@ 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
Expand All @@ -747,6 +763,8 @@ 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
Expand All @@ -761,6 +779,8 @@ 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
Expand All @@ -776,6 +796,8 @@ pure function slots_bits( map )
!!
!! 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
Expand Down

0 comments on commit f705430

Please sign in to comment.