Revision 248eb65e src/backends/VHDL/vhdl_ast_deriving.ml
src/backends/VHDL/vhdl_ast_deriving.ml  

75  75 
 Base of string 
76  76 
 Range of string option * int * int 
77  77 
 Bit_vector of int * int 
78 
 Array of int * int * vhdl_type_t 

79 
 Enumerated of string list 

78 
 Array of 

79 
{ 

80 
indexes: vhdl_name_t list ; 

81 
const: vhdl_constraint_t option [@default None]; 

82 
definition: vhdl_subtype_indication_t } [@name "ARRAY_TYPE_DEFINITION"] 

83 
 Record of vhdl_element_declaration_t list 

84 
[@name "RECORD_TYPE_DEFINITION"] 

85 
 Enumerated of vhdl_name_t list [@name "ENUMERATION_TYPE_DEFINITION"] 

80  86 
 Void 
87 
and vhdl_element_declaration_t = 

88 
{ 

89 
names: vhdl_name_t list ; 

90 
definition: vhdl_subtype_indication_t } 

81  91 
and vhdl_subtype_indication_t = 
82  92 
{ 
83  93 
name: vhdl_name_t [@default NoName]; 
...  ...  
175  185  
176  186 
let rec pp_vhdl_type_t : 
177  187 
Format.formatter > vhdl_type_t > Ppx_deriving_runtime.unit = 
178 
let __0 () = pp_vhdl_type_t in 

188 
let __4 () = pp_vhdl_name_t 

189 


190 
and __3 () = pp_vhdl_element_declaration_t 

191 


192 
and __2 () = pp_vhdl_subtype_indication_t 

193 


194 
and __1 () = pp_vhdl_constraint_t 

195 


196 
and __0 () = pp_vhdl_name_t 

197 
in 

179  198 
((let open! Ppx_deriving_runtime in 
180  199 
fun fmt > 
181  200 
function 
...  ...  
192  211 
(Format.fprintf fmt "%d") a2); 
193  212 
 Bit_vector (a0,a1) > 
194  213 
(Format.fprintf fmt "array (%d,%d) of bit") a0 a1; 
195 
 Array (a0,a1,a2) > 

196 
(Format.fprintf fmt "array "; 

197 
(Format.fprintf fmt "(%d,%d)") a0 a1; 

198 
Format.fprintf fmt " of "; 

199 
((__0 ()) fmt) a2) 

214 
 Array 

215 
{ indexes = aindexes; const = aconst; definition = adefinition } 

216 
> 

217 
Format.fprintf fmt "array"; 

218 
(match aindexes with 

219 
 [] > Format.fprintf fmt ""; 

220 
 _ > 

221 
((fun x > 

222 
ignore 

223 
(List.fold_left 

224 
(fun sep > 

225 
fun x > 

226 
if sep then Format.fprintf fmt ",@ "; 

227 
((__0 ()) fmt) x; 

228 
true) false x)) aindexes)); 

229 
(function 

230 
 None > Format.pp_print_string fmt "" 

231 
 Some x > 

232 
((__1 ()) fmt) x) aconst; 

233 
Format.fprintf fmt " of "; 

234 
((__2 ()) fmt) adefinition; 

235 
 Record a0 > 

236 
Format.fprintf fmt "@[<v 2>record@;"; 

237 
(fun x > 

238 
ignore 

239 
(List.fold_left 

240 
(fun sep > 

241 
fun x > 

242 
if sep then Format.fprintf fmt ";@;"; 

243 
((__3 ()) fmt) x; 

244 
true) false x); 

245 
Format.fprintf fmt "@]@;end record") a0; 

200  246 
 Enumerated a0 > 
201 
((fun x > 

202 
ignore 

203 
(List.fold_left 

204 
(fun sep > 

205 
fun x > 

206 
if sep then Format.fprintf fmt ",@ "; 

207 
(Format.fprintf fmt "%s") x; 

208 
true) false x))) a0; 

247 
(Format.fprintf fmt "("; 

248 
((fun x > 

249 
ignore 

250 
(List.fold_left 

251 
(fun sep > 

252 
fun x > 

253 
if sep then Format.fprintf fmt ",@ "; 

254 
((__4 ()) fmt) x; 

255 
true) false x))) a0; 

256 
Format.fprintf fmt ")"); 

209  257 
 Void > Format.pp_print_string fmt "") 
210  258 
[@ocaml.warning "A"]) 
211  259  
212  260 
and show_vhdl_type_t : vhdl_type_t > Ppx_deriving_runtime.string = 
213  261 
fun x > Format.asprintf "%a" pp_vhdl_type_t x 
214  262  
263 
and pp_vhdl_element_declaration_t : 

