Project

General

Profile

« Previous | Next » 

Revision 23b37f25

Added by Arnaud Dieumegard over 3 years ago

Concurrent signal assignment statement transformation to concurrent process statement

View differences:

src/backends/VHDL/mini_vhdl_ast.ml
1 1
open Vhdl_ast
2 2

  
3 3
type mini_vhdl_sequential_stmt_t = 
4
  | VarAssign of { label: vhdl_name_t [@default NoName]; lhs: vhdl_name_t; rhs: vhdl_expr_t } [@name "VARIABLE_ASSIGNMENT_STATEMENT"]
5
  | SigSeqAssign of { label: vhdl_name_t [@default NoName]; lhs: vhdl_name_t; rhs: vhdl_signal_condition_t list} [@name "SIGNAL_ASSIGNMENT_STATEMENT"]
6
  | If of { label: vhdl_name_t [@default NoName]; if_cases: mini_vhdl_if_case_t list; default: mini_vhdl_sequential_stmt_t list [@default []]; } [@name "IF_STATEMENT"]
7
  | Case of { label: vhdl_name_t [@default NoName]; guard: vhdl_expr_t; branches: mini_vhdl_case_item_t list } [@name "CASE_STATEMENT_TREE"]
8
  | Exit of { label: vhdl_name_t [@default NoName]; loop_label: string option [@default Some ""]; condition: vhdl_expr_t option [@default Some IsNull]} [@name "EXIT_STATEMENT"]
9
  | Assert of { label: vhdl_name_t [@default NoName]; cond: vhdl_expr_t; report: vhdl_expr_t [@default IsNull]; severity: vhdl_expr_t [@default IsNull]} [@name "ASSERTION_STATEMENT"]
10
  | ProcedureCall of { label: vhdl_name_t [@default NoName]; name: vhdl_name_t; assocs: vhdl_assoc_element_t list [@default []] } [@name "PROCEDURE_CALL_STATEMENT"]
11
  | Wait [@name "WAIT_STATEMENT"]
12
  | Null of { label: vhdl_name_t [@default NoName]} [@name "NULL_STATEMENT"]
13
  | Return of { label: vhdl_name_t option [@default None]; expr: vhdl_expr_t option [@default None]} [@name "RETURN_STATEMENT"]
14
and mini_vhdl_if_case_t = 
4
  | VarAssign of {
5
      label: vhdl_name_t option;
6
      lhs: vhdl_name_t;
7
      rhs: vhdl_expr_t }
8
  | SigSeqAssign of {
9
      label: vhdl_name_t option;
10
      lhs: vhdl_name_t;
11
      rhs: vhdl_waveform_element_t list}
12
  | SigCondAssign of {
13
      label: vhdl_name_t option;
14
      lhs: vhdl_name_t;
15
      rhs: vhdl_signal_condition_t list;
16
      delay: vhdl_expr_t option}
17
  | SigSelectAssign of {
18
      label: vhdl_name_t option;
19
      lhs: vhdl_name_t;
20
      sel: vhdl_expr_t;
21
      branches: vhdl_signal_selection_t list;
22
      delay: vhdl_expr_t option}
23
  | If of {
24
      label: vhdl_name_t option;
25
      if_cases: mini_vhdl_if_case_t list;
26
      default: mini_vhdl_sequential_stmt_t list}
27
  | Case of {
28
      label: vhdl_name_t option;
29
      guard: vhdl_expr_t;
30
      branches: mini_vhdl_case_item_t list }
31
  | Exit of {
32
      label: vhdl_name_t option;
33
      loop_label: string option;
34
      condition: vhdl_expr_t option}
35
  | Assert of {
36
      label: vhdl_name_t option;
37
      cond: vhdl_expr_t;
38
      report: vhdl_expr_t;
39
      severity: vhdl_expr_t}
40
  | ProcedureCall of {
41
      label: vhdl_name_t option;
42
      name: vhdl_name_t;
43
      assocs: vhdl_assoc_element_t list }
44
  | Wait
45
  | Null of {
46
      label: vhdl_name_t option}
47
  | Return of {
48
     label: vhdl_name_t option;
49
     expr: vhdl_expr_t option}
