Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / tools / importer / vhdl_json_lib.ml @ 55963629

History | View | Annotate | Download (6.22 KB)

1
open Yojson.Safe
2
open Yojson.Safe.Util
3

    
4
let rec assoc_map_except_str l f str =
5
  match l with
6
  | (s,x)::y -> 
7
    if (String.equal s str) then 
8
      assoc_map_except_str y f str
9
    else
10
      (s,f str x)::assoc_map_except_str y f str
11
  | [] -> []
12

    
13
let rec map_2_args f l arg1 =
14
  match l with
15
  | hd::tl -> (f arg1 hd)::(map_2_args f tl arg1)
16
  | [] -> []
17

    
18
(*
19
Remove `Assoc nodes with tag 'str' in json j
20
*)
21
let rec prune_str str json =
22
  match json with
23
    | `Assoc ((t,hd)::tl) -> 
24
      if (String.equal str t) then
25
        `Assoc (assoc_map_except_str tl prune_str str)
26
      else
27
        `Assoc ((t, prune_str str hd)::(assoc_map_except_str tl prune_str str))
28
    | `List (hd::tl) -> `List ((prune_str str hd)::(map_2_args prune_str tl str))
29
    | `String (s) -> if (String.equal str s) then `String ("") else `String (s)
30
    | x -> x
31

    
32
(*******************)
33

    
34
let rec name_pair_list_to_string l =
35
  match l with
36
  | (t, `String(x))::tl -> 
37
    if (String.equal t "name") then 
38
      (x::name_pair_list_to_string tl) 
39
    else 
40
      (name_pair_list_to_string tl)
41
  | _ -> []
42

    
43
let rec assoc_filter_string l str =
44
  match l with
45
  | `Assoc (x) -> name_pair_list_to_string x
46
  | _ -> []
47

    
48
(********************)
49

    
50
let rec pairlist_remove str l f =
51
  match l with
52
  | (t,j)::tl ->
53
    if (String.equal t str) then
54
      (f j)::(pairlist_remove str tl f)
55
    else
56
      `Assoc ((t, f j)::[])::(pairlist_remove str tl f)
57
  | [] -> []
58

    
59
(******************)
60
let rec assoc_elem_fst pair_list = 
61
  match pair_list with 
62
  | (t,j)::tl -> t::(assoc_elem_fst tl)
63
  | [] -> []
64

    
65
let rec assoc_elem_snd pair_list = 
66
  match pair_list with 
67
  | (t,j)::tl -> j::(assoc_elem_snd tl) 
68
  | [] -> []
69

    
70
let rec assoc_elem_filter pair_list str = 
71
  match pair_list with 
72
  | (t,j)::tl -> if (String.equal t str) then 
73
                    (t,j)::(assoc_elem_filter tl str) 
74
                  else assoc_elem_filter tl str
75
  | [] -> []
76

    
77
let rec assoc_elem_filternot pair_list str = 
78
  match pair_list with 
79
  | (t,j)::tl -> if (not (String.equal t str)) then 
80
                    (t,j)::(assoc_elem_filternot tl str) 
81
                  else assoc_elem_filternot tl str
82
  | [] -> []
83

    
84
let rec assoc_elem_filter_snd pair_list str = 
85
  match pair_list with 
86
  | (t,j)::tl -> if (String.equal t str) then 
87
                    j::(assoc_elem_filter_snd tl str) 
88
                  else assoc_elem_filter_snd tl str
89
  | [] -> []
90

    
91
let rec assoc_elem_filternot_snd pair_list str = 
92
  match pair_list with 
93
  | (t,j)::tl -> if (not (String.equal t str)) then 
94
                    j::(assoc_elem_filter_snd tl str) 
95
                  else assoc_elem_filter_snd tl str
96
  | [] -> []
97

    
98
let rec pairlist_snd_as_list pair_list str = 
99
  match pair_list with 
100
  | (t,j)::tl -> if (String.equal t str) then 
