Project

General

Profile

Revision ab6312e7

View differences:

src/backends/VHDL/vhdl_ast.ml
67 67
  | Subtype of {name : vhdl_name_t ; typ : vhdl_subtype_indication_t} [@name "SUBTYPE_DECLARATION"]
68 68
and vhdl_expr_t =
69 69
  | Call of vhdl_name_t [@name "CALL"]
70
  | Cst of vhdl_cst_val_t [@name "CONSTANT_VALUE"]
70
  | Cst of { value: vhdl_cst_val_t; unit_name: vhdl_name_t option [@default None]} [@name "CONSTANT_VALUE"]
71 71
  | Op of { id: string [@default ""]; args: vhdl_expr_t list [@default []]} [@name "EXPRESSION"]
72 72
  | IsNull [@name "IsNull"]
73 73
  | Time of { value: int; phy_unit: string [@default ""]}
src/backends/VHDL/vhdl_ast_deriving.ml
124 124
  typ: vhdl_subtype_indication_t } [@name "SUBTYPE_DECLARATION"]
125 125
and vhdl_expr_t =
126 126
  | Call of vhdl_name_t [@name "CALL"]
127
  | Cst of vhdl_cst_val_t [@name "CONSTANT_VALUE"]
127
  | Cst of
128
  {
129
  value: vhdl_cst_val_t ;
130
  unit_name: vhdl_name_t option [@default None]} [@name "CONSTANT_VALUE"]
128 131
  | Op of {
129 132
  id: string [@default ""];
130 133
  args: vhdl_expr_t list [@default []]} [@name "EXPRESSION"]
......
432 435
(* TODO adapt for Op, Time, Sig, suffixMod, Aggregate *)
433 436
and pp_vhdl_expr_t :
434 437
  Format.formatter -> vhdl_expr_t -> Ppx_deriving_runtime.unit =
435
  let __7 () = pp_vhdl_element_assoc_t
438
  let __8 () = pp_vhdl_element_assoc_t
436 439
  
437
  and __6 () = pp_vhdl_suffix_selection_t
440
  and __7 () = pp_vhdl_suffix_selection_t
438 441
  
439
  and __5 () = pp_vhdl_expr_t
442
  and __6 () = pp_vhdl_expr_t
440 443
  
441
  and __4 () = pp_vhdl_signal_attributes_t
444
  and __5 () = pp_vhdl_signal_attributes_t
442 445
  
443
  and __3 () = pp_vhdl_name_t
446
  and __4 () = pp_vhdl_name_t
444 447
  
445
  and __2 () = pp_vhdl_expr_t
448
  and __3 () = pp_vhdl_expr_t
449
  
450
  and __2 () = pp_vhdl_name_t
446 451
  
447 452
  and __1 () = pp_vhdl_cst_val_t
448 453
  
......
453 458
        function
454 459
        | Call a0 ->
455 460
             ((__0 ()) fmt) a0;
456
        | Cst a0 ->
457
             ((__1 ()) fmt) a0;
461
        | Cst { value = avalue; unit_name = aunit_name } ->
462
             ((__1 ()) fmt) avalue;
463
             ((function
464
                | None  -> Format.pp_print_string fmt ""
465
                | Some x ->
466
                     ((__2 ()) fmt) x)) aunit_name;
458 467
        | Op { id = aid; args = aargs } ->
459 468
            (match aargs with
460 469
            | [] -> (Format.fprintf fmt "%s") aid;
461 470
            | hd::[] ->
462 471
               (Format.fprintf fmt "%s") aid;
463
               ((__2 ()) fmt) hd
472
               ((__3 ()) fmt) hd
464 473
            | hd::(hd2::[]) -> 
465
               ((__2 ()) fmt) hd;
474
               ((__3 ()) fmt) hd;
466 475
               (Format.fprintf fmt " %s ") aid;
467
               ((__2 ()) fmt) hd2
476
               ((__3 ()) fmt) hd2
468 477
            | _ ->
469 478
            (Format.fprintf fmt "@[<2>Op {@,";
470 479
             ((Format.fprintf fmt "@[%s =@ " "id";
......
479 488
                       (fun sep  ->
480 489
                          fun x  ->
481 490
                            if sep then Format.fprintf fmt ";@ ";
482
                            ((__2 ()) fmt) x;
491
                            ((__3 ()) fmt) x;
483 492
                            true) false x);
484 493
                  Format.fprintf fmt "@,]@]")) aargs;
485 494
              Format.fprintf fmt "@]");
......
498 507
        | Sig { name = aname; att = aatt } ->
499 508
            (Format.fprintf fmt "--@[<2>Sig {@,";
500 509
             ((Format.fprintf fmt "@[%s =@ " "name";
501
               ((__3 ()) fmt) aname;
510
               ((__4 ()) fmt) aname;
502 511
               Format.fprintf fmt "@]");
503 512
              Format.fprintf fmt ";@ ";
504 513
              Format.fprintf fmt "@[%s =@ " "att";
......
506 515
                | None  -> Format.pp_print_string fmt "None"
507 516
                | Some x ->
508 517
                    (Format.pp_print_string fmt "(Some ";
509
                     ((__4 ()) fmt) x;
518
                     ((__5 ()) fmt) x;
510 519
                     Format.pp_print_string fmt ")"))) aatt;
511 520
              Format.fprintf fmt "@]");