50
and mini_vhdl_if_case_t =
15 51
  {
16 52
    if_cond: vhdl_expr_t;
17 53
    if_block: mini_vhdl_sequential_stmt_t list;
......
25 61

  
26 62
type mini_vhdl_declaration_t =
27 63
  | VarDecl of {
28
      names : vhdl_name_t list; 
29
      typ : vhdl_subtype_indication_t; 
30
      init_val : vhdl_expr_t [@default IsNull] 
31
    } [@name "VARIABLE_DECLARATION"]
32
  | CstDecl of { 
33
      names : vhdl_name_t list; 
34
      typ : vhdl_subtype_indication_t; 
64
      names : vhdl_name_t list;
65
      typ : vhdl_subtype_indication_t;
35 66
      init_val : vhdl_expr_t
36
    } [@name "CONSTANT_DECLARATION"]
37
  | SigDecl of { 
38
      names : vhdl_name_t list; 
39
      typ : vhdl_subtype_indication_t; 
40
      init_val : vhdl_expr_t [@default IsNull]
41
    } [@name "SIGNAL_DECLARATION"]
67
    }
68
  | CstDecl of {
69
      names : vhdl_name_t list;
70
      typ : vhdl_subtype_indication_t;
71
      init_val : vhdl_expr_t
72
    }
73
  | SigDecl of {
74
      names : vhdl_name_t list;
75
      typ : vhdl_subtype_indication_t;
76
      init_val : vhdl_expr_t
77
    }
42 78
  | ComponentDecl of {
43
      name: vhdl_name_t [@default NoName];
44
      generics: vhdl_port_t list [@default []];
45
      ports: vhdl_port_t list [@default []];
46
    } [@name "COMPONENT_DECLARATION"]
79
      name: vhdl_name_t;
80
      generics: vhdl_port_t list;
81
      ports: vhdl_port_t list;
82
    }
47 83
  | Subprogram of {
48
      spec: vhdl_subprogram_spec_t; 
49
      decl_part: mini_vhdl_declaration_t list [@default []]; 
50
      stmts: mini_vhdl_sequential_stmt_t list [@default []]
51
    } [@name "SUBPROGRAM_BODY"]
84
      spec: vhdl_subprogram_spec_t;
85
      decl_part: mini_vhdl_declaration_t list;
86
      stmts: mini_vhdl_sequential_stmt_t list
87
    }
52 88
[@@deriving show { with_path = false }];;
53 89

  
54 90
type mini_vhdl_declarative_item_t =
55 91
  {
56
    use_clause: vhdl_load_t option [@default None];
57
    declaration: mini_vhdl_declaration_t option [@default None];
58
    definition: vhdl_definition_t option [@default None];
92
    use_clause: vhdl_load_t option;
93
    declaration: mini_vhdl_declaration_t option;
94
    definition: vhdl_definition_t option;
59 95
  }
60 96
[@@deriving show { with_path = false }];;
61 97

  
......
64 100
    name: vhdl_name_t;
65 101
    archi: vhdl_architecture_t;
66 102
    entity: vhdl_entity_t;
67
    generic_map: vhdl_assoc_element_t list [@default []];
68
    port_map: vhdl_assoc_element_t list [@default []];
103
    generic_map: vhdl_assoc_element_t list;
104
    port_map: vhdl_assoc_element_t list;
69 105
  }
