Project

General

Profile

Revision 3bc26d43 src/backends/VHDL/vhdl_ast_deriving.ml

View differences:

src/backends/VHDL/vhdl_ast_deriving.ml
267 267
  vhdl_discrete_range_t -> Ppx_deriving_runtime.string =
268 268
  fun x  -> Format.asprintf "%a" pp_vhdl_discrete_range_t x
269 269

  
270
(* Requires adaptation for: ArrayConstraint, RecordConstraint *)
270
(* TODO Adapt for: ArrayConstraint, RecordConstraint *)
271 271
and pp_vhdl_constraint_t :
272 272
  Format.formatter -> vhdl_constraint_t -> Ppx_deriving_runtime.unit =
273 273
  let __4 () = pp_vhdl_constraint_t
......
328 328
and show_vhdl_constraint_t : vhdl_constraint_t -> Ppx_deriving_runtime.string
329 329
  = fun x  -> Format.asprintf "%a" pp_vhdl_constraint_t x
330 330

  
331
(* TODO Adapt for Type *)
331 332
and pp_vhdl_definition_t :
332 333
  Format.formatter -> vhdl_definition_t -> Ppx_deriving_runtime.unit =
333 334
  let __3 () = pp_vhdl_subtype_indication_t
......
342 343
      fun fmt  ->
343 344
        function
344 345
        | Type { name = aname; definition = adefinition } ->
345
            Format.fprintf fmt "@[<2>type ";
346
            Format.fprintf fmt "type ";
346 347
            ((__0 ()) fmt) aname;
347 348
            Format.fprintf fmt " is ";
348 349
            ((__1 ()) fmt) adefinition;
349
            Format.fprintf fmt "@]}";
350 350
        | Subtype { name = aname; typ = atyp } ->
351
            Format.fprintf fmt "@[<2>subtype ";
351
            Format.fprintf fmt "subtype ";
352 352
            ((__2 ()) fmt) aname;
353 353
            Format.fprintf fmt " is ";
354 354
            ((__3 ()) fmt) atyp;
355
            Format.fprintf fmt "@]";
356 355
   )
357 356
    [@ocaml.warning "-A"])
358 357

  
......
2647 2646
  when_cond: vhdl_expr_t list ;
2648 2647
  when_stmt: vhdl_sequential_stmt_t list }
2649 2648

  
2649
(* Needs adaptation for: Assert *)
2650 2650
let rec pp_vhdl_sequential_stmt_t :
2651 2651
  Format.formatter -> vhdl_sequential_stmt_t -> Ppx_deriving_runtime.unit =
2652 2652
  let __19 () = pp_vhdl_name_t
......
2872 2872
and show_vhdl_if_case_t : vhdl_if_case_t -> Ppx_deriving_runtime.string =
2873 2873
  fun x  -> Format.asprintf "%a" pp_vhdl_if_case_t x
2874 2874

  
2875
(* Adapted *)
2875 2876
and pp_vhdl_case_item_t :
2876 2877
  Format.formatter -> vhdl_case_item_t -> Ppx_deriving_runtime.unit =
2877 2878
  let __1 () = pp_vhdl_sequential_stmt_t
......
3574 3575
      fun fmt  ->
3575 3576
        function
3576 3577
        | VarDecl { names = anames; typ = atyp; init_val = ainit_val } ->
3577
            (Format.fprintf fmt "@[<2>variable@ ";
3578
            (Format.fprintf fmt "variable ";
3578 3579
             ((((fun x  ->
3579 3580
                    ignore
3580 3581
                      (List.fold_left
......
3583 3584
                              if sep then Format.fprintf fmt ",";
3584 3585
                              ((__0 ()) fmt) x;
3585 3586
                              true) false x);)) anames;
3586
               Format.fprintf fmt "@ :@ ";
3587
               Format.fprintf fmt " : ";
3587 3588
               ((__1 ()) fmt) atyp;
3588 3589
              ((function
3589 3590
                | None  -> Format.pp_print_string fmt ""
3590 3591
                | Some x ->
3591 3592
                    (Format.fprintf fmt ":=";
3592
                     ((__2 ()) fmt) x;))) ainit_val;
3593
              Format.fprintf fmt "@]");
3593
                     ((__2 ()) fmt) x;))) ainit_val);
