@@ -113,7 +113,7 @@ keys and their associated data.
113
113
114
114
The constant ` int_hash ` is used to define the integer kind value for
115
115
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
117
117
value, ` int32 ` .
118
118
119
119
### The ` stdlib_hashmap_wrappers ` ' module's derived types
@@ -580,7 +580,7 @@ an allocatable of `class(*)`. It is an `intent(out)` argument.
580
580
end do
581
581
call set( key, value )
582
582
call get( key, result )
583
- print *, `RESULT == VALUE = ', all( value == result )
583
+ print *, `RESULT == VALUE = ', all( value == result )
584
584
end program demo_get
585
585
```
586
586
@@ -683,11 +683,9 @@ The result is `.true.` if the keys are equal, otherwise `.falss.`.
683
683
use stdlib_hashmap_wrappers, only: &
684
684
copy_key, operator(==), key_type, set
685
685
use iso_fortran_env, only: int8
686
- implicit none
687
- integer(int8), allocatable :: value(: )
686
+ implicit none
687
+ integer(int8) :: i, value(15 )
688
688
type(key_type) :: key_in, key_out
689
- integer(int_8) :: i
690
- allocate( value(1:15) )
691
689
do i=1, 15
692
690
value(i) = i
693
691
end do
@@ -952,8 +950,8 @@ The extension types provide
952
950
procedures to manipulate the structure of a hash map object:
953
951
` init ` , ` map_entry ` , ` rehash ` , ` remove_entry ` , and
954
952
` 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
957
955
overall structure and performance of the hash map object:` calls ` ,
958
956
` entries ` , ` get_other_data ` , ` loading ` , ` slots ` , and
959
957
` total_depth ` . The module also defines a number of public constants:
@@ -1076,7 +1074,6 @@ The type's definition is below:
1076
1074
integer(int_calls) :: total_probes = 0
1077
1075
integer(int_index) :: num_entries = 0
1078
1076
integer(int_index) :: num_free = 0
1079
- integer(int_index) :: index_mask = 2_int_index**default_bits-1
1080
1077
integer(int32) :: nbits = default_bits
1081
1078
procedure(hasher_fun), pointer, nopass :: hasher => fnv_1_hasher
1082
1079
contains
@@ -1093,7 +1090,7 @@ The type's definition is below:
1093
1090
procedure(remove_entry), deferred, pass(map) :: remove
1094
1091
procedure(set_other), deferred, pass(map) :: set_other_data
1095
1092
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
1097
1094
end type hashmap_type
1098
1095
```
1099
1096
@@ -1183,9 +1180,8 @@ as follows:
1183
1180
procedure :: remove => remove_chaining_entry
1184
1181
procedure :: set_other_data => set_other_chaining_data
1185
1182
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
1189
1185
end type chaining_hashmap_type
1190
1186
```
1191
1187
@@ -1199,10 +1195,10 @@ the inverse table. The type's definition is below:
1199
1195
``` fortran
1200
1196
type :: open_map_entry_type ! Open hash map entry type
1201
1197
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
1206
1202
end type open_map_entry_type
1207
1203
```
1208
1204
@@ -1216,7 +1212,7 @@ containing the elements of the table. The type's definition is below:
1216
1212
1217
1213
``` fortran
1218
1214
type open_map_entry_ptr ! Wrapper for a pointer to a open
1219
- ! map entry type object
1215
+ ! map entry type object
1220
1216
type(open_map_entry_type), pointer :: target => null()
1221
1217
end type open_map_entry_ptr
1222
1218
```
@@ -1243,9 +1239,9 @@ as follows:
1243
1239
private
1244
1240
integer(int_index) :: index_mask = 2_int_index**default_bits-1
1245
1241
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(:)
1249
1245
contains
1250
1246
procedure :: get_other_data => get_other_open_data
1251
1247
procedure :: in_map => in_open_map
@@ -1256,8 +1252,7 @@ as follows:
1256
1252
procedure :: remove => remove_open_entry
1257
1253
procedure :: set_other_data => set_other_open_data
1258
1254
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
1261
1256
final :: free_open_map
1262
1257
end type open_hashmap_type
1263
1258
```
@@ -1273,49 +1268,49 @@ are listed below.
1273
1268
1274
1269
Procedure to initialize a chaining hash map:
1275
1270
1276
- * ` init( map, hasher[, slots_bits, status] ) ` - Routine
1271
+ * ` map % init( hasher[, slots_bits, status] )` - Routine
1277
1272
to initialize a chaining hash map.
1278
1273
1279
1274
Procedure to modify the structure of a map:
1280
1275
1281
- * ` rehash( map, hasher ) ` - Routine to change the hash function
1276
+ * ` map % rehash( hasher )` - Routine to change the hash function
1282
1277
for a map.
1283
1278
1284
1279
Procedures to modify the content of a map:
1285
1280
1286
- * ` map_entry( map, key, other, conflict ) ` - Inserts an entry into the
1281
+ * ` map % map_entry( key, other, conflict )` - Inserts an entry into the
1287
1282
hash map.
1288
1283
1289
- * ` remove_entry(map, key, existed ) ` - Remove the entry, if any,
1284
+ * ` map % remove_entry( key, existed )` - Remove the entry, if any,
1290
1285
associated with the ` key ` .
1291
1286
1292
- * ` set_other_data( map, key, other, exists ) ` - Change the other data
1287
+ * ` map % set_other_data( key, other, exists )` - Change the other data
1293
1288
associated with the entry.
1294
1289
1295
1290
Procedures to report the content of a map:
1296
1291
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
1298
1293
associated with the ` key ` ;
1299
1294
1300
- * ` valid_key(map, key) ` - Returns a flag indicating whether the ` key `
1295
+ * ` map % valid_key( key)` - Returns a flag indicating whether the ` key `
1301
1296
is present in the map.
1302
1297
1303
1298
Procedures to report on the structure of the map:
1304
1299
1305
- * ` calls( map )` - the number of subroutine calls on the hash map.
1300
+ * ` map % calls( ) ` - the number of subroutine calls on the hash map.
1306
1301
1307
- * ` entries( map )` - the number of entries in a hash map.
1302
+ * ` map % entries( ) ` - the number of entries in a hash map.
1308
1303
1309
- * ` loading( map )` - the number of entries relative to the number of
1304
+ * ` map % loading( ) ` - the number of entries relative to the number of
1310
1305
slots in a hash map.
1311
1306
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
1313
1308
map.
1314
1309
1315
- * ` slots( map )` - Returns the number of allocated slots in a hash
1310
+ * ` map % slots( ) ` - Returns the number of allocated slots in a hash
1316
1311
map.
1317
1312
1318
- * ` total_depth( map )` - Returns the total number of one's based
1313
+ * ` map % total_depth( ) ` - Returns the total number of one's based
1319
1314
offsets of slot entries from their slot index
1320
1315
1321
1316
@@ -2053,7 +2048,7 @@ the map.
2053
2048
2054
2049
##### Syntax
2055
2050
2056
- ` result = [[stdlib_hashmaps:map % valid_index ]]( key ) `
2051
+ ` result = [[stdlib_hashmaps:map % valid_key ]]( key ) `
2057
2052
2058
2053
##### Class
2059
2054
0 commit comments