264 
Format.formatter > vhdl_element_declaration_t > Ppx_deriving_runtime.unit 

265 
= 

266 
let __1 () = pp_vhdl_subtype_indication_t 

267 


268 
and __0 () = pp_vhdl_name_t 

269 
in 

270 
((let open! Ppx_deriving_runtime in 

271 
fun fmt > 

272 
fun x > 

273 
(fun x > 

274 
ignore 

275 
(List.fold_left 

276 
(fun sep > 

277 
fun x > 

278 
if sep then Format.fprintf fmt ",@ "; 

279 
((__0 ()) fmt) x; 

280 
true) false x)) x.names; 

281 
Format.fprintf fmt ":@ "; 

282 
((__1 ()) fmt) x.definition) 

283 
[@ocaml.warning "A"]) 

284  
285 
and show_vhdl_element_declaration_t : 

286 
vhdl_element_declaration_t > Ppx_deriving_runtime.string = 

287 
fun x > Format.asprintf "%a" pp_vhdl_element_declaration_t x 

288  
215  289 
and pp_vhdl_subtype_indication_t : 
216  290 
Format.formatter > vhdl_subtype_indication_t > Ppx_deriving_runtime.unit 
217  291 
= 
...  ...  
738  812 
[`String "Bit_vector"; 
739  813 
((fun (x : Ppx_deriving_runtime.int) > `Int x)) arg0; 
740  814 
((fun (x : Ppx_deriving_runtime.int) > `Int x)) arg1] 
741 
 Array (arg0,arg1,arg2) >


815 
 Array arg0 >


742  816 
`List 
743 
[`String "Array"; 

744 
((fun (x : Ppx_deriving_runtime.int) > `Int x)) arg0; 

745 
((fun (x : Ppx_deriving_runtime.int) > `Int x)) arg1; 

746 
((fun x > vhdl_type_t_to_yojson x)) arg2] 

747 
 Enumerated arg0 > 

817 
[`String "ARRAY_TYPE_DEFINITION"; 

818 
(let fields = [] in 

819 
let fields = 

820 
("definition", 

821 
((fun x > vhdl_subtype_indication_t_to_yojson x) 

822 
arg0.definition)) 

823 
:: fields in 

824 
let fields = 

825 
if arg0.const = None 

826 
then fields 

827 
else 

828 
("const", 

829 
(((function 

830 
 None > `Null 

831 
 Some x > 

832 
((fun x > vhdl_constraint_t_to_yojson x)) x)) 

833 
arg0.const)) 

834 
:: fields 

835 
in 

836 
let fields = 

837 
("indexes", 

838 
((fun x > 

839 
`List (List.map (fun x > vhdl_name_t_to_yojson x) x)) 

840 
arg0.indexes)) 

841 
:: fields in 

842 
`Assoc fields)] 

843 
 Record arg0 > 

748  844 
`List 
749 
[`String "Enumerated";


845 
[`String "RECORD_TYPE_DEFINITION";


750  846 
((fun x > 
751  847 
`List 
752  848 
(List.map 
753 
(fun (x : Ppx_deriving_runtime.string) > `String x) x)))


849 
(fun x > vhdl_element_declaration_t_to_yojson x) x)))


754  850 
arg0] 
851 
 Enumerated arg0 > 

