Skip to content

Commit 396b6f6

Browse files
committed
Various changes
The changes include: Consistently change valid_index to valid_key Removed references to unmap and in_map Changed name( map ...) to map % name(...) Changed deferredxd to deferred [ticket: X]
1 parent 2782d3c commit 396b6f6

File tree

1 file changed

+32
-37
lines changed

1 file changed

+32
-37
lines changed

doc/specs/stdlib_hashmaps.md

Lines changed: 32 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -113,7 +113,7 @@ keys and their associated data.
113113

114114
The constant `int_hash` is used to define the integer kind value for
115115
the returned hash codes and variables used to access them. It
116-
currently is importedxd from `stdlib_hash_32bit` where it haas the
116+
currently is imported from `stdlib_hash_32bit` where it haas the
117117
value, `int32`.
118118

119119
### The `stdlib_hashmap_wrappers`' module's derived types
@@ -580,7 +580,7 @@ an allocatable of `class(*)`. It is an `intent(out)` argument.
580580
end do
581581
call set( key, value )
582582
call get( key, result )
583-
print *, `RESULT == VALUE = ', all( value == result )
583+
print *, `RESULT == VALUE = ', all( value == result )
584584
end program demo_get
585585
```
586586

@@ -683,11 +683,9 @@ The result is `.true.` if the keys are equal, otherwise `.falss.`.
683683
use stdlib_hashmap_wrappers, only: &
684684
copy_key, operator(==), key_type, set
685685
use iso_fortran_env, only: int8
686-
implicit none
687-
integer(int8), allocatable :: value(:)
686+
implicit none
687+
integer(int8) :: i, value(15)
688688
type(key_type) :: key_in, key_out
689-
integer(int_8) :: i
690-
allocate( value(1:15) )
691689
do i=1, 15
692690
value(i) = i
693691
end do
@@ -952,8 +950,8 @@ The extension types provide
952950
procedures to manipulate the structure of a hash map object:
953951
`init`, `map_entry`, `rehash`, `remove_entry`, and
954952
`set_other_data`. They also provide procedures to inquire about
955-
entries in the hash map: `get_other_data`, `in_map`, `unmap` and
956-
`valid_index`. Finally they provide procedures to inquire about the
953+
entries in the hash map: `get_other_data`, `in_map`, and
954+
`valid_key`. Finally they provide procedures to inquire about the
957955
overall structure and performance of the hash map object:`calls`,
958956
`entries`, `get_other_data`, `loading`, `slots`, and
959957
`total_depth`. The module also defines a number of public constants:
@@ -1076,7 +1074,6 @@ The type's definition is below:
10761074
integer(int_calls) :: total_probes = 0
10771075
integer(int_index) :: num_entries = 0
10781076
integer(int_index) :: num_free = 0
1079-
integer(int_index) :: index_mask = 2_int_index**default_bits-1
10801077
integer(int32) :: nbits = default_bits
10811078
procedure(hasher_fun), pointer, nopass :: hasher => fnv_1_hasher
10821079
contains
@@ -1093,7 +1090,7 @@ The type's definition is below:
10931090
procedure(remove_entry), deferred, pass(map) :: remove
10941091
procedure(set_other), deferred, pass(map) :: set_other_data
10951092
procedure(total_depth), deferred, pass(map) :: total_depth
1096-
procedure(valid_index), deferred, pass(map) :: valid_key
1093+
procedure(valid_key), deferred, pass(map) :: valid_key
10971094
end type hashmap_type
10981095
```
10991096