3594 3594
            ))
3595 3595
        | CstDecl { names = anames; typ = atyp; init_val = ainit_val } ->
3596
            (Format.fprintf fmt "@[<2>constant@ ";
3596
            (Format.fprintf fmt "constant ";
3597 3597
             ((((fun x  ->
3598 3598
                    ignore
3599 3599
                      (List.fold_left
......
3602 3602
                              if sep then Format.fprintf fmt ",";
3603 3603
                              ((__3 ()) fmt) x;
3604 3604
                              true) false x);)) anames;
3605
               Format.fprintf fmt "@ :@ ";
3605
               Format.fprintf fmt " : ";
3606 3606
               ((__4 ()) fmt) atyp;
3607 3607
              Format.fprintf fmt ":=";
3608
              ((__5 ()) fmt) ainit_val;
3609
              Format.fprintf fmt "@]");
3610
             ))
3608
              ((__5 ()) fmt) ainit_val)))
3611 3609
        | SigDecl { names = anames; typ = atyp; init_val = ainit_val } ->
3612
            (Format.fprintf fmt "@[<2>signal@ ";
3610
            (Format.fprintf fmt "signal ";
3613 3611
            ((fun x  ->
3614 3612
              ignore
3615 3613
              (List.fold_left
......
3619 3617
                                ((__6 ()) fmt) x;
3620 3618
                                true) false x);
3621 3619
              )) anames;
3622
            Format.fprintf fmt "@ :@ ";
3620
            Format.fprintf fmt " : ";
3623 3621
            ((__7 ()) fmt) atyp;
3624 3622
            (function
3625 3623
              | None  -> Format.pp_print_string fmt ""
3626 3624
              | Some x ->
3627 3625
                  (Format.fprintf fmt ":=";
3628 3626
                  ((__8 ()) fmt) x;)
3629
            ) ainit_val;
3630
            Format.fprintf fmt "@]";
3631
            )
3627
            ) ainit_val)
3632 3628
        | Subprogram
3633 3629
            { name = aname; kind = akind; spec = aspec;
3634 3630
              decl_part = adecl_part; stmts = astmts }
......
4049 4045
  expr: vhdl_expr_t list ;
4050 4046
  cond: vhdl_expr_t [@default IsNull]}
4051 4047

  
4048
(* Adapted *)
4052 4049
let rec pp_vhdl_signal_condition_t :
4053 4050
  Format.formatter -> vhdl_signal_condition_t -> Ppx_deriving_runtime.unit =
4054 4051
  let __1 () = pp_vhdl_expr_t
......
4058 4055
  ((let open! Ppx_deriving_runtime in
4059 4056
      fun fmt  ->
4060 4057
        fun x  ->
4061
          Format.fprintf fmt "@[<2>{ ";
4062
          ((Format.fprintf fmt "@[%s =@ " "expr";
4063
            ((fun x  ->
4064
                Format.fprintf fmt "@[<2>[";
4065
                ignore
4066
                  (List.fold_left
4067
                     (fun sep  ->
4068
                        fun x  ->
4069
                          if sep then Format.fprintf fmt ";@ ";
4070
                          ((__0 ()) fmt) x;
4071
                          true) false x);
4072
                Format.fprintf fmt "@,]@]")) x.expr;
4073
            Format.fprintf fmt "@]");
4074
           Format.fprintf fmt ";@ ";
4075
           Format.fprintf fmt "@[%s =@ " "cond";
4076
           ((__1 ()) fmt) x.cond;
4077
           Format.fprintf fmt "@]");
4078
          Format.fprintf fmt "@ }@]")
4058
          ((fun x  ->
4059
              ignore
4060
                (List.fold_left
4061
                   (fun sep  ->
4062
                      fun x  ->
4063
                        if sep then Format.fprintf fmt ";@ ";
4064
                        ((__0 ()) fmt) x;
4065
                        true) false x))) x.expr;
4066
          (match x.cond with
4067
          | IsNull -> Format.fprintf fmt "";
4068
          | _ -> Format.fprintf fmt "when ";
4069
                 ((__1 ()) fmt) x.cond);)