512 521
             Format.fprintf fmt "@]}")
513 522
        | SuffixMod { expr = aexpr; selection = aselection } ->
514 523
            (Format.fprintf fmt "--@[<2>SuffixMod {@,";
515 524
             ((Format.fprintf fmt "@[%s =@ " "expr";
516
               ((__5 ()) fmt) aexpr;
525
               ((__6 ()) fmt) aexpr;
517 526
               Format.fprintf fmt "@]");
518 527
              Format.fprintf fmt ";@ ";
519 528
              Format.fprintf fmt "@[%s =@ " "selection";
520
              ((__6 ()) fmt) aselection;
529
              ((__7 ()) fmt) aselection;
521 530
              Format.fprintf fmt "@]");
522 531
             Format.fprintf fmt "@]}")
523 532
        | Aggregate { elems = aelems } ->
......
530 539
                       (fun sep  ->
531 540
                          fun x  ->
532 541
                            if sep then Format.fprintf fmt ";@ ";
533
                            ((__7 ()) fmt) x;
542
                            ((__8 ()) fmt) x;
534 543
                            true) false x);
535 544
                  Format.fprintf fmt "@,]@]")) aelems;
536 545
              Format.fprintf fmt "@]");
......
1401 1410
      | Cst arg0 ->
1402 1411
          `List
1403 1412
            [`String "CONSTANT_VALUE";
1404
            ((fun x  -> vhdl_cst_val_t_to_yojson x)) arg0]
1413
            (let fields = []  in
1414
             let fields =
1415
               if arg0.unit_name = None
1416
               then fields
1417
               else
1418
                 ("unit_name",
1419
                   (((function
1420
                      | None  -> `Null
1421
                      | Some x -> ((fun x  -> vhdl_name_t_to_yojson x)) x))
1422
                      arg0.unit_name))
1423
                 :: fields
1424
                in
1425
             let fields =
1426
               ("value", ((fun x  -> vhdl_cst_val_t_to_yojson x) arg0.value))
1427
               :: fields  in
1428
             `Assoc fields)]
1405 1429
      | Op arg0 ->
1406 1430
          `List
1407 1431
            [`String "EXPRESSION";
......
1499 1523
          ((fun x  -> vhdl_name_t_of_yojson x) arg0) >>=
1500 1524
            ((fun arg0  -> Result.Ok (Call arg0)))
1501 1525
      | `List ((`String "CONSTANT_VALUE")::arg0::[]) ->
1502
          ((fun x  -> vhdl_cst_val_t_of_yojson x) arg0) >>=
1503
            ((fun arg0  -> Result.Ok (Cst arg0)))
1526
          ((function
1527
            | `Assoc xs ->
1528
                let rec loop xs ((arg0,arg1) as _state) =
1529
                  match xs with
1530
                  | ("value",x)::xs ->
1531
                      loop xs
1532
                        (((fun x  -> vhdl_cst_val_t_of_yojson x) x), arg1)
1533
                  | ("unit_name",x)::xs ->
1534
                      loop xs
1535
                        (arg0,
1536
                          ((function
1537
                            | `Null -> Result.Ok None
1538
                            | x ->
1539
                                ((fun x  -> vhdl_name_t_of_yojson x) x) >>=
1540
                                  ((fun x  -> Result.Ok (Some x)))) x))
1541
                  | [] ->
1542
                      arg1 >>=
1543
                        ((fun arg1  ->
1544
                            arg0 >>=
1545
                              (fun arg0  ->
1546
                                 Result.Ok
1547
                                   (Cst { value = arg0; unit_name = arg1 }))))
1548
                  | _::xs -> loop xs _state  in
1549
                loop xs
1550
                  ((Result.Error "Vhdl_ast.vhdl_expr_t.value"),
1551
                    (Result.Ok None))
1552
            | _ -> Result.Error "Vhdl_ast.vhdl_expr_t")) arg0
1504 1553
      | `List ((`String "EXPRESSION")::arg0::[]) ->
1505 1554
          ((function
1506 1555
            | `Assoc xs ->
src/backends/VHDL/vhdl_ast_map.ml
166 166
      fun x  ->
167 167
        match x with
168 168
        | Call a -> let a = self#vhdl_name_t a  in Call a
169
        | Cst a -> let a = self#vhdl_cst_val_t a  in Cst a
169
        | Cst { value; unit_name } ->
170
            let value = self#vhdl_cst_val_t value  in
171
            let unit_name = self#option self#vhdl_name_t unit_name  in
172
            Cst { value; unit_name }
170 173
        | Op { id; args } ->
171 174
            let id = self#string id  in
172 175
            let args = self#list self#vhdl_expr_t args  in Op { id; args }
src/tools/importer/vhdl_to_lustre.ml
168 168
      fun x  ->
169 169
        match x with
170 170
        | Call a -> let a = self#vhdl_name_t a  in Call a
171
        | Cst a -> let a = self#vhdl_cst_val_t a  in Cst a
171
        | Cst { value; unit_name } ->
172
            let value = self#vhdl_cst_val_t value  in
173
            let unit_name = self#option self#vhdl_name_t unit_name  in
174
            Cst { value; unit_name }
172 175
        | Op { id; args } ->
173 176
            let id = self#string id  in
174 177
            let args = self#list self#vhdl_expr_t args  in Op { id; args }

Also available in: Unified diff