101
                    (t,`List (j::[]))::(pairlist_snd_as_list tl str)
102
                  else (t,j)::(pairlist_snd_as_list tl str)
103
  | [] -> []
104

    
105
let all_members str json =
106
  match json with
107
  | `Assoc (l) -> assoc_elem_filter_snd l str
108
  | _ -> []
109

    
110
let retain_other_members str json =
111
  match json with
112
  | `Assoc (l) -> `Assoc (assoc_elem_filter l str)
113
  | _ -> `Null
114

    
115
(*
116
DESIGN_UNIT as lists
117
*)
118
let vhdl_json_designunits_content_as_list json =
119
  let designunits_contents = json |> member "DESIGN_FILE" |> all_members "DESIGN_UNIT" in
120
  `List designunits_contents
121

    
122
let vhdl_json_designfile_content_excluding json str =
123
  json |> member "DESIGN_FILE" |> retain_other_members "DESIGN_UNIT" 
124

    
125
let vhdl_json_list_designunits json =
126
  let design_file = json |> member "DESIGN_FILE" in
127
  let designunits_list = vhdl_json_designunits_content_as_list json in
128
  `Assoc (("DESIGN_FILE", (`Assoc (("DESIGN_UNIT", designunits_list)::[])))::[])
129

    
130
let rec pairlist_contains_str str l =
131
  match l with
132
  | (t,j)::tl -> if (String.equal t str) then true else pairlist_contains_str str tl
133
  | [] -> false
134

    
135
(*
136
ITEM element content as list
137
*)
138
let assoc_elem_as_list str json =
139
  match json with
140
  | `Assoc (l) -> `Assoc (pairlist_snd_as_list l str)
141
  | x -> x
142

    
143
let rec map_list map_f l f =
144
  match l with
145
  | hd::tl -> (map_f (f hd) f)::(map_list map_f tl f)
146
  | [] -> []
147

    
148
let rec map_pairlist map_f l f =
149
  match l with
150
  | (t,j)::tl -> (t, map_f (f j) f)::(map_pairlist map_f tl f)
151
  | [] -> []
152

    
153
let rec map_snd f l =
154
  match l with
155
  | (t,j)::tl -> (t,f j)::(map_snd f tl)
156
  | [] -> []
157

    
158
let rec map_all json f =
159
  match json with
160
  | `Assoc ((t,j)::tl) -> 
161
    `Assoc ((t,(map_all (f j) f))::(map_pairlist map_all tl f))
162
  | `List (hd::tl) -> 
163
    `List ((map_all (f hd) f)::(map_list map_all tl f))
164
  | x -> x
165

    
166
let to_list_str str json =
167
  map_all json (assoc_elem_as_list str)
168

    
169
let rec to_list_content_str str json =
170
  match json with
171
  | `Assoc (l) -> if (pairlist_contains_str str l) then
172
      `Assoc (
173
         (str, to_list_content_str str (`List (assoc_elem_filter_snd l str)))
174
         ::(assoc_elem_filternot (map_snd (to_list_content_str str) l) str)
175
      )
176
    else 
177
      `Assoc (map_snd (to_list_content_str str) l)
178
  | `List (hd::tl) -> `List ((to_list_content_str str hd)::(List.map (to_list_content_str str) tl))
179
  | x -> x
180

    
181
let rec prune_null_assoc json =
182
  match json with
183
  | `Assoc ((t, `Assoc([]))::tl) -> prune_null_assoc (`Assoc tl)
184
  | `Assoc ((t, `Null)::tl) -> prune_null_assoc (`Assoc tl)
185
  | `Assoc ((t, j)::tl) -> `Assoc ((t, (prune_null_assoc j))::(map_snd prune_null_assoc tl))
186
  | `List (`Null::[]) -> `Null
187
  | `List (l) -> `List (List.map prune_null_assoc l)
188
  | x -> x
189

    
190
(*
191
Value printers
192
*)
193
let rec print_depth json depth indent =
194
  if (depth > 0) then
195
    match json with
196
    | `Assoc ((t,j)::tl) -> 
197
      (indent^t)::(List.append (print_depth j (depth-1) (indent^"  "))
198
                               (print_depth (`Assoc (tl)) depth indent))
199
    | `List (hd::tl) ->
200
      List.append (print_depth hd depth indent)
201
                  (print_depth (`List (tl)) depth indent)
202
    | _ -> []
203
  else
204
    []
205

    
206
let rec flatten_ivd json =
207
  match json with
208
  | `Assoc ((t, `List (l))::[]) -> if (String.equal t "INTERFACE_VARIABLE_DECLARATION") then
209
      `List (List.map flatten_ivd l) else `Assoc ((t, flatten_ivd (`List(l)))::[])
210
  | `Assoc (l) -> `Assoc (map_snd flatten_ivd l)
211
  | `List (hd::tl) -> `List((flatten_ivd hd)::(List.map flatten_ivd tl))
212
  | x -> x
213

    
214
(*
215
let do_stuff json =
216
  match json with
217
  | `Assoc ((t,j)::tl) -> 
218
  | `List (hd::tl) ->
219
  | `String (s) ->
220
  | _ -> x
221
*)