Revision ca7ff3f7
Added by Lélio Brun 8 months 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