4079 4070
    [@ocaml.warning "-A"])
4080 4071

  
4081 4072
and show_vhdl_signal_condition_t :
......
4235 4226
  cond: vhdl_expr_t [@default IsNull];
4236 4227
  delay: vhdl_expr_t [@default IsNull]}
4237 4228

  
4229
(* Adapted *)
4238 4230
let rec pp_vhdl_conditional_signal_t :
4239 4231
  Format.formatter -> vhdl_conditional_signal_t -> Ppx_deriving_runtime.unit
4240 4232
  =
......
4251 4243
  ((let open! Ppx_deriving_runtime in
4252 4244
      fun fmt  ->
4253 4245
        fun x  ->
4254
          Format.fprintf fmt "@[<2>{ ";
4255
          ((((((Format.fprintf fmt "@[%s =@ " "postponed";
4256
                (Format.fprintf fmt "%B") x.postponed;
4257
                Format.fprintf fmt "@]");
4258
               Format.fprintf fmt ";@ ";
4259
               Format.fprintf fmt "@[%s =@ " "label";
4260
               ((__0 ()) fmt) x.label;
4261
               Format.fprintf fmt "@]");
4262
              Format.fprintf fmt ";@ ";
4263
              Format.fprintf fmt "@[%s =@ " "lhs";
4264
              ((__1 ()) fmt) x.lhs;
4265
              Format.fprintf fmt "@]");
4266
             Format.fprintf fmt ";@ ";
4267
             Format.fprintf fmt "@[%s =@ " "rhs";
4268
             ((fun x  ->
4269
                 Format.fprintf fmt "@[<2>[";
4270
                 ignore
4271
                   (List.fold_left
4272
                      (fun sep  ->
4273
                         fun x  ->
4274
                           if sep then Format.fprintf fmt ";@ ";
4275
                           ((__2 ()) fmt) x;
4276
                           true) false x);
4277
                 Format.fprintf fmt "@,]@]")) x.rhs;
4278
             Format.fprintf fmt "@]");
4279
            Format.fprintf fmt ";@ ";
4280
            Format.fprintf fmt "@[%s =@ " "cond";
4281
            ((__3 ()) fmt) x.cond;
4282
            Format.fprintf fmt "@]");
4283
           Format.fprintf fmt ";@ ";
4284
           Format.fprintf fmt "@[%s =@ " "delay";
4285
           ((__4 ()) fmt) x.delay;
4286
           Format.fprintf fmt "@]");
4287
          Format.fprintf fmt "@ }@]")
4288
    [@ocaml.warning "-A"])
4246
          (match x.label with
4247
            | NoName -> Format.fprintf fmt "";
4248
            | _ -> (((__0 ()) fmt) x.label;
4249
                   Format.fprintf fmt ":@ ")
4250
          );
4251
          if (x.postponed) then Format.fprintf fmt "postponed@ ";
4252
          ((__1 ()) fmt) x.lhs;
4253
          Format.fprintf fmt " <= ";
4254
          (match x.delay with
4255
            | IsNull -> Format.fprintf fmt "";
4256
            | _ -> ((__4 ()) fmt) x.delay;
4257
                   Format.fprintf fmt " ");
4258
          ((fun x  ->
4259
             Format.fprintf fmt "@[";
4260
             ignore
4261
               (List.fold_left
4262
                 (fun sep  ->
4263
                   fun x  ->
4264
                     if sep then Format.fprintf fmt "";
4265
                      ((__2 ()) fmt) x;
4266
                      Format.fprintf fmt ";";
4267
                      true) false x);
4268
          Format.fprintf fmt "@]")) x.rhs;