@@ -1183,9 +1180,8 @@ as follows:
11831180
procedure :: remove => remove_chaining_entry
11841181
procedure :: set_other_data => set_other_chaining_data
11851182
procedure :: total_depth => total_chaining_depth
1186-
procedure :: unmap => unmap_chain
1187-
procedure :: valid_index => valid_chaining_index
1188-
final :: free_chaining_map
1183+
procedure :: valid_key => valid_chaining_key
1184+
final :: free_chaining_map
11891185
end type chaining_hashmap_type
11901186
```
11911187

@@ -1199,10 +1195,10 @@ the inverse table. The type's definition is below:
11991195
```fortran
12001196
type :: open_map_entry_type ! Open hash map entry type
12011197
private
1202-
integer(int_hash) :: hash_val ! Full hash value
1203-
type(key_type) :: key ! The entry's key
1204-
type(other_type) :: other ! Other entry data
1205-
integer(int_index) :: index ! Index into inverse table
1198+
integer(int_hash) :: hash_val ! Full hash value
1199+
type(key_type) :: key ! The entry's key
1200+
type(other_type) :: other ! Other entry data
1201+
integer(int_index) :: index ! Index into inverse table
12061202
end type open_map_entry_type
12071203
```
12081204

@@ -1216,7 +1212,7 @@ containing the elements of the table. The type's definition is below:
12161212

12171213
```fortran
12181214
type open_map_entry_ptr ! Wrapper for a pointer to a open
1219-
! map entry type object
1215+
! map entry type object
12201216
type(open_map_entry_type), pointer :: target => null()
12211217
end type open_map_entry_ptr
12221218
```
@@ -1243,9 +1239,9 @@ as follows:
12431239
private
12441240
integer(int_index) :: index_mask = 2_int_index**default_bits-1
12451241
type(open_map_entry_pool), pointer :: cache => null()
1246-
integer(int_index), allocatable :: slots(:)
1247-
type(open_map_entry_ptr), allocatable :: inverse(:)
1248-
type(open_map_entry_list), pointer :: free_list => null()
1242+
type(open_map_entry_list), pointer :: free_list => null()
1243+
type(open_map_entry_ptr), allocatable :: inverse(:)
1244+
integer(int_index), allocatable :: slots(:)
12491245
contains
12501246
procedure :: get_other_data => get_other_open_data
12511247
procedure :: in_map => in_open_map
@@ -1256,8 +1252,7 @@ as follows:
12561252
procedure :: remove => remove_open_entry
12571253
procedure :: set_other_data => set_other_open_data
12581254
procedure :: total_depth => total_open_depth
1259-
procedure :: unmap => unmap_open
1260-
procedure :: valid_index => valid_open_index
1255+
procedure :: valid_key => valid_open_key
12611256
final :: free_open_map
12621257
end type open_hashmap_type
12631258
```
@@ -1273,49 +1268,49 @@ are listed below.
12731268

12741269
Procedure to initialize a chaining hash map:
12751270

1276-
* `init( map, hasher[, slots_bits, status] )` - Routine
1271+
* `map % init( hasher[, slots_bits, status] )` - Routine
12771272
to initialize a chaining hash map.
12781273

12791274
Procedure to modify the structure of a map:
12801275

1281-
* `rehash( map, hasher )` - Routine to change the hash function
1276+
* `map % rehash( hasher )` - Routine to change the hash function
12821277
for a map.
12831278

12841279
Procedures to modify the content of a map:
12851280

1286-
* `map_entry( map, key, other, conflict )` - Inserts an entry into the
1281+
* `map % map_entry( key, other, conflict )` - Inserts an entry into the
12871282
hash map.
12881283

1289-
* `remove_entry(map, key, existed )` - Remove the entry, if any,
1284+
* `map % remove_entry( key, existed )` - Remove the entry, if any,
12901285
associated with the `key`.
12911286

1292-
* `set_other_data( map, key, other, exists )` - Change the other data
1287+
* `map % set_other_data( key, other, exists )` - Change the other data
12931288
associated with the entry.
12941289

12951290
Procedures to report the content of a map:
12961291

1297-
* `get_other_data( map, key, other, exists )` - Returns the other data
1292+
* `map 5 get_other_data( key, other, exists )` - Returns the other data
12981293
associated with the `key`;
12991294

1300-
* `valid_key(map, key)` - Returns a flag indicating whether the `key`
1295+
* `map % valid_key( key)` - Returns a flag indicating whether the `key`
13011296
is present in the map.
13021297

13031298
Procedures to report on the structure of the map:
13041299

1305-
* `calls( map )` - the number of subroutine calls on the hash map.
1300+
* `map % calls()` - the number of subroutine calls on the hash map.
13061301

1307-
* `entries( map )`- the number of entries in a hash map.
1302+
* `map % entries()`- the number of entries in a hash map.
13081303

1309-
* `loading( map )` - the number of entries relative to the number of
1304+
* `map % loading()` - the number of entries relative to the number of
13101305
slots in a hash map.
13111306

1312-
* `map_probes( map )` - the total number of table probes on a hash
1307+
* `map % map_probes()` - the total number of table probes on a hash
13131308
map.
13141309

1315-
* `slots( map )` - Returns the number of allocated slots in a hash
1310+
* `map % slots()` - Returns the number of allocated slots in a hash
13161311
map.
13171312

1318-
* `total_depth( map )` - Returns the total number of one's based
1313+
* `map % total_depth()` - Returns the total number of one's based
13191314
offsets of slot entries from their slot index
13201315

13211316

@@ -2053,7 +2048,7 @@ the map.
20532048

20542049
##### Syntax
20552050

2056-
`result = [[stdlib_hashmaps:map % valid_index]]( key )`
2051+
`result = [[stdlib_hashmaps:map % valid_key]]( key )`
20572052

20582053
##### Class
20592054

0 commit comments

Comments
 (0)