852 
`List 

853 
[`String "ENUMERATION_TYPE_DEFINITION"; 

854 
((fun x > 

855 
`List (List.map (fun x > vhdl_name_t_to_yojson x) x))) arg0] 

755  856 
 Void > `List [`String "Void"]) 
756  857 
[@ocaml.warning "A"]) 
757  858  
...  ...  
792  893 
 `Int x > Result.Ok x 
793  894 
 _ > Result.Error "Vhdl_ast.vhdl_type_t") arg0) >>= 
794  895 
(fun arg0 > Result.Ok (Bit_vector (arg0, arg1))))) 
795 
 `List ((`String "Array")::arg0::arg1::arg2::[]) > 

796 
((fun x > vhdl_type_t_of_yojson x) arg2) >>= 

797 
((fun arg2 > 

798 
((function 

799 
 `Int x > Result.Ok x 

800 
 _ > Result.Error "Vhdl_ast.vhdl_type_t") arg1) >>= 

801 
(fun arg1 > 

802 
((function 

803 
 `Int x > Result.Ok x 

804 
 _ > Result.Error "Vhdl_ast.vhdl_type_t") arg0) >>= 

805 
(fun arg0 > Result.Ok (Array (arg0, arg1, arg2)))))) 

806 
 `List ((`String "Enumerated")::arg0::[]) > 

896 
 `List ((`String "ARRAY_TYPE_DEFINITION")::arg0::[]) > 

897 
((function 

898 
 `Assoc xs > 

899 
let rec loop xs ((arg0,arg1,arg2) as _state) = 

900 
match xs with 

901 
 ("indexes",x)::xs > 

902 
loop xs 

903 
(((function 

904 
 `List xs > 

905 
map_bind (fun x > vhdl_name_t_of_yojson x) 

906 
[] xs 

907 
 _ > Result.Error "Vhdl_ast.vhdl_type_t.indexes") 

908 
x), arg1, arg2) 

909 
 ("const",x)::xs > 

910 
loop xs 