4269
          (match x.cond with
4270
            | IsNull -> Format.fprintf fmt "";
4271
            | _ -> Format.fprintf fmt "when (";
4272
                   ((__3 ()) fmt) x.cond;
4273
                   Format.fprintf fmt ")"))
4274
   [@ocaml.warning "-A"])
4289 4275

  
4290 4276
and show_vhdl_conditional_signal_t :
4291 4277
  vhdl_conditional_signal_t -> Ppx_deriving_runtime.string =
......
4421 4407
  body: vhdl_sequential_stmt_t list
4422 4408
    [@key "PROCESS_STATEMENT_PART"][@default []]}
4423 4409

  
4410
(* Adapted *)
4424 4411
let rec pp_vhdl_process_t :
4425 4412
  Format.formatter -> vhdl_process_t -> Ppx_deriving_runtime.unit =
4426 4413
  let __3 () = pp_vhdl_sequential_stmt_t
......
4434 4421
  ((let open! Ppx_deriving_runtime in
4435 4422
      fun fmt  ->
4436 4423
        fun x  ->
4437
          Format.fprintf fmt "@[<2>{ ";
4438
          ((((Format.fprintf fmt "@[%s =@ " "id";
4439
              ((__0 ()) fmt) x.id;
4440
              Format.fprintf fmt "@]");
4441
             Format.fprintf fmt ";@ ";
4442
             Format.fprintf fmt "@[%s =@ " "declarations";
4443
             ((function
4444
               | None  -> Format.pp_print_string fmt "None"
4445
               | Some x ->
4446
                   (Format.pp_print_string fmt "(Some ";
4447
                    ((fun x  ->
4448
                        Format.fprintf fmt "@[<2>[";
4449
                        ignore
4450
                          (List.fold_left
4451
                             (fun sep  ->
4452
                                fun x  ->
4453
                                  if sep then Format.fprintf fmt ";@ ";
4454
                                  ((__1 ()) fmt) x;
4455
                                  true) false x);
4456
                        Format.fprintf fmt "@,]@]")) x;
4457
                    Format.pp_print_string fmt ")"))) x.declarations;
4458
             Format.fprintf fmt "@]");
4459
            Format.fprintf fmt ";@ ";
4460
            Format.fprintf fmt "@[%s =@ " "active_sigs";
4461
            ((fun x  ->
4462
                Format.fprintf fmt "@[<2>[";
4463
                ignore
4464
                  (List.fold_left
4465
                     (fun sep  ->
4466
                        fun x  ->
4467
                          if sep then Format.fprintf fmt ";@ ";
4468
                          ((__2 ()) fmt) x;
4469
                          true) false x);
4470
                Format.fprintf fmt "@,]@]")) x.active_sigs;
4471
            Format.fprintf fmt "@]");
4472
           Format.fprintf fmt ";@ ";
4473
           Format.fprintf fmt "@[%s =@ " "body";
4474
           ((fun x  ->
4475
               Format.fprintf fmt "@[<2>[";
4424
          Format.fprintf fmt "@[<v>process ";
4425
          (match x.active_sigs with
4426
          | [] -> Format.fprintf fmt "";
4427
          | _ -> Format.fprintf fmt "(";
4428
                 ((fun x  ->
4429
                    ignore
4430
                      (List.fold_left
4431
                         (fun sep  ->
4432
                            fun x  ->
4433
                              if sep then Format.fprintf fmt ",";
4434
                              ((__2 ()) fmt) x;
4435
                              true) false x))) x.active_sigs;
4436
                 Format.fprintf fmt ")");
4437
          ((function
4438
             | None  -> Format.pp_print_string fmt ""
4439
             | Some x ->
4440
                  ((fun x  ->
4441
                      Format.fprintf fmt "@[<2>";
4442
                      ignore
4443
                        (List.fold_left
4444
                           (fun sep  ->
4445
                              fun x  ->
4446
                                if sep then Format.fprintf fmt "@;";
4447
                                ((__1 ()) fmt) x;
4448
                                true) false x);
4449
                      Format.fprintf fmt "@]")) x;)) x.declarations;
4450
          Format.fprintf fmt "@;@[<v 2>begin@;";
4451
          ((fun x  ->
4476 4452
               ignore
4477 4453
                 (List.fold_left
4478 4454
                    (fun sep  ->
4479 4455
                       fun x  ->
4480
                         if sep then Format.fprintf fmt ";@ ";
4456
                         if sep then Format.fprintf fmt "@;";
4481 4457
                         ((__3 ()) fmt) x;
4482
                         true) false x);
4483
               Format.fprintf fmt "@,]@]")) x.body;
4484
           Format.fprintf fmt "@]");
4485
          Format.fprintf fmt "@ }@]")
4458
                         true) false x);)) x.body;
