-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathyaml.f90
140 lines (116 loc) · 3.88 KB
/
yaml.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
module yaml
use iso_c_binding
use yaml_types
implicit none
private
integer,parameter :: string_length = 1024
integer,parameter :: error_length = 1024
public :: parse, error_length
type type_node_c
! Node
integer(c_int) :: T
! character(len=string_length, kind=c_char) :: path
! Scalar
type(c_ptr) :: string = c_null_ptr
! Dictionary
type(c_ptr) :: first_keyvaluepair = c_null_ptr
type(c_ptr) :: key = c_null_ptr
type(c_ptr) :: value = c_null_ptr
type(c_ptr) :: next_keyvaluepair = c_null_ptr
! List
type(c_ptr) :: first_listitem = c_null_ptr
type(c_ptr) :: node = c_null_ptr
type(c_ptr) :: next_listitem = c_null_ptr
end type
interface
subroutine LoadFile_c(filename, ptr, error) bind(C, name="LoadFile_c")
use, intrinsic :: iso_c_binding
character(len=1, kind = c_char), intent(in) :: filename
type(c_ptr), intent(out) :: ptr
character(len=1, kind = c_char), intent(in) :: error
end subroutine
subroutine DestroyNode(root) bind(C, name="DestroyNode")
use, intrinsic :: iso_c_binding
type(c_ptr), intent(inout) :: root
end subroutine
end interface
contains
function LoadFile(filename, error) result(root)
character(len=*), intent(in) :: filename
character(len=string_length, kind=c_char), intent(out) :: error
type(c_ptr) :: root
character(len=:, kind=c_char), allocatable :: filename_copy
filename_copy = filename//char(0)
call LoadFile_c(filename_copy, root, error)
deallocate(filename_copy)
end function
recursive subroutine read_value(node_c_ptr, node)
type(c_ptr), intent(in) :: node_c_ptr
class(type_node), intent(inout), pointer :: node
type(c_ptr) :: pair_c, item_c
type(type_node_c), pointer :: node_c, pair, item
character(len=string_length, kind=c_char), pointer :: key
character(len=string_length, kind=c_char), pointer :: string
class (type_node), pointer :: list_item
class (type_node), pointer :: value
call c_f_pointer(node_c_ptr, node_c)
if (node_c%T == 1) then
! is map
allocate(type_dictionary::node)
pair_c = node_c%first_keyvaluepair
do while(c_associated(pair_c))
call c_f_pointer(pair_c, pair)
call c_f_pointer(pair%key, key)
call read_value(pair%value, value)
select type (node)
class is (type_dictionary)
call node%set(key, value)
end select
pair_c = pair%next_keyvaluepair
enddo
elseif (node_c%T == 2) then
! is sequence
allocate(type_list::node)
item_c = node_c%first_listitem
do while(c_associated(item_c))
call c_f_pointer(item_c, item)
call read_value(item%node, list_item)
select type (node)
class is (type_list)
call node%append(list_item)
end select
item_c = item%next_listitem
enddo
elseif (node_c%T == 3) then
! is scalar
allocate(type_scalar::node)
call c_f_pointer(node_c%string, string)
select type (node)
class is (type_scalar)
node%string = string
end select
elseif (node_c%T == 4) then
! is null
allocate(type_null::node)
else
print*,'Problem!!!'
endif
end subroutine
function parse(path, error) result(root)
character(len=*), intent(in) :: path
character(len=string_length), intent(out) :: error
class (type_node), pointer :: root
type(c_ptr) :: root_c
nullify(root)
if (len_trim(path) >= string_length) then
error = "The path can not be longer than 1024 characters."
return
endif
root_c = LoadFile(trim(path), error)
if (c_associated(root_c)) then
call read_value(root_c, root)
call root%set_path("")
call DestroyNode(root_c)
endif
end function
end module