Project

General

Profile

« Previous | Next » 

Revision ca7ff3f7

Added by LĂ©lio Brun 8 months ago

reformatting

View differences:

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