-
Notifications
You must be signed in to change notification settings - Fork 6
/
Copy pathkey_value_module.f90
148 lines (96 loc) · 4.32 KB
/
key_value_module.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
module key_value_module
! Two types are defined:
! key_value_t to hold key value pairs, where the key is a string,
! and the value is an unlimited polymporphic type
!
! The following interface is wanted:
!
! A generic function to return a new key_value_t for
! kv = key_value_t(key, int32) key-value pair for int32 value
! kv = key_value_t(key, real32) ditto for real32 value
! kv = key_value_t(key, string) ditto for string value
!
! subroutine key_value_release(kv) to release/destroy resources
! subroutine key_value_print(kv) utility to print key/value pair
! key_value_list_t an exapndable list of key_value_t pairs
use iso_fortran_env
implicit none
public
type, public :: key_value_t
character (len = :), allocatable :: key ! The key ...
class (*), pointer :: val => null() ! ... value
end type key_value_t
type, public :: key_value_list_t
integer :: npair = 0 ! Current number of pairs
type (key_value_t), allocatable :: kv(:) ! Expandable list
end type key_value_list_t
! We will make the specific versions private; one must use the generic
! name.
private :: key_value_create_i32
private :: key_value_create_r32
private :: key_value_create_str
contains
!---------------------------------------------------------------------------
!---------------------------------------------------------------------------
function key_value_create_str(key, str) result(kv)
! Return aggregated key / value pair - note with trim(str)
character (len = *), intent(in) :: key
character (len = *), intent(in) :: str
type (key_value_t) :: kv
kv%key = trim(key)
allocate(kv%val, source = trim(str))
end function key_value_create_str
!---------------------------------------------------------------------------
!---------------------------------------------------------------------------
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
function key_value_list_empty_t() result(kvlist)
! Return a newly created empty list; allocate size zero pairs.
type (key_value_list_t) :: kvlist
kvlist%npair = 0
allocate(kvlist%kv(0))
end function key_value_list_empty_t
!---------------------------------------------------------------------------
!---------------------------------------------------------------------------
subroutine key_value_list_release(kvlist)
! Release list storage (assume allocated).
type (key_value_list_t), intent(inout) :: kvlist
integer :: ikv
do ikv = 1, kvlist%npair
call key_value_release(kvlist%kv(ikv))
end do
deallocate(kvlist%kv)
kvlist%npair = 0
end subroutine key_value_list_release
!---------------------------------------------------------------------------
!---------------------------------------------------------------------------
subroutine key_value_list_add_kv(kvlist, kv)
! Add attribute to list
type (key_value_list_t), intent(inout) :: kvlist
type (key_value_t), intent(in) :: kv
integer :: nnew
nnew = kvlist%npair + 1
if (nnew > size(kvlist%kv)) call key_value_list_reallocate(kvlist)
kvlist%npair = nnew
kvlist%kv(nnew)%key = kv%key
allocate(kvlist%kv(nnew)%val, source = kv%val)
end subroutine key_value_list_add_kv
!---------------------------------------------------------------------------
!---------------------------------------------------------------------------
subroutine key_value_list_print(kvlist)
! List items
type (key_value_list_t), intent(in) :: kvlist
integer :: ib
print *, "List has (size, current pairs): ", size(kvlist%kv), kvlist%npair
do ib = 1, kvlist%npair
call key_value_print(kvlist%kv(ib))
end do
end subroutine key_value_list_print
!---------------------------------------------------------------------------
!---------------------------------------------------------------------------
subroutine key_value_list_reallocate(kvlist)
! Expand list storage (by a factor of 2)
type (key_value_list_t), intent(inout) :: kvlist
! .. implementation required
end subroutine key_value_list_reallocate
end module key_value_module