Line data Source code
1 : !> \file dictionary_m.f90
2 : !! \brief Module file for dictionary_t
3 :
4 : !> Dictionary type that uses strings for the keys and values
5 : !!
6 : !! Design:
7 : !! - djb2 hash function (D. J. Bernstein, see http://www.cse.yorku.ca/~oz/hash.html)
8 : !! - The strings are all "character(len=:), allocatable" variables
9 : !! - There is no linked list nor pointers, only allocatable arrays for the dynamic data structure
10 : !! - set rewrites existing entries without complaining
11 :
12 : module dictionary_m
13 : implicit none
14 :
15 : private
16 :
17 : public :: dictionary_t
18 :
19 : !> Single entry in the dictionary
20 : type entry_t
21 : character(len=:), allocatable :: key
22 : character(len=:), allocatable :: value
23 : end type entry_t
24 :
25 : !> A bucket contains several entries
26 : type bucket_t
27 : type(entry_t), allocatable :: entries(:)
28 : integer :: current_size = 0
29 : integer :: current_idx = 0
30 : contains
31 : procedure :: find
32 : end type bucket_t
33 :
34 : !> The dictionary contains dict_size buckets (defined at run time)
35 : type dictionary_t
36 : type(bucket_t), allocatable :: buckets(:)
37 : integer :: dict_size = 0
38 : contains
39 : procedure :: djb2
40 : procedure :: set
41 : procedure :: get
42 : procedure :: init
43 : procedure :: show
44 : end type dictionary_t
45 :
46 : integer, parameter :: BUCKET_EMPTY = -2
47 : integer, parameter :: BUCKET_ENTRY_NOT_FOUND = -4
48 :
49 : contains
50 :
51 : !> djb2 hash function
52 : !!
53 : !! \param this the dictionary_t object
54 : !! \param s a string
55 : !!
56 : !! \return the hash value between 0 and dict_size-1
57 19 : function djb2(this, s) result(r)
58 : class(dictionary_t), intent(in) :: this
59 : character(len=*), intent(in) :: s
60 : integer :: r
61 :
62 : integer :: i, l
63 :
64 19 : l = len(s)
65 :
66 19 : r = 5381
67 :
68 97 : do i = 1, l
69 78 : r = r*33 + ichar(s(i:i))
70 : end do
71 :
72 19 : r = modulo(r, this%dict_size)
73 :
74 38 : end function djb2
75 :
76 : !> Add or replace an entry in the dictionary
77 : !!
78 : !! \param this the dictionary_t object
79 : !! \param k the key
80 : !! \param v the value
81 13 : subroutine set(this, k, v)
82 : class(dictionary_t), intent(inout) :: this
83 : character(len=*), intent(in) :: k
84 : character(len=*), intent(in) :: v
85 :
86 13 : type(bucket_t) :: tmp_bucket
87 :
88 : integer :: h, i, b_idx
89 :
90 13 : h = this%djb2(k) + 1
91 :
92 13 : b_idx = this%buckets(h)%find(k)
93 :
94 13 : if (b_idx == BUCKET_EMPTY) then
95 : ! allocate bucket for 1 entry
96 : ! also, means we can take the first entry
97 11 : allocate(this%buckets(h)%entries(1))
98 11 : this%buckets(h)%current_size = 1
99 11 : this%buckets(h)%current_idx = 1
100 11 : b_idx = 1
101 11 : this%buckets(h)%entries(1)%key = trim(k)
102 11 : this%buckets(h)%entries(1)%value = trim(v)
103 : ! the values are registered, exit
104 11 : return
105 : end if
106 :
107 2 : if (b_idx == BUCKET_ENTRY_NOT_FOUND) then
108 : ! copy and grow bucket entries
109 :
110 1 : allocate(tmp_bucket%entries(this%buckets(h)%current_size + 1))
111 1 : tmp_bucket%current_size = this%buckets(h)%current_size + 1
112 1 : tmp_bucket%current_idx = this%buckets(h)%current_idx + 1
113 :
114 2 : do i = 1, this%buckets(h)%current_size
115 1 : tmp_bucket%entries(i)%key = this%buckets(h)%entries(i)%key
116 1 : tmp_bucket%entries(i)%value = this%buckets(h)%entries(i)%value
117 : end do
118 :
119 1 : deallocate(this%buckets(h)%entries)
120 1 : allocate(this%buckets(h)%entries, source=tmp_bucket%entries)
121 1 : deallocate(tmp_bucket%entries)
122 :
123 1 : this%buckets(h)%current_size = tmp_bucket%current_size
124 1 : this%buckets(h)%current_idx = tmp_bucket%current_idx
125 1 : b_idx = this%buckets(h)%current_idx
126 : end if
127 :
128 2 : if (b_idx > 0) then
129 2 : this%buckets(h)%entries(b_idx)%key = k
130 2 : this%buckets(h)%entries(b_idx)%value = v
131 : end if
132 :
133 26 : end subroutine set
134 :
135 : !> Initialize a dictionary object
136 : !!
137 : !! \param this the dictionary_t object
138 : !! \param dict_size the size of the hash table
139 3 : subroutine init(this, dict_size)
140 : class(dictionary_t), intent(out) :: this
141 : integer, intent(in) :: dict_size
142 :
143 3 : allocate(this%buckets(dict_size))
144 3 : this%dict_size = dict_size
145 :
146 3 : end subroutine init
147 :
148 : !> Display the content of a dictionary
149 : !!
150 : !! \param this the dictionary_t object
151 1 : subroutine show(this)
152 : class(dictionary_t), intent(in) :: this
153 :
154 : integer :: i, j, s
155 : integer :: n
156 :
157 1 : n = 0
158 11 : do i = 1, this%dict_size
159 10 : s = this%buckets(i)%current_idx
160 10 : if (s > 0) then
161 5 : write(*,*) 'bucket : ', i, ' size ', s
162 11 : do j = 1, s
163 6 : write(*,*) 'key : ', this%buckets(i)%entries(j)%key
164 6 : write(*,*) 'value : ', this%buckets(i)%entries(j)%value
165 : end do
166 : end if
167 : end do
168 :
169 1 : end subroutine show
170 :
171 : !> Find the "in-bucket" index for a given key
172 : !!
173 : !! Negative return values correspond to module-defined return codes.
174 : !!
175 : !! \param this the bucket_t object
176 : !! \param k the key
177 : !!
178 : !! \return the index (1-based) of the key in the bucket or a return code
179 19 : function find(this, k) result(r)
180 : class(bucket_t), intent(in) :: this
181 : character(len=*), intent(in) :: k
182 : integer :: r
183 :
184 : integer :: i
185 :
186 19 : if (this%current_size == 0) then
187 12 : r = BUCKET_EMPTY
188 12 : return
189 : end if
190 :
191 7 : r = BUCKET_ENTRY_NOT_FOUND
192 8 : do i = 1, this%current_size
193 7 : if (this%entries(i)%key == trim(k)) then
194 6 : r = i
195 6 : exit
196 : end if
197 : end do
198 :
199 26 : end function find
200 :
201 : !> Fetch an entry in the dictionary.
202 : !!
203 : !! \param this the dictionary_t object
204 : !! \param k the key
205 : !!
206 : !! \return the value if found, an empty string else
207 12 : function get(this, k) result(r)
208 : class(dictionary_t), intent(in) :: this
209 : character(len=*), intent(in) :: k
210 :
211 : character(len=:), allocatable :: r
212 :
213 : integer :: h, b_idx
214 :
215 6 : h = this%djb2(k) + 1
216 :
217 6 : b_idx = this%buckets(h)%find(k)
218 :
219 6 : if ( (b_idx == BUCKET_EMPTY) .or. &
220 : (b_idx == BUCKET_ENTRY_NOT_FOUND) ) then
221 1 : r = ''
222 1 : return
223 : end if
224 :
225 5 : if (b_idx>0) then
226 5 : r = this%buckets(h)%entries(b_idx)%value
227 : end if
228 :
229 12 : end function get
230 :
231 3 : end module dictionary_m
|