911 
(arg0, 

912 
((function 

913 
 `Null > Result.Ok None 

914 
 x > 

915 
((fun x > vhdl_constraint_t_of_yojson x) x) 

916 
>>= ((fun x > Result.Ok (Some x)))) x), 

917 
arg2) 

918 
 ("definition",x)::xs > 

919 
loop xs 

920 
(arg0, arg1, 

921 
((fun x > vhdl_subtype_indication_t_of_yojson x) 

922 
x)) 

923 
 [] > 

924 
arg2 >>= 

925 
((fun arg2 > 

926 
arg1 >>= 

927 
(fun arg1 > 

928 
arg0 >>= 

929 
(fun arg0 > 

930 
Result.Ok 

931 
(Array 

932 
{ 

933 
indexes = arg0; 

934 
const = arg1; 

935 
definition = arg2 

936 
}))))) 

937 
 _::xs > loop xs _state in 

938 
loop xs 

939 
((Result.Error "Vhdl_ast.vhdl_type_t.indexes"), 

940 
(Result.Ok None), 

941 
(Result.Error "Vhdl_ast.vhdl_type_t.definition")) 

942 
 _ > Result.Error "Vhdl_ast.vhdl_type_t")) arg0 

943 
 `List ((`String "RECORD_TYPE_DEFINITION")::arg0::[]) > 

807  944 
((function 
808  945 
 `List xs > 
809 
map_bind 

810 
(function 

811 
 `String x > Result.Ok x 

812 
 _ > Result.Error "Vhdl_ast.vhdl_type_t") [] xs 

946 
map_bind (fun x > vhdl_element_declaration_t_of_yojson x) 

947 
[] xs 

948 
 _ > Result.Error "Vhdl_ast.vhdl_type_t") arg0) >>= 

949 
((fun arg0 > Result.Ok (Record arg0))) 

950 
 `List ((`String "ENUMERATION_TYPE_DEFINITION")::arg0::[]) > 

951 
((function 

952 
 `List xs > map_bind (fun x > vhdl_name_t_of_yojson x) [] xs 

813  953 
 _ > Result.Error "Vhdl_ast.vhdl_type_t") arg0) >>= 
814  954 
((fun arg0 > Result.Ok (Enumerated arg0))) 
815  955 
 `List ((`String "Void")::[]) > Result.Ok Void 
816  956 
 _ > Result.Error "Vhdl_ast.vhdl_type_t") 
817  957 
[@ocaml.warning "A"]) 
818  958  
959 
and (vhdl_element_declaration_t_to_yojson : 

960 
vhdl_element_declaration_t > Yojson.Safe.json) 

961 
= 

962 
((let open! Ppx_deriving_yojson_runtime in 

963 
fun x > 

964 
let fields = [] in 

965 
let fields = 

966 
("definition", 

967 
((fun x > vhdl_subtype_indication_t_to_yojson x) x.definition)) 

968 
:: fields in 

969 
let fields = 

970 
("names", 

971 
((fun x > 

972 
`List (List.map (fun x > vhdl_name_t_to_yojson x) x)) 

973 
x.names)) 

974 
:: fields in 

975 
`Assoc fields) 

976 
[@ocaml.warning "A"]) 

977  
978 
and (vhdl_element_declaration_t_of_yojson : 

979 
Yojson.Safe.json > 

980 
vhdl_element_declaration_t Ppx_deriving_yojson_runtime.error_or) 

981 
= 

982 
((let open! Ppx_deriving_yojson_runtime in 

983 
function 

984 
 `Assoc xs > 

985 
let rec loop xs ((arg0,arg1) as _state) = 

986 
match xs with 

987 
 ("names",x)::xs > 

988 
loop xs 

989 
(((function 

990 
 `List xs > 

991 
map_bind (fun x > vhdl_name_t_of_yojson x) [] xs 

992 
 _ > 

993 
Result.Error 

994 
"Vhdl_ast.vhdl_element_declaration_t.names") x), 

995 
arg1) 

996 
 ("definition",x)::xs > 

997 
loop xs 

998 
(arg0, 

999 
((fun x > vhdl_subtype_indication_t_of_yojson x) x)) 

1000 
 [] > 

1001 
arg1 >>= 

1002 
((fun arg1 > 

1003 
arg0 >>= 

1004 
(fun arg0 > 

1005 
Result.Ok { names = arg0; definition = arg1 }))) 

1006 
 _::xs > loop xs _state in 

1007 
loop xs 

1008 
((Result.Error "Vhdl_ast.vhdl_element_declaration_t.names"), 

1009 
(Result.Error "Vhdl_ast.vhdl_element_declaration_t.definition")) 

1010 
 _ > Result.Error "Vhdl_ast.vhdl_element_declaration_t") 

1011 
[@ocaml.warning "A"]) 

1012  
819  1013 
and (vhdl_subtype_indication_t_to_yojson : 
820  1014 
vhdl_subtype_indication_t > Yojson.Safe.json) 
821  1015 
= 
...  ...  
5484  5678 
type vhdl_package_t = 
5485  5679 
{ 
5486  5680 
name: vhdl_name_t [@default NoName]; 
5487 
shared_defs: vhdl_definition_t list [@default []]} 

5681 
shared_defs: vhdl_definition_t list [@default []]; 

5682 
shared_decls: vhdl_declaration_t list [@default []]} 

5488  5683  
5489  5684 
let rec pp_vhdl_package_t : 
5490  5685 
Format.formatter > vhdl_package_t > Ppx_deriving_runtime.unit = 
5491 
let __1 () = pp_vhdl_definition_t 

5686 
let __2 () = pp_vhdl_declaration_t 

5687  
5688 
and __1 () = pp_vhdl_definition_t 

5492  5689 

5493  5690 
and __0 () = pp_vhdl_name_t 
5494  5691 
in 
...  ...  
5505  5702 
if sep then Format.fprintf fmt ""; 
5506  5703 
((__1 ()) fmt) x; 
5507  5704 
Format.fprintf fmt ";"; 
5508 
true) false x))) x.shared_defs;) 