70 106
[@@deriving show { with_path = false }];;
71 107

  
72 108
type mini_vhdl_process_t =
73
  { 
74
    id: vhdl_name_t [@default NoName];
75
    declarations: mini_vhdl_declarative_item_t list [@key "PROCESS_DECLARATIVE_PART"] [@default []];
76
    active_sigs: vhdl_name_t list [@default []];
77
    body: mini_vhdl_sequential_stmt_t list [@key "PROCESS_STATEMENT_PART"] [@default []]
109
  {
110
    id: vhdl_name_t;
111
    declarations: mini_vhdl_declarative_item_t list;
112
    active_sigs: vhdl_name_t list;
113
    body: mini_vhdl_sequential_stmt_t list;
114
    postponed: bool;
115
    label: vhdl_name_t option
78 116
  }
79 117
[@@deriving show { with_path = false }];;
80 118

  
81 119
type mini_vhdl_concurrent_stmt_t =
82
  | Process of mini_vhdl_process_t [@name "PROCESS_STATEMENT"]
83
  | SelectedSig of vhdl_selected_signal_t [@name "SELECTED_SIGNAL_ASSIGNMENT"]
84
  | ComponentInst of mini_vhdl_component_instantiation_t [@name "COMPONENT_INSTANTIATION_STATEMENT"]
120
  | Process of mini_vhdl_process_t
121
  | SelectedSig of vhdl_selected_signal_t
122
  | ComponentInst of mini_vhdl_component_instantiation_t
85 123
[@@deriving show { with_path = false }];;
86 124

  
87 125
type mini_vhdl_package_t =
88 126
  {
89
    name: vhdl_name_t [@default NoName];
90
    shared_defs: vhdl_definition_t list [@default []];
91
    shared_decls: mini_vhdl_declaration_t list [@default []];
92
    shared_uses: vhdl_load_t list [@default []];
127
    name: vhdl_name_t;
128
    shared_defs: vhdl_definition_t list;
129
    shared_decls: mini_vhdl_declaration_t list;
130
    shared_uses: vhdl_load_t list;
93 131
  }
94 132
[@@deriving show { with_path = false }];;
95 133

  
96 134
type mini_vhdl_component_t =
97 135
  {
98
    names: vhdl_name_t list [@default NoName];
99
    generics: vhdl_port_t list [@default []]; (* From related 'entity' *)
100
    ports: vhdl_port_t list [@default []]; (* From related 'entity' *)
101
    contexts: vhdl_load_t list [@default []]; (* Related 'declarations' contexts + relatated entity contexts *)
102
    declarations: mini_vhdl_declaration_t list [@default []]; (* From inlined 'declarations' + entity.declaration *)
103
    definitions: vhdl_definition_t list [@default []]; (* From inlined 'declarations' + entity.declaration *)
104
    body: mini_vhdl_concurrent_stmt_t list [@key "ARCHITECTURE_STATEMENT_PART"] [@default []]; (* + entity.stmts *)
136
    names: vhdl_name_t list;
137
    generics: vhdl_port_t list; (* From related 'entity' *)
138
    ports: vhdl_port_t list; (* From related 'entity' *)
139
    contexts: vhdl_load_t list; (* Related 'declarations' contexts + relatated entity contexts *)
140
    declarations: mini_vhdl_declaration_t list; (* From inlined 'declarations' + entity.declaration *)
141
    definitions: vhdl_definition_t list; (* From inlined 'declarations' + entity.declaration *)
142
    body: mini_vhdl_concurrent_stmt_t list; (* + entity.stmts *)
105 143
  }
106 144
[@@deriving show { with_path = false }];;
107 145

  
108 146
type mini_vhdl_design_file_t = 
109 147
  {
110
    components: mini_vhdl_component_t list [@default []];
111
    packages: mini_vhdl_package_t list [@default []];
148
    components: mini_vhdl_component_t list;
149
    packages: mini_vhdl_package_t list;
112 150
  }
113 151
[@@deriving show { with_path = false }];;
src/backends/VHDL/vhdl_2_mini_vhdl_map.ml
1 1
open Vhdl_ast
2 2
open Mini_vhdl_ast
3
open Vhdl_ast_fold_sensitivity
3 4

  
4 5
type db_tuple_t =
5 6
  {
......
9 10
    mutable contexts: vhdl_load_t list;
10 11
  }
11 12

  
13
let get_sensitivity_list = object (self)
14
  inherit ['acc] fold_sensitivity as super
15
end
16

  
12 17
let _ = fun (_ : vhdl_cst_val_t)  -> () 
13 18
let _ = fun (_ : vhdl_type_t)  -> () 
14 19
let _ = fun (_ : vhdl_element_declaration_t)  -> () 
......
449 454
      fun x  ->
450 455
        match x with
451 456
        | VarAssign { label; lhs; rhs } ->
452
            let label = self#lower_vhdl_name_t label  in
457
            let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in
453 458
            let lhs = self#lower_vhdl_name_t lhs  in
454 459
            let rhs = self#vhdl_expr_t rhs  in VarAssign { label; lhs; rhs }
455 460
        | SigSeqAssign { label; lhs; rhs } ->
456
            let label = self#lower_vhdl_name_t label  in
461
            let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in
457 462
            let lhs = self#lower_vhdl_name_t lhs  in
458
            let rhs = { expr = rhs; cond = None }::[] in
463
            let rhs = self#list self#vhdl_waveform_element_t rhs in
459 464
            SigSeqAssign { label; lhs; rhs }
460 465
        | If { label; if_cases; default } ->
461
            let label = self#lower_vhdl_name_t label  in
466
            let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in
462 467
            let if_cases = List.map self#vhdl_if_case_t if_cases  in
463 468
            let default = List.map self#vhdl_sequential_stmt_t default  in
464 469
            If { label; if_cases; default }
465 470
        | Case { label; guard; branches } ->
466
            let label = self#lower_vhdl_name_t label  in
471
            let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in
467 472
            let guard = self#vhdl_expr_t guard  in
468 473
            let branches = List.map self#vhdl_case_item_t branches  in
469 474
            Case { label; guard; branches }
470 475
        | Exit { label; loop_label; condition } ->
471
            let label = self#lower_vhdl_name_t label  in
476
            let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in
472 477
            let loop_label = self#option self#string loop_label  in
473 478
            let condition = self#option self#vhdl_expr_t condition  in
474 479
            Exit { label; loop_label; condition }
475 480
        | Assert { label; cond; report; severity } ->
476
            let label = self#lower_vhdl_name_t label  in
481
            let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in
477 482
            let cond = self#vhdl_expr_t cond  in
478 483
            let report = self#vhdl_expr_t report  in
479 484
            let severity = self#vhdl_expr_t severity  in
480 485
            Assert { label; cond; report; severity }
481 486
        | ProcedureCall { label; name; assocs } ->
482
            let label = self#lower_vhdl_name_t label  in
487
            let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in
483 488
            let name = self#lower_vhdl_name_t name  in
484 489
            let assocs = self#list self#vhdl_assoc_element_t assocs  in
485 490
            ProcedureCall { label; name; assocs }
486 491
        | Wait  -> Wait
487 492
        | Null { label } ->
488
            let label = self#lower_vhdl_name_t label  in Null { label }
493
            let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in
494
            Null { label }
489 495
        | Return { label; expr } ->
490 496
            let label = self#option self#lower_vhdl_name_t label  in
491 497
            let expr = self#option self#vhdl_expr_t expr in
......
578 584
        let declarations = List.map self#vhdl_declarative_item_t declarations  in
579 585
        let active_sigs = self#list self#lower_vhdl_name_t active_sigs  in
580 586
        let body = List.map self#vhdl_sequential_stmt_t body  in
581
        { id; declarations; active_sigs; body }
587
        let postponed = false in
588
        let label = None in
589
        { id; declarations; active_sigs; body; postponed; label }
582 590

  
583 591
    method vhdl_selected_signal_t :
584 592
      vhdl_selected_signal_t -> vhdl_selected_signal_t=
......
617 625
            Process {
618 626
              id = self#postfix_flatten_vhdl_name_t a.lhs "__implicit_process";
619 627
              declarations = [];
620
              active_sigs = [];
621
              body = (SigSeqAssign {
622
                label = NoName;
628
              active_sigs = get_sensitivity_list#vhdl_concurrent_stmt_t x []; (* TODO: Resolve sensitivity list from here *)
629
              body = (SigCondAssign {
630
                label = None;
623 631
                lhs = a.lhs;
624 632
                rhs = a.rhs;
625
              })::[]
633
                delay = match a.delay with | IsNull -> None | _ -> Some a.delay
634
              })::[];
635
              postponed = a.postponed;
636
              label = match a.label with | NoName -> None | _ -> Some a.label
626 637
            }
627 638
        | Process a -> let a = self#vhdl_process_t a  in Process a
628
        | SelectedSig a -> let a = self#vhdl_selected_signal_t a  in SelectedSig a (* TODO: convert to Process *)
639
        | SelectedSig a -> 
640
            Process {
641
              id = self#postfix_flatten_vhdl_name_t a.lhs "__implicit_process";
642
              declarations = [];
643
              active_sigs = get_sensitivity_list#vhdl_concurrent_stmt_t x []; (* TODO: Resolve sensitivity list from here *)
644
              body = (SigSelectAssign {
645
                label = None;
646
                lhs = a.lhs;
647
                sel = a.sel;
648
                branches = a.branches;
649
                delay = a.delay
650
              })::[];
651
              postponed = a.postponed;
652
              label = match a.label with | NoName -> None | _ -> Some a.label
653
            }
629 654
        | ComponentInst a -> let a = self#vhdl_component_instantiation_t a  in ComponentInst a (* TODO: instantiate *)
630 655

  
631 656
    method vhdl_port_t : vhdl_port_t -> vhdl_port_t=
......
693 718
          contexts=contexts; 
694 719
          declarations=declarations; 
695 720
          definitions=definitions; 
696
          body=body 
721
          body=body (* TODO: Flatten component instantiation from here *)
697 722
        }
698 723

  
699 724
    method declarative_items_declarations : vhdl_declarative_item_t list -> vhdl_declaration_t list =

Also available in: Unified diff