Project

General

Profile

Download (6.21 KB) Statistics
| Branch: | Tag: | Revision:
1
open Yojson.Safe.Util
2

    
3
let rec assoc_map_except_str l f str =
4
  match l with
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
    []
10

    
11
let rec map_2_args f l arg1 =
12
  match l with hd :: tl -> f arg1 hd :: map_2_args f tl arg1 | [] -> []
13

    
14
(* Remove `Assoc nodes with tag 'str' in json j *)
15
let rec prune_str str json =
16
  match json with
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
26

    
27
(*******************)
28

    
29
let rec name_pair_list_to_string l =
30
  match l with
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
    []
36

    
37
let assoc_filter_string l =
38
  match l with `Assoc x -> name_pair_list_to_string x | _ -> []
39

    
40
(********************)
41

    
42
let rec pairlist_remove str l f =
43
  match l with
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
    []
49

    
50
(******************)
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
    []
80

    
81
let assoc_elem_filternot_snd pair_list str =
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
    []
96

    
97
let all_members str json =
98
  match json with `Assoc l -> assoc_elem_filter_snd l str | _ -> []
99

    
100
let retain_other_members str json =
101
  match json with `Assoc l -> `Assoc (assoc_elem_filter l str) | _ -> `Null
102

    
103
(* DESIGN_UNIT as lists *)
104
let vhdl_json_designunits_content_as_list json =
105
  let designunits_contents =
106
    json |> member "DESIGN_FILE" |> all_members "DESIGN_UNIT"
107
  in
108
  `List designunits_contents
109

    
110
let vhdl_json_designfile_content_excluding json =
111
  json |> member "DESIGN_FILE" |> retain_other_members "DESIGN_UNIT"
112

    
113
let vhdl_json_list_designunits json =
114
  let designunits_list = vhdl_json_designunits_content_as_list json in
115
  `Assoc [ "DESIGN_FILE", `Assoc [ "DESIGN_UNIT", designunits_list ] ]
116

    
117
let rec pairlist_contains_str str l =
118
  match l with
119
  | (t, _) :: tl ->
120
    if String.equal t str then true else pairlist_contains_str str tl
121
  | [] ->
122
    false
123

    
124
(* ITEM element content as list *)
125
let assoc_elem_as_list str json =
126
  match json with `Assoc l -> `Assoc (pairlist_snd_as_list l str) | x -> x
127

    
128
let rec map_list map_f l f =
129
  match l with hd :: tl -> map_f (f hd) f :: map_list map_f tl f | [] -> []
130

    
131
let rec map_pairlist map_f l f =
132
  match l with
133
  | (t, j) :: tl ->
134
    (t, map_f (f j) f) :: map_pairlist map_f tl f
135
  | [] ->
136
    []
137

    
138
let rec map_snd f l =
139
  match l with (t, j) :: tl -> (t, f j) :: map_snd f tl | [] -> []
140

    
141
let rec map_all json f =
142
  match json with
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
149

    
150
let numeric_literal_simpl json =
151
  match json with
152
  | `Assoc
153
      [
154
        ("NUMERIC_LITERAL", `Assoc [ ("TOKEN", `Assoc [ ("text", `String x) ]) ]);
155
      ] ->
156
    `String x
157
  | x ->
158
    x
159

    
160
let flatten_numeric_literal json = map_all json numeric_literal_simpl
161

    
162
let to_list_str str json = map_all json (assoc_elem_as_list str)
163

    
164
let rec to_list_content_str str json =
165
  match json with
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
176

    
177
let rec prune_null_assoc json =
178
  match json with
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 *)
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)
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 []
211

    
212
let rec flatten_ivd json =
213
  match json with
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 *)
(3-3/3)