5705 
true) false x))) x.shared_defs; 

5706 
((fun x > 

5707 
ignore 

5708 
(List.fold_left 

5709 
(fun sep > 

5710 
fun x > 

5711 
if sep then Format.fprintf fmt ""; 

5712 
((__2 ()) fmt) x; 

5713 
true) false x))) x.shared_decls;) 

5509  5714 
[@ocaml.warning "A"]) 
5510  5715  
5511  5716 
and show_vhdl_package_t : vhdl_package_t > Ppx_deriving_runtime.string = 
...  ...  
5516  5721 
fun x > 
5517  5722 
let fields = [] in 
5518  5723 
let fields = 
5724 
if x.shared_decls = [] 

5725 
then fields 

5726 
else 

5727 
("shared_decls", 

5728 
(((fun x > 

5729 
`List 

5730 
(List.map (fun x > vhdl_declaration_t_to_yojson x) x))) 

5731 
x.shared_decls)) 

5732 
:: fields 

5733 
in 

5734 
let fields = 

5519  5735 
if x.shared_defs = [] 
5520  5736 
then fields 
5521  5737 
else 
...  ...  
5541  5757 
((let open! Ppx_deriving_yojson_runtime in 
5542  5758 
function 
5543  5759 
 `Assoc xs > 
5544 
let rec loop xs ((arg0,arg1) as _state) = 

5760 
let rec loop xs ((arg0,arg1,arg2) as _state) =


5545  5761 
match xs with 
5546  5762 
 ("name",x)::xs > 
5547 
loop xs (((fun x > vhdl_name_t_of_yojson x) x), arg1) 

5763 
loop xs (((fun x > vhdl_name_t_of_yojson x) x), arg1, arg2)


5548  5764 
 ("shared_defs",x)::xs > 
5549  5765 
loop xs 
5550  5766 
(arg0, 
...  ...  
5554  5770 
[] xs 
5555  5771 
 _ > 
5556  5772 
Result.Error "Vhdl_ast.vhdl_package_t.shared_defs") 
5773 
x), arg2) 

5774 
 ("shared_decls",x)::xs > 

5775 
loop xs 

5776 
(arg0, arg1, 

5777 
((function 

5778 
 `List xs > 

5779 
map_bind (fun x > vhdl_declaration_t_of_yojson x) 

5780 
[] xs 

5781 
 _ > 

5782 
Result.Error "Vhdl_ast.vhdl_package_t.shared_decls") 

5557  5783 
x)) 
5558  5784 
 [] > 
5559 
arg1 >>= 

5560 
((fun arg1 > 

5561 
arg0 >>= 

5562 
(fun arg0 > 

5563 
Result.Ok { name = arg0; shared_defs = arg1 }))) 

5785 
arg2 >>= 

5786 
((fun arg2 > 

5787 
arg1 >>= 

5788 
(fun arg1 > 

5789 
arg0 >>= 

5790 
(fun arg0 > 

5791 
Result.Ok 

5792 
{ 

5793 
name = arg0; 

5794 
shared_defs = arg1; 

5795 
shared_decls = arg2 

5796 
})))) 

5564  5797 
 _::xs > loop xs _state in 
5565 
loop xs ((Result.Ok NoName), (Result.Ok [])) 

5798 
loop xs ((Result.Ok NoName), (Result.Ok []), (Result.Ok []))


5566  5799 
 _ > Result.Error "Vhdl_ast.vhdl_package_t") 
5567  5800 
[@ocaml.warning "A"]) 
5568  5801 
Also available in: Unified diff