4459
          Format.fprintf fmt "@]@;end process;@;";
4460
          Format.fprintf fmt "@]";)
4486 4461
    [@ocaml.warning "-A"])
4487 4462

  
4488 4463
and show_vhdl_process_t : vhdl_process_t -> Ppx_deriving_runtime.string =
......
5261 5236
  name: vhdl_name_t [@default NoName];
5262 5237
  shared_defs: vhdl_definition_t list [@default []]}
5263 5238

  
5264
(* Adapted -- TODO: indentation of package content is not correct *)
5239
(* Adapted *)
5265 5240
let rec pp_vhdl_package_t :
5266 5241
  Format.formatter -> vhdl_package_t -> Ppx_deriving_runtime.unit =
5267 5242
  let __1 () = pp_vhdl_definition_t
......
5271 5246
  ((let open! Ppx_deriving_runtime in
5272 5247
      fun fmt  ->
5273 5248
        fun x  ->
5274
          ((Format.fprintf fmt "@[";
5275
            ((__0 ()) fmt) x.name;
5276
            Format.fprintf fmt " is@.");
5277
           Format.fprintf fmt "@[<v 2>";
5278
           ((fun x  ->
5279
               Format.fprintf fmt "@[";
5280
               ignore
5281
                 (List.fold_left
5282
                    (fun sep  ->
5283
                       fun x  ->
5284
                         if sep then Format.fprintf fmt ";@ ";
5285
                         ((__1 ()) fmt) x;
5286
                         true) false x);
5287
               Format.fprintf fmt "@,@]")) x.shared_defs;
5288
           Format.fprintf fmt "@]");
5289
          Format.fprintf fmt "@]")
5249
          ((__0 ()) fmt) x.name;
5250
          Format.fprintf fmt " is@;";
5251
          ((fun x  ->
5252
             ignore
5253
               (List.fold_left
5254
                  (fun sep  ->
5255
                     fun x  ->
5256
                       if sep then Format.fprintf fmt "";
5257
                       ((__1 ()) fmt) x;
5258
                       Format.fprintf fmt ";";
5259
                       true) false x))) x.shared_defs;)
5290 5260
    [@ocaml.warning "-A"])
5291 5261

  
5292 5262
and show_vhdl_package_t : vhdl_package_t -> Ppx_deriving_runtime.string =
......
5351 5321
  | Library of vhdl_name_t list [@name "LIBRARY_CLAUSE"][@default []]
5352 5322
  | Use of vhdl_name_t list [@name "USE_CLAUSE"][@default []]
5353 5323

  
5354
(* Adapted *)
5324
(* Adapted. TODO: check indentation *)
5355 5325
let rec pp_vhdl_load_t :
5356 5326
  Format.formatter -> vhdl_load_t -> Ppx_deriving_runtime.unit =
5357 5327
  let __1 () = pp_vhdl_name_t
