Revision ca7ff3f7
Added by Lélio Brun over 1 year ago
src/tools/importer/vhdl_json_lib.ml | ||
---|---|---|
2 | 2 |
|
3 | 3 |
let rec assoc_map_except_str l f str = |
4 | 4 |
match l with |
5 |
| (s,x)::y -> |
|
6 |
if (String.equal s str) then |
|
7 |
assoc_map_except_str y f str |
|
8 |
else |
|
9 |
(s,f str x)::assoc_map_except_str y f str |
|
10 |
| [] -> [] |
|
5 |
| (s, x) :: y -> |
|
6 |
if String.equal s str then assoc_map_except_str y f str |
|
7 |
else (s, f str x) :: assoc_map_except_str y f str |
|
8 |
| [] -> |
|
9 |
[] |
|
11 | 10 |
|
12 | 11 |
let rec map_2_args f l arg1 = |
13 |
match l with |
|
14 |
| hd::tl -> (f arg1 hd)::(map_2_args f tl arg1) |
|
15 |
| [] -> [] |
|
12 |
match l with hd :: tl -> f arg1 hd :: map_2_args f tl arg1 | [] -> [] |
|
16 | 13 |
|
17 |
(* |
|
18 |
Remove `Assoc nodes with tag 'str' in json j |
|
19 |
*) |
|
14 |
(* Remove `Assoc nodes with tag 'str' in json j *) |
|
20 | 15 |
let rec prune_str str json = |
21 | 16 |
match json with |
22 |
| `Assoc ((t,hd)::tl) -> |
|
23 |
if (String.equal str t) then |
|
24 |
`Assoc (assoc_map_except_str tl prune_str str) |
|
25 |
else |
|
26 |
`Assoc ((t, prune_str str hd)::(assoc_map_except_str tl prune_str str)) |
|
27 |
| `List (hd::tl) -> `List ((prune_str str hd)::(map_2_args prune_str tl str)) |
|
28 |
| `String (s) -> if (String.equal str s) then `String ("") else `String (s) |
|
29 |
| x -> x |
|
17 |
| `Assoc ((t, hd) :: tl) -> |
|
18 |
if String.equal str t then `Assoc (assoc_map_except_str tl prune_str str) |
|
19 |
else `Assoc ((t, prune_str str hd) :: assoc_map_except_str tl prune_str str) |
|
20 |
| `List (hd :: tl) -> |
|
21 |
`List (prune_str str hd :: map_2_args prune_str tl str) |
|
22 |
| `String s -> |
|
23 |
if String.equal str s then `String "" else `String s |
|
24 |
| x -> |
|
25 |
x |
|
30 | 26 |
|
31 | 27 |
(*******************) |
32 | 28 |
|
33 | 29 |
let rec name_pair_list_to_string l = |
34 | 30 |
match l with |
35 |
| (t, `String(x))::tl -> |
|
36 |
if (String.equal t "name") then |
|
37 |
(x::name_pair_list_to_string tl) |
|
38 |
else |
|
39 |
(name_pair_list_to_string tl) |
|
40 |
| _ -> [] |
|
31 |
| (t, `String x) :: tl -> |
|
32 |
if String.equal t "name" then x :: name_pair_list_to_string tl |
|
33 |
else name_pair_list_to_string tl |
|
34 |
| _ -> |
|
35 |
[] |
|
41 | 36 |
|
42 | 37 |
let assoc_filter_string l = |
43 |
match l with |
|
44 |
| `Assoc (x) -> name_pair_list_to_string x |
|
45 |
| _ -> [] |
|
38 |
match l with `Assoc x -> name_pair_list_to_string x | _ -> [] |
|
46 | 39 |
|
47 | 40 |
(********************) |
48 | 41 |
|
49 | 42 |
let rec pairlist_remove str l f = |
50 | 43 |
match l with |
51 |
| (t,j)::tl -> |
|
52 |
if (String.equal t str) then |
|
53 |
(f j)::(pairlist_remove str tl f) |
|
54 |
else |
|
55 |
`Assoc ((t, f j)::[])::(pairlist_remove str tl f) |
|
56 |
| [] -> [] |
|
44 |
| (t, j) :: tl -> |
|
45 |
if String.equal t str then f j :: pairlist_remove str tl f |
|
46 |
else `Assoc [ t, f j ] :: pairlist_remove str tl f |
|
47 |
| [] -> |
|
48 |
[] |
|
57 | 49 |
|
58 | 50 |
(******************) |
59 |
let rec assoc_elem_fst pair_list = |
|
60 |
match pair_list with |
|
61 |
| (t, _)::tl -> t::(assoc_elem_fst tl) |
|
62 |
| [] -> [] |
|
63 |
|
|
64 |
let rec assoc_elem_snd pair_list = |
|
65 |
match pair_list with |
|
66 |
| (_, j)::tl -> j::(assoc_elem_snd tl) |
|
67 |
| [] -> [] |
|
68 |
|
|
69 |
let rec assoc_elem_filter pair_list str = |
|
70 |
match pair_list with |
|
71 |
| (t,j)::tl -> if (String.equal t str) then |
|
72 |
(t,j)::(assoc_elem_filter tl str) |
|
73 |
else assoc_elem_filter tl str |
|
74 |
| [] -> [] |
|
75 |
|
|
76 |
let rec assoc_elem_filternot pair_list str = |
|
77 |
match pair_list with |
|
78 |
| (t,j)::tl -> if (not (String.equal t str)) then |
|
79 |
(t,j)::(assoc_elem_filternot tl str) |
|
80 |
else assoc_elem_filternot tl str |
|
81 |
| [] -> [] |
|
82 |
|
|
83 |
let rec assoc_elem_filter_snd pair_list str = |
|
84 |
match pair_list with |
|
85 |
| (t,j)::tl -> if (String.equal t str) then |
|
86 |
j::(assoc_elem_filter_snd tl str) |
|
87 |
else assoc_elem_filter_snd tl str |
|
88 |
| [] -> [] |
|
51 |
let rec assoc_elem_fst pair_list = |
|
52 |
match pair_list with (t, _) :: tl -> t :: assoc_elem_fst tl | [] -> [] |
|
53 |
|
|
54 |
let rec assoc_elem_snd pair_list = |
|
55 |
match pair_list with (_, j) :: tl -> j :: assoc_elem_snd tl | [] -> [] |
|
56 |
|
|
57 |
let rec assoc_elem_filter pair_list str = |
|
58 |
match pair_list with |
|
59 |
| (t, j) :: tl -> |
|
60 |
if String.equal t str then (t, j) :: assoc_elem_filter tl str |
|
61 |
else assoc_elem_filter tl str |
|
62 |
| [] -> |
|
63 |
[] |
|
64 |
|
|
65 |
let rec assoc_elem_filternot pair_list str = |
|
66 |
match pair_list with |
|
67 |
| (t, j) :: tl -> |
|
68 |
if not (String.equal t str) then (t, j) :: assoc_elem_filternot tl str |
|
69 |
else assoc_elem_filternot tl str |
|
70 |
| [] -> |
|
71 |
[] |
|
72 |
|
|
73 |
let rec assoc_elem_filter_snd pair_list str = |
|
74 |
match pair_list with |
|
75 |
| (t, j) :: tl -> |
|
76 |
if String.equal t str then j :: assoc_elem_filter_snd tl str |
|
77 |
else assoc_elem_filter_snd tl str |
|
78 |
| [] -> |
|
79 |
[] |
|
89 | 80 |
|
90 | 81 |
let assoc_elem_filternot_snd pair_list str = |
91 |
match pair_list with |
|
92 |
| (t,j)::tl -> if (not (String.equal t str)) then |
|
93 |
j::(assoc_elem_filter_snd tl str) |
|
94 |
else assoc_elem_filter_snd tl str |
|
95 |
| [] -> [] |
|
96 |
|
|
97 |
let rec pairlist_snd_as_list pair_list str = |
|
98 |
match pair_list with |
|
99 |
| (t,j)::tl -> if (String.equal t str) then |
|
100 |
(t,`List (j::[]))::(pairlist_snd_as_list tl str) |
|
101 |
else (t,j)::(pairlist_snd_as_list tl str) |
|
102 |
| [] -> [] |
|
82 |
match pair_list with |
|
83 |
| (t, j) :: tl -> |
|
84 |
if not (String.equal t str) then j :: assoc_elem_filter_snd tl str |
|
85 |
else assoc_elem_filter_snd tl str |
|
86 |
| [] -> |
|
87 |
[] |
|
88 |
|
|
89 |
let rec pairlist_snd_as_list pair_list str = |
|
90 |
match pair_list with |
|
91 |
| (t, j) :: tl -> |
|
92 |
if String.equal t str then (t, `List [ j ]) :: pairlist_snd_as_list tl str |
|
93 |
else (t, j) :: pairlist_snd_as_list tl str |
|
94 |
| [] -> |
|
95 |
[] |
|
103 | 96 |
|
104 | 97 |
let all_members str json = |
105 |
match json with |
|
106 |
| `Assoc (l) -> assoc_elem_filter_snd l str |
|
107 |
| _ -> [] |
|
98 |
match json with `Assoc l -> assoc_elem_filter_snd l str | _ -> [] |
|
108 | 99 |
|
109 | 100 |
let retain_other_members str json = |
110 |
match json with |
|
111 |
| `Assoc (l) -> `Assoc (assoc_elem_filter l str) |
|
112 |
| _ -> `Null |
|
101 |
match json with `Assoc l -> `Assoc (assoc_elem_filter l str) | _ -> `Null |
|
113 | 102 |
|
114 |
(* |
|
115 |
DESIGN_UNIT as lists |
|
116 |
*) |
|
103 |
(* DESIGN_UNIT as lists *) |
|
117 | 104 |
let vhdl_json_designunits_content_as_list json = |
118 |
let designunits_contents = json |> member "DESIGN_FILE" |> all_members "DESIGN_UNIT" in |
|
105 |
let designunits_contents = |
|
106 |
json |> member "DESIGN_FILE" |> all_members "DESIGN_UNIT" |
|
107 |
in |
|
119 | 108 |
`List designunits_contents |
120 | 109 |
|
121 | 110 |
let vhdl_json_designfile_content_excluding json = |
122 |
json |> member "DESIGN_FILE" |> retain_other_members "DESIGN_UNIT"
|
|
111 |
json |> member "DESIGN_FILE" |> retain_other_members "DESIGN_UNIT" |
|
123 | 112 |
|
124 | 113 |
let vhdl_json_list_designunits json = |
125 | 114 |
let designunits_list = vhdl_json_designunits_content_as_list json in |
126 |
`Assoc (("DESIGN_FILE", (`Assoc (("DESIGN_UNIT", designunits_list)::[])))::[])
|
|
115 |
`Assoc [ "DESIGN_FILE", `Assoc [ "DESIGN_UNIT", designunits_list ] ]
|
|
127 | 116 |
|
128 | 117 |
let rec pairlist_contains_str str l = |
129 | 118 |
match l with |
130 |
| (t, _)::tl -> if (String.equal t str) then true else pairlist_contains_str str tl |
|
131 |
| [] -> false |
|
119 |
| (t, _) :: tl -> |
|
120 |
if String.equal t str then true else pairlist_contains_str str tl |
|
121 |
| [] -> |
|
122 |
false |
|
132 | 123 |
|
133 |
(* |
|
134 |
ITEM element content as list |
|
135 |
*) |
|
124 |
(* ITEM element content as list *) |
|
136 | 125 |
let assoc_elem_as_list str json = |
137 |
match json with |
|
138 |
| `Assoc (l) -> `Assoc (pairlist_snd_as_list l str) |
|
139 |
| x -> x |
|
126 |
match json with `Assoc l -> `Assoc (pairlist_snd_as_list l str) | x -> x |
|
140 | 127 |
|
141 | 128 |
let rec map_list map_f l f = |
142 |
match l with |
|
143 |
| hd::tl -> (map_f (f hd) f)::(map_list map_f tl f) |
|
144 |
| [] -> [] |
|
129 |
match l with hd :: tl -> map_f (f hd) f :: map_list map_f tl f | [] -> [] |
|
145 | 130 |
|
146 | 131 |
let rec map_pairlist map_f l f = |
147 | 132 |
match l with |
148 |
| (t,j)::tl -> (t, map_f (f j) f)::(map_pairlist map_f tl f) |
|
149 |
| [] -> [] |
|
133 |
| (t, j) :: tl -> |
|
134 |
(t, map_f (f j) f) :: map_pairlist map_f tl f |
|
135 |
| [] -> |
|
136 |
[] |
|
150 | 137 |
|
151 | 138 |
let rec map_snd f l = |
152 |
match l with |
|
153 |
| (t,j)::tl -> (t,f j)::(map_snd f tl) |
|
154 |
| [] -> [] |
|
139 |
match l with (t, j) :: tl -> (t, f j) :: map_snd f tl | [] -> [] |
|
155 | 140 |
|
156 | 141 |
let rec map_all json f = |
157 | 142 |
match json with |
158 |
| `Assoc ((t,j)::tl) -> |
|
159 |
`Assoc ((t,(map_all (f j) f))::(map_pairlist map_all tl f)) |
|
160 |
| `List (hd::tl) -> |
|
161 |
`List ((map_all (f hd) f)::(map_list map_all tl f)) |
|
162 |
| x -> x |
|
143 |
| `Assoc ((t, j) :: tl) -> |
|
144 |
`Assoc ((t, map_all (f j) f) :: map_pairlist map_all tl f) |
|
145 |
| `List (hd :: tl) -> |
|
146 |
`List (map_all (f hd) f :: map_list map_all tl f) |
|
147 |
| x -> |
|
148 |
x |
|
163 | 149 |
|
164 | 150 |
let numeric_literal_simpl json = |
165 | 151 |
match json with |
166 |
| `Assoc (("NUMERIC_LITERAL", `Assoc (("TOKEN", `Assoc (("text", `String(x))::[]))::[]))::[]) -> `String (x) |
|
167 |
| x -> x |
|
152 |
| `Assoc |
|
153 |
[ |
|
154 |
("NUMERIC_LITERAL", `Assoc [ ("TOKEN", `Assoc [ ("text", `String x) ]) ]); |
|
155 |
] -> |
|
156 |
`String x |
|
157 |
| x -> |
|
158 |
x |
|
168 | 159 |
|
169 |
let flatten_numeric_literal json = |
|
170 |
map_all json (numeric_literal_simpl) |
|
160 |
let flatten_numeric_literal json = map_all json numeric_literal_simpl |
|
171 | 161 |
|
172 |
let to_list_str str json = |
|
173 |
map_all json (assoc_elem_as_list str) |
|
162 |
let to_list_str str json = map_all json (assoc_elem_as_list str) |
|
174 | 163 |
|
175 | 164 |
let rec to_list_content_str str json = |
176 | 165 |
match json with |
177 |
| `Assoc (l) -> if (pairlist_contains_str str l) then |
|
178 |
`Assoc ( |
|
179 |
(str, to_list_content_str str (`List (assoc_elem_filter_snd l str))) |
|
180 |
::(assoc_elem_filternot (map_snd (to_list_content_str str) l) str) |
|
181 |
) |
|
182 |
else |
|
183 |
`Assoc (map_snd (to_list_content_str str) l) |
|
184 |
| `List (hd::tl) -> `List ((to_list_content_str str hd)::(List.map (to_list_content_str str) tl)) |
|
185 |
| x -> x |
|
166 |
| `Assoc l -> |
|
167 |
if pairlist_contains_str str l then |
|
168 |
`Assoc |
|
169 |
((str, to_list_content_str str (`List (assoc_elem_filter_snd l str))) |
|
170 |
:: assoc_elem_filternot (map_snd (to_list_content_str str) l) str) |
|
171 |
else `Assoc (map_snd (to_list_content_str str) l) |
|
172 |
| `List (hd :: tl) -> |
|
173 |
`List (to_list_content_str str hd :: List.map (to_list_content_str str) tl) |
|
174 |
| x -> |
|
175 |
x |
|
186 | 176 |
|
187 | 177 |
let rec prune_null_assoc json = |
188 | 178 |
match json with |
189 |
| `Assoc ((_, `Assoc([]))::tl) -> prune_null_assoc (`Assoc tl) |
|
190 |
| `Assoc ((_, `Null)::tl) -> prune_null_assoc (`Assoc tl) |
|
191 |
| `Assoc ((t, j)::tl) -> `Assoc ((t, (prune_null_assoc j))::(map_snd prune_null_assoc tl)) |
|
192 |
| `List (`Null::[]) -> `Null |
|
193 |
| `List (l) -> `List (List.map prune_null_assoc l) |
|
194 |
| x -> x |
|
195 |
|
|
196 |
(* |
|
197 |
Value printers |
|
198 |
*) |
|
179 |
| `Assoc ((_, `Assoc []) :: tl) -> |
|
180 |
prune_null_assoc (`Assoc tl) |
|
181 |
| `Assoc ((_, `Null) :: tl) -> |
|
182 |
prune_null_assoc (`Assoc tl) |
|
183 |
| `Assoc ((t, j) :: tl) -> |
|
184 |
`Assoc ((t, prune_null_assoc j) :: map_snd prune_null_assoc tl) |
|
185 |
| `List [ `Null ] -> |
|
186 |
`Null |
|
187 |
| `List l -> |
|
188 |
`List (List.map prune_null_assoc l) |
|
189 |
| x -> |
|
190 |
x |
|
191 |
|
|
192 |
(* Value printers *) |
|
199 | 193 |
let rec print_depth json depth indent = |
200 |
if (depth > 0) then
|
|
194 |
if depth > 0 then
|
|
201 | 195 |
match json with |
202 |
| `Assoc ((t,j)::tl) -> |
|
203 |
(indent^t)::(List.append (print_depth j (depth-1) (indent^" ")) |
|
204 |
(print_depth (`Assoc (tl)) depth indent)) |
|
205 |
| `List (hd::tl) -> |
|
206 |
List.append (print_depth hd depth indent) |
|
207 |
(print_depth (`List (tl)) depth indent) |
|
208 |
| `String (s) -> (indent^s)::[] |
|
209 |
| _ -> [] |
|
210 |
else |
|
211 |
[] |
|
196 |
| `Assoc ((t, j) :: tl) -> |
|
197 |
(indent ^ t) |
|
198 |
:: |
|
199 |
List.append |
|
200 |
(print_depth j (depth - 1) (indent ^ " ")) |
|
201 |
(print_depth (`Assoc tl) depth indent) |
|
202 |
| `List (hd :: tl) -> |
|
203 |
List.append |
|
204 |
(print_depth hd depth indent) |
|
205 |
(print_depth (`List tl) depth indent) |
|
206 |
| `String s -> |
|
207 |
[ indent ^ s ] |
|
208 |
| _ -> |
|
209 |
[] |
|
210 |
else [] |
|
212 | 211 |
|
213 | 212 |
let rec flatten_ivd json = |
214 | 213 |
match json with |
215 |
| `Assoc ((t, `List (l))::[]) -> if (String.equal t "INTERFACE_VARIABLE_DECLARATION") then |
|
216 |
`List (List.map flatten_ivd l) else `Assoc ((t, flatten_ivd (`List(l)))::[]) |
|
217 |
| `Assoc (l) -> `Assoc (map_snd flatten_ivd l) |
|
218 |
| `List (hd::tl) -> `List((flatten_ivd hd)::(List.map flatten_ivd tl)) |
|
219 |
| x -> x |
|
220 |
|
|
221 |
(* |
|
222 |
let do_stuff json = |
|
223 |
match json with |
|
224 |
| `Assoc ((t,j)::tl) -> |
|
225 |
| `List (hd::tl) -> |
|
226 |
| `String (s) -> |
|
227 |
| _ -> x |
|
228 |
*) |
|
214 |
| `Assoc [ (t, `List l) ] -> |
|
215 |
if String.equal t "INTERFACE_VARIABLE_DECLARATION" then |
|
216 |
`List (List.map flatten_ivd l) |
|
217 |
else `Assoc [ t, flatten_ivd (`List l) ] |
|
218 |
| `Assoc l -> |
|
219 |
`Assoc (map_snd flatten_ivd l) |
|
220 |
| `List (hd :: tl) -> |
|
221 |
`List (flatten_ivd hd :: List.map flatten_ivd tl) |
|
222 |
| x -> |
|
223 |
x |
|
224 |
|
|
225 |
(* let do_stuff json = match json with | `Assoc ((t,j)::tl) -> | `List (hd::tl) |
|
226 |
-> | `String (s) -> | _ -> x *) |
Also available in: Unified diff
reformatting