......
5448 5418
  ((let open! Ppx_deriving_runtime in
5449 5419
      fun fmt  ->
5450 5420
        fun x  ->
5451
          ((((
5452
              ((__0 ()) fmt) x.name;
5453
             );
5454
             Format.fprintf fmt " of ";
5455
             ((__1 ()) fmt) x.entity;
5456
            );
5457
            Format.fprintf fmt " is @ ";
5458
            Format.fprintf fmt "@[<v>";
5459
            ((fun x  ->
5460
                Format.fprintf fmt "@[";
5461
                ignore
5462
                  (List.fold_left
5463
                     (fun sep  ->
5464
                        fun x  ->
5465
                          if sep then Format.fprintf fmt "@ ";
5466
                          ((__2 ()) fmt) x;
5467
                          Format.fprintf fmt ";";
5468
                          true) false x);
5469
                Format.fprintf fmt "@]")) x.declarations;
5470
            Format.fprintf fmt "@]");
5471
           Format.fprintf fmt "@ ";
5472
           Format.fprintf fmt "@[<v>";
5473
           (match x.body with
5474
             | [] -> Format.fprintf fmt "";
5475
             | _ -> Format.fprintf fmt "begin@ @[<2>";
5476
           ((fun x  ->
5477
               Format.fprintf fmt "@[";
5421
          ((__0 ()) fmt) x.name;
5422
          Format.fprintf fmt " of ";
5423
          ((__1 ()) fmt) x.entity;
5424
          Format.fprintf fmt " is@;";
5425
          ((fun x  ->
5426
             ignore
5427
               (List.fold_left
5428
                  (fun sep  ->
5429
                     fun x  ->
5430
                       if sep then Format.fprintf fmt "@;";
5431
                       ((__2 ()) fmt) x;
5432
                       Format.fprintf fmt ";";
5433
                       true) false x))) x.declarations;
5434
          Format.fprintf fmt "@;";
5435
          (match x.body with
5436
            | [] -> Format.fprintf fmt "";
5437
            | _ -> Format.fprintf fmt "@[<v 2>begin@;";
5438
          ((fun x  ->
5478 5439
               ignore
5479 5440
                 (List.fold_left
5480 5441
                    (fun sep  ->
5481 5442
                       fun x  ->
5482
                         if sep then Format.fprintf fmt "@ ";
5443
                         if sep then Format.fprintf fmt "";
5483 5444
                         ((__3 ()) fmt) x;
5484
                         true) false x);
5485
               Format.fprintf fmt "@]")) x.body;
5486
           Format.fprintf fmt "@]");
5487
           Format.fprintf fmt "@]");
5488
          Format.fprintf fmt "@ ")
5445
                         true) false x))) x.body;
5446
          Format.fprintf fmt "@]@;end;"))
5489 5447
    [@ocaml.warning "-A"])
5490 5448

  
5491 5449
and show_vhdl_architecture_t :
......
5646 5604
      fun fmt  ->
5647 5605
        function
5648 5606
        | Package a0 ->
5649
            (Format.fprintf fmt "@[<2>package ";
5607
            (Format.fprintf fmt "@[<v 2>package ";
5650 5608
             ((__0 ()) fmt) a0;
5651
             Format.fprintf fmt "@.end;")
5609
             Format.fprintf fmt "@.end;@]")
5652 5610
        | Entities a0 ->
5653
            (Format.fprintf fmt "@[<2>entity ";
5611
            (Format.fprintf fmt "@[<v 2>entity ";
5654 5612
             ((__1 ()) fmt) a0;
5655
             Format.fprintf fmt "@.end;")
5613
             Format.fprintf fmt "@.end;@]")
5656 5614
        | Architecture a0 ->
5657
            (Format.fprintf fmt "@[<2>architecture ";
5615
            (Format.fprintf fmt "@[<v 2>architecture ";
5658 5616
             ((__2 ()) fmt) a0;
5659
             Format.fprintf fmt "@.end;")
5617
             Format.fprintf fmt "@.end;@]")
5660 5618
        | Configuration a0 ->
5661
            (Format.fprintf fmt "@[<2>configuration ";
5619
            (Format.fprintf fmt "@[<v 2>configuration ";
5662 5620
             ((__3 ()) fmt) a0;
5663
             Format.fprintf fmt "@.end;"))
5621
             Format.fprintf fmt "@.end;@]"))
5664 5622
    [@ocaml.warning "-A"])
5665 5623

  
5666 5624
and show_vhdl_library_unit_t :

Also available in: Unified diff