Revision 40364f53
Added by Arnaud Dieumegard over 6 years ago
| src/backends/VHDL/vhdl_ast.ml | ||
|---|---|---|
| 1 |
(* source: Synario VHDL Reference Manual - March 1997 *) |
|
| 2 |
|
|
| 3 |
(************************************************************************************) |
|
| 4 |
(* Types *) |
|
| 5 |
(************************************************************************************) |
|
| 6 | 1 |
let base_types = ["integer"; "character"; "bit"; "real"; "natural"; "positive"; "std_logic"; "std_logic_vector" ] |
| 7 |
|
|
| 8 |
type vhdl_type_t = |
|
| 9 |
| Base of string |
|
| 10 |
| Range of string option * int * int |
|
| 11 |
| Bit_vector of int * int |
|
| 12 |
| Array of int * int * vhdl_type_t |
|
| 13 |
| Enumerated of string list |
|
| 14 |
|
|
| 15 |
let rec pp_vhdl_type fmt t = |
|
| 16 |
match t with |
|
| 17 |
| Base s -> Format.fprintf fmt "%s" s |
|
| 18 |
| Bit_vector (n,m) -> Format.fprintf fmt "bit_vector(%i downto %i)" n m |
|
| 19 |
| Range(base, n, m) -> Format.fprintf fmt "%trange %i to %i" (fun fmt -> match base with Some s -> Format.fprintf fmt "%s " s | None -> ()) n m |
|
| 20 |
| Array (n, m, base) -> Format.fprintf fmt "array (%i to %i) of %a" n m pp_vhdl_type base |
|
| 21 |
| Enumerated sl -> Format.fprintf fmt "(%a)" (Utils.fprintf_list ~sep:", " Format.pp_print_string) sl |
|
| 22 |
|
|
| 23 |
|
|
| 24 |
|
|
| 2 |
|
|
| 25 | 3 |
(************************************************************************************) |
| 26 | 4 |
(* Constants *) |
| 27 | 5 |
(************************************************************************************) |
| ... | ... | |
| 37 | 15 |
'H': Weak signal that should probably go to 1 |
| 38 | 16 |
'-': Don't care. *) |
| 39 | 17 |
let std_logic_cst = ["U"; "X"; "0"; "1"; "Z"; "W"; "L"; "H"; "-" ] |
| 18 |
let literal_base = ["B"; "O"; "X"; "UB"; "UO"; "UX"; "SB"; "SO"; "SX"; "D"] (* Prefix of CstLiteral *) |
|
| 40 | 19 |
|
| 41 | 20 |
(* TODO: do we need more constructors ? *) |
| 42 |
type cst_val_t = CstInt of int | CstStdLogic of string | CstBV of string * string |
|
| 21 |
type vhdl_cst_val_t = |
|
| 22 |
CstInt of int |
|
| 23 |
| CstStdLogic of string |
|
| 24 |
| CstLiteral of string [@name "CST_LITERAL"] |
|
| 25 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 43 | 26 |
|
| 27 |
(* |
|
| 44 | 28 |
let pp_cst_val fmt c = |
| 45 | 29 |
match c with |
| 46 | 30 |
| CstInt i -> Format.fprintf fmt "%i" i |
| 47 | 31 |
| CstStdLogic s -> if List.mem s std_logic_cst then Format.fprintf fmt "%s" s else assert false |
| 48 |
| CstBV (pref,suff) -> Format.fprintf fmt "%s\"%s\"" pref suff |
|
| 49 |
|
|
| 50 |
(************************************************************************************) |
|
| 51 |
(* Declarations *) |
|
| 52 |
(************************************************************************************) |
|
| 53 |
|
|
| 54 |
|
|
| 55 |
(* TODO ? Shall we merge definition / declaration ? Do they appear at the same |
|
| 56 |
place or at different ones ? *) |
|
| 57 |
type vhdl_definition_t = |
|
| 58 |
| Type of {name : string ; definition: vhdl_type_t}
|
|
| 59 |
| Subtype of {name : string ; definition: vhdl_type_t}
|
|
| 60 |
|
|
| 61 |
let pp_vhdl_definition fmt def = |
|
| 62 |
match def with |
|
| 63 |
| Type s -> Format.fprintf fmt "type %s is %a;" s.name pp_vhdl_type s.definition |
|
| 64 |
| Subtype s -> Format.fprintf fmt "subtype %s is %a;" s.name pp_vhdl_type s.definition |
|
| 65 |
|
|
| 66 |
type vhdl_declaration_t = |
|
| 67 |
| VarDecl of { name : string; typ : vhdl_type_t; init_val : cst_val_t option }
|
|
| 68 |
| CstDecl of { name : string; typ : vhdl_type_t; init_val : cst_val_t }
|
|
| 69 |
| SigDecl of { name : string; typ : vhdl_type_t; init_val : cst_val_t option }
|
|
| 70 |
|
|
| 71 |
let pp_vhdl_declaration fmt decl = |
|
| 72 |
match decl with |
|
| 73 |
| VarDecl v -> Format.fprintf |
|
| 74 |
fmt |
|
| 75 |
"variable %s : %a%t;" |
|
| 76 |
v.name |
|
| 77 |
pp_vhdl_type v.typ |
|
| 78 |
(fun fmt -> match v.init_val with Some initv -> Format.fprintf fmt " := %a" pp_cst_val initv | _ -> ()) |
|
| 79 |
| CstDecl v -> Format.fprintf |
|
| 80 |
fmt |
|
| 81 |
"constant %s : %a := %a;" |
|
| 82 |
v.name |
|
| 83 |
pp_vhdl_type v.typ |
|
| 84 |
pp_cst_val v.init_val |
|
| 85 |
| SigDecl v -> Format.fprintf |
|
| 86 |
fmt |
|
| 87 |
"signal %s : %a%t;" |
|
| 88 |
v.name |
|
| 89 |
pp_vhdl_type v.typ |
|
| 90 |
(fun fmt -> match v.init_val with Some initv -> Format.fprintf fmt " := %a" pp_cst_val initv | _ -> ()) |
|
| 32 |
| CstLiteral s -> Format.fprintf fmt "%s" s |
|
| 33 |
*) |
|
| 91 | 34 |
|
| 35 |
type vhdl_type_t = |
|
| 36 |
| Base of string |
|
| 37 |
| Range of string option * int * int |
|
| 38 |
| Bit_vector of int * int |
|
| 39 |
| Array of int * int * vhdl_type_t |
|
| 40 |
| Enumerated of string list |
|
| 41 |
| Void |
|
| 42 |
and vhdl_subtype_indication_t = |
|
| 43 |
{
|
|
| 44 |
name : vhdl_name_t [@default NoName]; |
|
| 45 |
functionName : vhdl_name_t [@default NoName]; |
|
| 46 |
const: vhdl_constraint_t [@default NoConstraint]; |
|
| 47 |
} |
|
| 48 |
and vhdl_discrete_range_t = |
|
| 49 |
| SubDiscreteRange of vhdl_subtype_indication_t [@name "SUB_DISCRETE_RANGE"] |
|
| 50 |
| NamedRange of vhdl_name_t [@name "NAMED_RANGE"] |
|
| 51 |
| DirectedRange of { direction: string; from: vhdl_expr_t; _to: vhdl_expr_t } [@name "RANGE_WITH_DIRECTION"]
|
|
| 52 |
and vhdl_constraint_t = |
|
| 53 |
| RefConstraint of { ref_name: vhdl_name_t; }
|
|
| 54 |
| RangeConstraint of { range: vhdl_discrete_range_t } [@name "RANGE_CONSTRAINT"]
|
|
| 55 |
| IndexConstraint of { ranges: vhdl_discrete_range_t list; } [@name "INDEX_CONSTRAINT"]
|
|
| 56 |
| ArrayConstraint of { ranges: vhdl_discrete_range_t list; sub: vhdl_constraint_t } [@name "ARRAY_CONSTRAINT"]
|
|
| 57 |
| RecordConstraint |
|
| 58 |
| NoConstraint |
|
| 59 |
and vhdl_definition_t = |
|
| 60 |
| Type of {name : vhdl_name_t ; definition: vhdl_type_t} [@name "TYPE_DECLARATION"]
|
|
| 61 |
| Subtype of {name : vhdl_name_t ; typ : vhdl_subtype_indication_t} [@name "SUBTYPE_DECLARATION"]
|
|
| 62 |
and vhdl_expr_t = |
|
| 63 |
| Call of vhdl_name_t [@name "CALL"] |
|
| 64 |
| Cst of vhdl_cst_val_t [@name "CONSTANT_VALUE"] |
|
| 65 |
| Op of { id: string [@default ""]; args: vhdl_expr_t list [@default []]} [@name "EXPRESSION"]
|
|
| 66 |
| IsNull [@name "IsNull"] |
|
| 67 |
| Time of { value: int; phy_unit: string [@default ""]}
|
|
| 68 |
| Sig of { name: vhdl_name_t; att: vhdl_signal_attributes_t option }
|
|
| 69 |
| SuffixMod of { expr : vhdl_expr_t; selection : vhdl_suffix_selection_t }
|
|
| 70 |
| Aggregate of { elems : vhdl_element_assoc_t list } [@name "AGGREGATE"]
|
|
| 71 |
| Others [@name "OTHERS"] |
|
| 72 |
and vhdl_name_t = |
|
| 73 |
| Simple of string [@name "SIMPLE_NAME"] |
|
| 74 |
| Identifier of string [@name "IDENTIFIER"] |
|
| 75 |
| Selected of vhdl_name_t list [@name "SELECTED_NAME"] |
|
| 76 |
| Index of { id: vhdl_name_t; exprs: vhdl_expr_t list } [@name "INDEXED_NAME"]
|
|
| 77 |
| Slice of { id: vhdl_name_t; range: vhdl_discrete_range_t } [@name "SLICE_NAME"]
|
|
| 78 |
| Attribute of { id: vhdl_name_t; designator: vhdl_name_t; expr: vhdl_expr_t [@default IsNull]} [@name "ATTRIBUTE_NAME"]
|
|
| 79 |
| Function of { id: vhdl_name_t; assoc_list: vhdl_assoc_element_t list } [@name "FUNCTION_CALL"]
|
|
| 80 |
| NoName |
|
| 81 |
and vhdl_assoc_element_t = |
|
| 82 |
{
|
|
| 83 |
formal_name: vhdl_name_t option [@default Some NoName]; |
|
| 84 |
formal_arg: vhdl_name_t option [@default Some NoName]; |
|
| 85 |
actual_name: vhdl_name_t option [@default Some NoName]; |
|
| 86 |
actual_designator: vhdl_name_t option [@default Some NoName]; |
|
| 87 |
actual_expr: vhdl_expr_t option [@default Some IsNull]; |
|
| 88 |
} |
|
| 89 |
and vhdl_element_assoc_t = |
|
| 90 |
{
|
|
| 91 |
choices: vhdl_expr_t list; |
|
| 92 |
expr: vhdl_expr_t; |
|
| 93 |
} |
|
| 94 |
and vhdl_array_attributes_t = |
|
| 95 |
| AAttInt of { id: string; arg: int; }
|
|
| 96 |
| AAttAscending |
|
| 97 |
and vhdl_signal_attributes_t = SigAtt of string |
|
| 98 |
and vhdl_string_attributes_t = StringAtt of string |
|
| 99 |
and vhdl_suffix_selection_t = Idx of int | SuffixRange of int * int |
|
| 100 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 101 |
|
|
| 102 |
(* |
|
| 103 |
let rec pp_vhdl_type fmt t = |
|
| 104 |
match t with |
|
| 105 |
| Base s -> Format.fprintf fmt "%s" s |
|
| 106 |
| Range(base, n, m) -> Format.fprintf fmt "%trange %i to %i" (fun fmt -> match base with Some s -> Format.fprintf fmt "%s " s | None -> ()) n m |
|
| 107 |
| Bit_vector (n,m) -> Format.fprintf fmt "bit_vector(%i downto %i)" n m |
|
| 108 |
| Array (n, m, base) -> Format.fprintf fmt "array (%i to %i) of %a" n m pp_vhdl_type base |
|
| 109 |
| Enumerated sl -> Format.fprintf fmt "(%a)" (Utils.fprintf_list ~sep:", " Format.pp_print_string) sl |
|
| 110 |
| Void -> Format.fprintf fmt "" |
|
| 111 |
*) |
|
| 92 | 112 |
|
| 93 | 113 |
(************************************************************************************) |
| 94 | 114 |
(* Attributes for types, arrays, signals and strings *) |
| ... | ... | |
| 99 | 119 |
| TAttIntArg of { id: string; arg: int }
|
| 100 | 120 |
| TAttValArg of { id: string; arg: 'basetype }
|
| 101 | 121 |
| TAttStringArg of { id: string; arg: string }
|
| 122 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 102 | 123 |
|
| 103 | 124 |
let typ_att_noarg = ["base"; "left"; "right"; "high"; "low"] |
| 104 | 125 |
let typ_att_intarg = ["pos"; "val"; "succ"; "pred"; "leftof"; "rightof"] |
| 105 | 126 |
let typ_att_valarg = ["image"] |
| 106 | 127 |
let typ_att_stringarg = ["value"] |
| 107 | 128 |
|
| 108 |
let pp_type_attribute pp_val fmt tatt = |
|
| 109 |
match tatt with |
|
| 110 |
| TAttNoArg a -> Format.fprintf fmt "'%s" a.id |
|
| 111 |
| TAttIntArg a -> Format.fprintf fmt "'%s(%i)" a.id a.arg |
|
| 112 |
| TAttValArg a -> Format.fprintf fmt "'%s(%a)" a.id pp_val a.arg |
|
| 113 |
| TAttStringArg a -> Format.fprintf fmt "'%s(%s)" a.id a.arg |
|
| 114 |
|
|
| 115 |
type vhdl_array_attributes_t = AAttInt of { id: string; arg: int; } | AAttAscending
|
|
| 116 |
let pp_array_attribute fmt aatt = |
|
| 117 |
match aatt with |
|
| 118 |
| AAttInt a -> Format.fprintf fmt "'%s(%i)" a.id a.arg |
|
| 119 |
| AAttAscending -> Format.fprintf fmt "'ascending" |
|
| 120 | 129 |
let array_att_intarg = ["left"; "right"; "high"; "low"; "range"; "reverse_range"; "length"] |
| 121 | 130 |
|
| 122 |
type vhdl_signal_attributes_t = SigAtt of string |
|
| 123 |
let pp_signal_attribute fmt sa = match sa with |
|
| 124 |
| SigAtt s -> Format.fprintf fmt "'%s" s |
|
| 125 |
let signal_att = [ "event"; "stable"; "last_value" ] |
|
| 131 |
type vhdl_parameter_t = |
|
| 132 |
{
|
|
| 133 |
names: vhdl_name_t list; |
|
| 134 |
mode: string list [@default []]; |
|
| 135 |
typ: vhdl_subtype_indication_t; |
|
| 136 |
init_val: vhdl_cst_val_t option [@default Some (CstInt (0))]; |
|
| 137 |
} |
|
| 138 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 126 | 139 |
|
| 127 |
type vhdl_string_attributes_t = StringAtt of string |
|
| 128 |
let pp_string_attribute fmt sa = match sa with |
|
| 129 |
| StringAtt s -> Format.fprintf fmt "'%s" s |
|
| 130 |
let signal_att = [ "simple_name"; "path_name"; "instance_name" ] |
|
| 140 |
type vhdl_subprogram_spec_t = |
|
| 141 |
{
|
|
| 142 |
name: string [@default ""]; |
|
| 143 |
typeMark: vhdl_name_t [@default NoName]; |
|
| 144 |
parameters: vhdl_parameter_t list; |
|
| 145 |
isPure: bool [@default false]; |
|
| 146 |
} |
|
| 147 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 131 | 148 |
|
| 132 | 149 |
(************************************************************************************) |
| 133 | 150 |
(* Expressions / Statements *) |
| 134 | 151 |
(************************************************************************************) |
| 135 | 152 |
|
| 136 |
|
|
| 137 |
(* TODO: call to functions? procedures? component instanciations ? *) |
|
| 138 |
|
|
| 139 |
type suffix_selection_t = Idx of int | Range of int * int |
|
| 140 |
let pp_suffix_selection fmt sel = |
|
| 141 |
match sel with |
|
| 142 |
| Idx n -> Format.fprintf fmt "(%i)" n |
|
| 143 |
| Range(n,m) -> Format.fprintf fmt "(%i downto %i)" n m |
|
| 144 |
|
|
| 145 |
type vhdl_expr_t = |
|
| 146 |
| Cst of cst_val_t |
|
| 147 |
| Var of string (* a signal or a variable *) |
|
| 148 |
| Sig of { name: string; att: vhdl_signal_attributes_t option }
|
|
| 149 |
| SuffixMod of { expr : vhdl_expr_t; selection : suffix_selection_t }
|
|
| 150 |
| Op of { id: string; args: vhdl_expr_t list }
|
|
| 151 |
|
|
| 152 |
let rec pp_vhdl_expr fmt e = |
|
| 153 |
match e with |
|
| 154 |
| Cst c -> pp_cst_val fmt c |
|
| 155 |
| Var s -> Format.fprintf fmt "%s" s |
|
| 156 |
| Sig s -> Format.fprintf |
|
| 157 |
fmt |
|
| 158 |
"%s%t" |
|
| 159 |
s.name |
|
| 160 |
(fun fmt -> match s.att with None -> () | Some att -> pp_signal_attribute fmt att) |
|
| 161 |
| SuffixMod s -> |
|
| 162 |
Format.fprintf fmt "%a %a" |
|
| 163 |
pp_vhdl_expr s.expr |
|
| 164 |
pp_suffix_selection s.selection |
|
| 165 |
| Op op -> ( |
|
| 166 |
match op.args with |
|
| 167 |
| [] -> assert false |
|
| 168 |
| [ e1; e2] -> Format.fprintf fmt "@[<hov 3>%a %s %a@]" pp_vhdl_expr e1 op.id pp_vhdl_expr e2 |
|
| 169 |
| _ -> assert false (* all ops are binary up to now *) |
|
| 170 |
(* | _ -> Format.fprintf fmt "@[<hov 3>%s (%a)@]" op.id (Utils.fprintf_list ~sep:",@ " pp_vhdl_expr) op.args *) |
|
| 171 |
) |
|
| 172 |
|
|
| 173 |
(* Available operators in the standard library. There are some restrictions on |
|
| 174 |
types. See reference doc. *) |
|
| 175 |
let arith_funs = ["+";"-";"*";"/";"mod"; "rem";"abs";"**"] |
|
| 153 |
let arith_funs = ["+";"-";"*";"/";"mod"; "rem";"abs";"**";"&"] |
|
| 176 | 154 |
let bool_funs = ["and"; "or"; "nand"; "nor"; "xor"; "not"] |
| 177 |
let rel_funs = ["<";">";"<=";">=";"/=";"="] |
|
| 178 |
|
|
| 179 |
|
|
| 180 |
type vhdl_if_case_t = {
|
|
| 155 |
let rel_funs = ["<";">";"<=";">=";"/=";"=";"?=";"?/=";"?<";"?<=";"?>";"?>=";"??"] |
|
| 156 |
let shift_funs = ["sll";"srl";"sla";"sra";"rol";"ror"] |
|
| 157 |
|
|
| 158 |
type vhdl_sequential_stmt_t = |
|
| 159 |
| VarAssign of { label: vhdl_name_t [@default NoName]; lhs: vhdl_name_t; rhs: vhdl_expr_t } [@name "VARIABLE_ASSIGNMENT_STATEMENT"]
|
|
| 160 |
| SigSeqAssign of { label: vhdl_name_t [@default NoName]; lhs: vhdl_name_t; rhs: vhdl_expr_t list} [@name "SIGNAL_ASSIGNMENT_STATEMENT"]
|
|
| 161 |
| If of { label: vhdl_name_t [@default NoName]; if_cases: vhdl_if_case_t list;
|
|
| 162 |
default: vhdl_sequential_stmt_t list [@default []]; } [@name "IF_STATEMENT"] |
|
| 163 |
| Case of { label: vhdl_name_t [@default NoName]; guard: vhdl_expr_t; branches: vhdl_case_item_t list } [@name "CASE_STATEMENT_TREE"]
|
|
| 164 |
| 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"]
|
|
| 165 |
| 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"]
|
|
| 166 |
| Wait [@name "WAIT_STATEMENT"] |
|
| 167 |
| Null of { label: vhdl_name_t [@default NoName]} [@name "NULL_STATEMENT"]
|
|
| 168 |
| Return of { label: vhdl_name_t [@default NoName]} [@name "RETURN_STATEMENT"]
|
|
| 169 |
and vhdl_if_case_t = |
|
| 170 |
{
|
|
| 181 | 171 |
if_cond: vhdl_expr_t; |
| 182 | 172 |
if_block: vhdl_sequential_stmt_t list; |
| 183 |
} |
|
| 184 |
and vhdl_sequential_stmt_t = |
|
| 185 |
| VarAssign of { lhs: string; rhs: vhdl_expr_t }
|
|
| 186 |
| SigSeqAssign of { lhs: string; rhs: vhdl_expr_t }
|
|
| 187 |
| If of { if_cases: vhdl_if_case_t list;
|
|
| 188 |
default: (vhdl_sequential_stmt_t list) option; } |
|
| 189 |
| Case of { guard: vhdl_expr_t; branches: vhdl_case_item_t list }
|
|
| 190 |
and vhdl_case_item_t = {
|
|
| 191 |
when_cond: vhdl_expr_t; |
|
| 192 |
when_stmt: vhdl_sequential_stmt_t; |
|
| 193 | 173 |
} |
| 174 |
and vhdl_case_item_t = |
|
| 175 |
{
|
|
| 176 |
when_cond: vhdl_expr_t list; |
|
| 177 |
when_stmt: vhdl_sequential_stmt_t list; |
|
| 178 |
} |
|
| 179 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 194 | 180 |
|
| 195 |
|
|
| 196 |
|
|
| 197 |
let rec pp_vhdl_sequential_stmt fmt stmt = |
|
| 198 |
match stmt with |
|
| 199 |
| VarAssign va -> Format.fprintf fmt "%s := %a;" va.lhs pp_vhdl_expr va.rhs |
|
| 200 |
| SigSeqAssign va -> Format.fprintf fmt "%s <= %a;" va.lhs pp_vhdl_expr va.rhs |
|
| 201 |
| If ifva -> ( |
|
| 202 |
List.iteri (fun idx ifcase -> |
|
| 203 |
if idx = 0 then |
|
| 204 |
Format.fprintf fmt "@[<v 3>if" |
|
| 205 |
else |
|
| 206 |
Format.fprintf fmt "@ @[<v 3>elsif"; |
|
| 207 |
Format.fprintf fmt " %a then@ %a@]" |
|
| 208 |
pp_vhdl_expr ifcase.if_cond |
|
| 209 |
pp_vhdl_sequential_stmts ifcase.if_block |
|
| 210 |
) ifva.if_cases; |
|
| 211 |
let _ = |
|
| 212 |
match ifva.default with |
|
| 213 |
| None -> () |
|
| 214 |
| Some bl -> Format.fprintf fmt "@ @[<v 3>else@ %a@]" pp_vhdl_sequential_stmts bl |
|
| 215 |
in |
|
| 216 |
Format.fprintf fmt "@ end if;" |
|
| 217 |
) |
|
| 218 |
| Case caseva -> ( |
|
| 219 |
Format.fprintf fmt "@[<v 3>case %a is@ %a@]@ end case;" |
|
| 220 |
pp_vhdl_expr caseva.guard |
|
| 221 |
(Utils.fprintf_list ~sep:"@ " pp_vhdl_case) caseva.branches |
|
| 222 |
) |
|
| 223 |
|
|
| 224 |
|
|
| 225 |
and pp_vhdl_sequential_stmts fmt l = Utils.fprintf_list ~sep:"@ " pp_vhdl_sequential_stmt fmt l |
|
| 226 |
and pp_vhdl_case fmt case = |
|
| 227 |
Format.fprintf fmt "when %a => %a" |
|
| 228 |
pp_vhdl_expr case.when_cond |
|
| 229 |
pp_vhdl_sequential_stmt case.when_stmt |
|
| 230 |
|
|
| 231 |
type signal_condition_t = |
|
| 181 |
type vhdl_declaration_t = |
|
| 182 |
| VarDecl of {
|
|
| 183 |
names : vhdl_name_t list; |
|
| 184 |
typ : vhdl_subtype_indication_t; |
|
| 185 |
init_val : vhdl_cst_val_t option [@default Some (CstInt (0))] |
|
| 186 |
} [@name "VARIABLE_DECLARATION"] |
|
| 187 |
| CstDecl of {
|
|
| 188 |
names : vhdl_name_t list; |
|
| 189 |
typ : vhdl_subtype_indication_t; |
|
| 190 |
init_val : vhdl_cst_val_t |
|
| 191 |
} [@name "CONSTANT_DECLARATION"] |
|
| 192 |
| SigDecl of {
|
|
| 193 |
names : vhdl_name_t list; |
|
| 194 |
typ : vhdl_subtype_indication_t; |
|
| 195 |
init_val : vhdl_cst_val_t option [@default Some (CstInt (0))] |
|
| 196 |
} [@name "SIGNAL_DECLARATION"] |
|
| 197 |
| Subprogram of {
|
|
| 198 |
name: vhdl_name_t [@default NoName]; |
|
| 199 |
kind: string [@default ""]; |
|
| 200 |
spec: vhdl_subprogram_spec_t [@default {name="";typeMark=NoName;parameters=[];isPure=false}];
|
|
| 201 |
decl_part: vhdl_declaration_t list [@default []]; |
|
| 202 |
stmts: vhdl_sequential_stmt_t list [@default []] |
|
| 203 |
} [@name "SUBPROGRAM_BODY"] |
|
| 204 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 205 |
|
|
| 206 |
type vhdl_signal_condition_t = |
|
| 232 | 207 |
{
|
| 233 |
expr: vhdl_expr_t; (* when expression *) |
|
| 234 |
else_case: vhdl_expr_t option; (* optional else case expression.
|
|
| 208 |
expr: vhdl_expr_t list; (* when expression *)
|
|
| 209 |
cond: vhdl_expr_t [@default IsNull]; (* optional else case expression.
|
|
| 235 | 210 |
If None, could be a latch *) |
| 236 | 211 |
} |
| 212 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 237 | 213 |
|
| 238 |
type signal_selection_t = |
|
| 214 |
type vhdl_signal_selection_t =
|
|
| 239 | 215 |
{
|
| 240 |
sel_lhs: string; |
|
| 241 | 216 |
expr : vhdl_expr_t; |
| 242 |
when_sel: vhdl_expr_t option;
|
|
| 217 |
when_sel: vhdl_expr_t list [@default []];
|
|
| 243 | 218 |
} |
| 219 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 244 | 220 |
|
| 245 |
type conditional_signal_t = |
|
| 221 |
type vhdl_conditional_signal_t =
|
|
| 246 | 222 |
{
|
| 247 |
lhs: string; (* assigned signal *) |
|
| 248 |
rhs: vhdl_expr_t; (* expression *) |
|
| 249 |
cond: signal_condition_t option (* conditional signal statement *) |
|
| 223 |
postponed: bool [@default false]; |
|
| 224 |
label: vhdl_name_t [@default NoName]; |
|
| 225 |
lhs: vhdl_name_t; (* assigned signal = target*) |
|
| 226 |
rhs: vhdl_signal_condition_t list; (* expression *) |
|
| 227 |
cond: vhdl_expr_t [@default IsNull]; |
|
| 228 |
delay: vhdl_expr_t [@default IsNull]; |
|
| 250 | 229 |
} |
| 251 |
|
|
| 252 |
type process_t = |
|
| 253 |
{ id: string option; active_sigs: string list; body: vhdl_sequential_stmt_t list }
|
|
| 254 |
|
|
| 255 |
type selected_signal_t = { sel: vhdl_expr_t; branches: signal_selection_t list }
|
|
| 230 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 231 |
|
|
| 232 |
type vhdl_process_t = |
|
| 233 |
{
|
|
| 234 |
id: vhdl_name_t [@default NoName]; |
|
| 235 |
declarations: vhdl_declaration_t list option [@key "PROCESS_DECLARATIVE_PART"] [@default Some []]; |
|
| 236 |
active_sigs: vhdl_name_t list [@default []]; |
|
| 237 |
body: vhdl_sequential_stmt_t list [@key "PROCESS_STATEMENT_PART"] [@default []] |
|
| 238 |
} |
|
| 239 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 240 |
|
|
| 241 |
type vhdl_selected_signal_t = |
|
| 242 |
{
|
|
| 243 |
postponed: bool [@default false]; |
|
| 244 |
label: vhdl_name_t [@default NoName]; |
|
| 245 |
lhs: vhdl_name_t; (* assigned signal = target *) |
|
| 246 |
sel: vhdl_expr_t; |
|
| 247 |
branches: vhdl_signal_selection_t list [@default []]; |
|
| 248 |
delay: vhdl_expr_t option; |
|
| 249 |
} |
|
| 250 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 256 | 251 |
|
| 257 | 252 |
type vhdl_concurrent_stmt_t = |
| 258 |
| SigAssign of conditional_signal_t |
|
| 259 |
| Process of process_t |
|
| 260 |
| SelectedSig of selected_signal_t |
|
| 253 |
| SigAssign of vhdl_conditional_signal_t [@name "CONDITIONAL_SIGNAL_ASSIGNMENT"] |
|
| 254 |
| Process of vhdl_process_t [@name "PROCESS_STATEMENT"] |
|
| 255 |
| SelectedSig of vhdl_selected_signal_t [@name "SELECTED_SIGNAL_ASSIGNMENT"] |
|
| 256 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 261 | 257 |
(* |
| 262 | 258 |
type vhdl_statement_t = |
| 263 | 259 |
|
| ... | ... | |
| 266 | 262 |
| SequentialStmt of vhdl_sequential_stmt_t |
| 267 | 263 |
*) |
| 268 | 264 |
|
| 269 |
let pp_vhdl_concurrent_stmt fmt stmt = |
|
| 270 |
let pp_sig_cond fmt va = |
|
| 271 |
Format.fprintf |
|
| 272 |
fmt |
|
| 273 |
"%s <= %a%t;" |
|
| 274 |
va.lhs |
|
| 275 |
pp_vhdl_expr va.rhs |
|
| 276 |
(fun fmt -> match va.cond with |
|
| 277 |
| None -> () |
|
| 278 |
| Some cond -> |
|
| 279 |
Format.fprintf |
|
| 280 |
fmt |
|
| 281 |
" when %a%t" |
|
| 282 |
pp_vhdl_expr cond.expr |
|
| 283 |
(fun fmt -> match cond.else_case with |
|
| 284 |
| None -> () |
|
| 285 |
| Some else_case -> |
|
| 286 |
Format.fprintf |
|
| 287 |
fmt |
|
| 288 |
" else %a" |
|
| 289 |
pp_vhdl_expr else_case |
|
| 290 |
) |
|
| 291 |
) |
|
| 292 |
in |
|
| 293 |
let pp_process fmt p = |
|
| 294 |
Format.fprintf |
|
| 295 |
fmt |
|
| 296 |
"@[<v 0>%tprocess %a@ @[<v 3>begin@ %a@]@ end process;@]" |
|
| 297 |
(fun fmt -> match p.id with Some id -> Format.fprintf fmt "%s: " id| None -> ()) |
|
| 298 |
(fun fmt asigs -> |
|
| 299 |
if asigs <> [] then |
|
| 300 |
Format.fprintf |
|
| 301 |
fmt |
|
| 302 |
"(@[<hov 0>%a)@]" |
|
| 303 |
(Utils.fprintf_list ~sep:",@ " Format.pp_print_string) asigs) |
|
| 304 |
p.active_sigs |
|
| 305 |
(Utils.fprintf_list ~sep:"@ " pp_vhdl_sequential_stmt) p.body |
|
| 306 |
in |
|
| 307 |
let pp_sig_sel fmt va = |
|
| 308 |
Format.fprintf fmt "@[<v 3>with %a select@ %a;@]" |
|
| 309 |
pp_vhdl_expr va.sel |
|
| 310 |
(Utils.fprintf_list |
|
| 311 |
~sep:"@ " |
|
| 312 |
(fun fmt b -> |
|
| 313 |
Format.fprintf |
|
| 314 |
fmt |
|
| 315 |
"%s <= %a when %t" |
|
| 316 |
b.sel_lhs |
|
| 317 |
pp_vhdl_expr b.expr |
|
| 318 |
(fun fmt -> match b.when_sel with |
|
| 319 |
| None -> Format.fprintf fmt "others" |
|
| 320 |
| Some w -> pp_vhdl_expr fmt w |
|
| 321 |
)) |
|
| 322 |
) va.branches in |
|
| 323 |
match stmt with |
|
| 324 |
| SigAssign va -> pp_sig_cond fmt va |
|
| 325 |
| Process p -> pp_process fmt p |
|
| 326 |
| SelectedSig va -> pp_sig_sel fmt va |
|
| 327 |
|
|
| 328 |
|
|
| 329 |
|
|
| 330 |
|
|
| 331 |
|
|
| 332 |
|
|
| 333 |
|
|
| 334 | 265 |
(************************************************************************************) |
| 335 | 266 |
(* Entities *) |
| 336 | 267 |
(************************************************************************************) |
| 337 | 268 |
|
| 338 |
(* TODO? Seems to appear optionally in entities *) |
|
| 339 |
type vhdl_generic_t = unit |
|
| 340 |
let pp_vhdl_generic fmt g = () |
|
| 341 |
|
|
| 342 |
|
|
| 343 |
type vhdl_port_kind_t = InPort | OutPort | InoutPort | BufferPort |
|
| 344 |
let pp_vhdl_port_kind fmt p = |
|
| 345 |
match p with |
|
| 346 |
| InPort -> Format.fprintf fmt "in" |
|
| 347 |
| OutPort -> Format.fprintf fmt "in" |
|
| 348 |
| InoutPort -> Format.fprintf fmt "inout" |
|
| 349 |
| BufferPort -> Format.fprintf fmt "buffer" |
|
| 350 |
|
|
| 351 |
|
|
| 269 |
type vhdl_port_mode_t = |
|
| 270 |
InPort [@name "in"] |
|
| 271 |
| OutPort [@name "out"] |
|
| 272 |
| InoutPort [@name "inout"] |
|
| 273 |
| BufferPort [@name "buffer"] |
|
| 274 |
[@@deriving show { with_path = false }, yojson];;
|
|
| 275 |
|
|
| 352 | 276 |
type vhdl_port_t = |
| 353 | 277 |
{
|
| 354 |
name: string; |
|
| 355 |
kind: vhdl_port_kind_t; |
|
| 356 |
typ: vhdl_type_t; |
|
| 278 |
names: vhdl_name_t list [@default []]; |
|
| 279 |
mode: vhdl_port_mode_t [@default InPort]; |
|
| 280 |
typ: vhdl_subtype_indication_t; |
|
| 281 |
expr: vhdl_expr_t [@default IsNull]; |
|
| 357 | 282 |
} |
| 283 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 358 | 284 |
|
| 359 |
let pp_vhdl_port fmt p = |
|
| 360 |
Format.fprintf fmt "%s : %a %a" |
|
| 361 |
p.name |
|
| 362 |
pp_vhdl_port_kind p.kind |
|
| 363 |
pp_vhdl_type p.typ |
|
| 364 |
|
|
| 365 |
|
|
| 366 | 285 |
type vhdl_entity_t = |
| 367 | 286 |
{
|
| 368 |
name: string; |
|
| 369 |
generics: vhdl_generic_t list; |
|
| 370 |
ports: vhdl_port_t list; |
|
| 287 |
name: vhdl_name_t [@default NoName]; |
|
| 288 |
generics: vhdl_port_t list [@default []]; |
|
| 289 |
ports: vhdl_port_t list [@default []]; |
|
| 290 |
declaration: vhdl_declaration_t list [@key "ENTITY_DECLARATIVE_PART"] [@default []]; |
|
| 291 |
stmts: vhdl_concurrent_stmt_t list [@key "ENTITY_STATEMENT_PART"] [@default []]; |
|
| 371 | 292 |
} |
| 372 |
let pp_vhdl_entity fmt e = |
|
| 373 |
Format.fprintf |
|
| 374 |
fmt |
|
| 375 |
"@[<v 3>entity %s is@ %t%t@]@ end %s;@ " |
|
| 376 |
e.name |
|
| 377 |
(fun fmt -> List.iter (fun g -> Format.fprintf fmt "generic %a;@ " pp_vhdl_generic g) e.generics) |
|
| 378 |
(fun fmt -> |
|
| 379 |
if e.ports = [] then () else |
|
| 380 |
Format.fprintf fmt "port (@[<hov 0>%a@]);" (Utils.fprintf_list ~sep:",@ " pp_vhdl_port) e.ports) |
|
| 381 |
e.name |
|
| 382 |
|
|
| 383 |
|
|
| 384 |
|
|
| 293 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 385 | 294 |
|
| 386 | 295 |
(************************************************************************************) |
| 387 | 296 |
(* Packages / Library loading *) |
| 388 | 297 |
(************************************************************************************) |
| 389 |
|
|
| 390 |
|
|
| 391 | 298 |
|
| 392 | 299 |
(* Optional. Describes shared definitions *) |
| 393 | 300 |
type vhdl_package_t = |
| 394 | 301 |
{
|
| 395 |
name: string;
|
|
| 396 |
shared_defs: vhdl_definition_t list; |
|
| 302 |
name: vhdl_name_t [@default NoName];
|
|
| 303 |
shared_defs: vhdl_definition_t list [@default []];
|
|
| 397 | 304 |
} |
| 305 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 398 | 306 |
|
| 399 |
let pp_vhdl_package fmt p = |
|
| 400 |
Format.fprintf |
|
| 401 |
fmt |
|
| 402 |
"@[<v 3>package %s is@ %a@]@ end %s;@ " |
|
| 403 |
p.name |
|
| 404 |
(Utils.fprintf_list ~sep:"@ " pp_vhdl_definition) p.shared_defs |
|
| 405 |
p.name |
|
| 406 |
|
|
| 407 |
type vhdl_load_t = Library of string | Use of string list |
|
| 408 |
let pp_vhdl_load fmt l = |
|
| 409 |
match l with |
|
| 410 |
| Library s -> Format.fprintf fmt "library %s;@ " s |
|
| 411 |
| Use sl -> Format.fprintf fmt "use %a;@ " (Utils.fprintf_list ~sep:"." Format.pp_print_string) sl |
|
| 412 |
|
|
| 307 |
type vhdl_load_t = |
|
| 308 |
Library of vhdl_name_t list [@name "LIBRARY_CLAUSE"] [@default []] |
|
| 309 |
| Use of vhdl_name_t list [@name "USE_CLAUSE"] [@default []] |
|
| 310 |
[@@deriving show { with_path = false }, yojson];;
|
|
| 413 | 311 |
|
| 414 | 312 |
(************************************************************************************) |
| 415 | 313 |
(* Architecture / VHDL Design *) |
| 416 | 314 |
(************************************************************************************) |
| 417 | 315 |
|
| 418 |
|
|
| 419 | 316 |
type vhdl_architecture_t = |
| 420 | 317 |
{
|
| 421 |
name: string;
|
|
| 422 |
entity: string;
|
|
| 423 |
declarations: vhdl_declaration_t list; |
|
| 424 |
body: vhdl_concurrent_stmt_t list;
|
|
| 318 |
name: vhdl_name_t [@default NoName];
|
|
| 319 |
entity: vhdl_name_t [@default NoName];
|
|
| 320 |
declarations: vhdl_declaration_t list [@key "ARCHITECTURE_DECLARATIVE_PART"] [@default []];
|
|
| 321 |
body: vhdl_concurrent_stmt_t list [@key "ARCHITECTURE_STATEMENT_PART"] [@default []];
|
|
| 425 | 322 |
} |
| 323 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 426 | 324 |
|
| 427 |
let pp_vhdl_architecture fmt a = |
|
| 428 |
Format.fprintf |
|
| 429 |
fmt |
|
| 430 |
"@[<v 3>architecture %s of %s is@ %a@]@ @[<v 3>begin@ %a@]@ end %s;" |
|
| 431 |
a.name |
|
| 432 |
a.entity |
|
| 433 |
(Utils.fprintf_list ~sep:"@ " pp_vhdl_declaration) a.declarations |
|
| 434 |
(Utils.fprintf_list ~sep:"@ " pp_vhdl_concurrent_stmt) a.body |
|
| 435 |
a.name |
|
| 436 |
|
|
| 437 |
|
|
| 438 |
(* TODO. Configuraiton is optional *) |
|
| 325 |
(* TODO. Configuration is optional *) |
|
| 439 | 326 |
type vhdl_configuration_t = unit |
| 440 |
let pp_vhdl_configuration fmt c = ()
|
|
| 327 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 441 | 328 |
|
| 329 |
type vhdl_library_unit_t = (* TODO: PACKAGE_BODY *) |
|
| 330 |
Package of vhdl_package_t [@name "PACKAGE_DECLARATION"] |
|
| 331 |
| Entities of vhdl_entity_t [@name "ENTITY_DECLARATION"] |
|
| 332 |
| Architecture of vhdl_architecture_t [@name "ARCHITECTURE_BODY"] |
|
| 333 |
| Configuration of vhdl_configuration_t [@name "CONFIGURATION_DECLARATION"] |
|
| 334 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 442 | 335 |
|
| 336 |
type vhdl_design_unit_t = |
|
| 337 |
{
|
|
| 338 |
contexts: vhdl_load_t list [@default []]; |
|
| 339 |
library: vhdl_library_unit_t; |
|
| 340 |
} |
|
| 341 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 443 | 342 |
|
| 444 |
type vhdl_design_t = |
|
| 343 |
type vhdl_design_file_t =
|
|
| 445 | 344 |
{
|
| 446 |
packages: vhdl_package_t list; |
|
| 447 |
libraries: vhdl_load_t list; |
|
| 448 |
entities: vhdl_entity_t list; |
|
| 449 |
architectures: vhdl_architecture_t list; |
|
| 450 |
configuration: vhdl_configuration_t option; |
|
| 345 |
design_units: vhdl_design_unit_t list [@default []]; |
|
| 451 | 346 |
} |
| 347 |
[@@deriving show { with_path = false }, yojson {strict = false}];;
|
|
| 452 | 348 |
|
| 453 |
let pp_vhdl_design fmt d = |
|
| 454 |
Format.fprintf |
|
| 455 |
fmt |
|
| 456 |
"@[<v 0>%a%t%a%t%a%t%a%t@]" |
|
| 457 |
(Utils.fprintf_list ~sep:"@ " pp_vhdl_package) d.packages |
|
| 458 |
(fun fmt -> if d.packages <> [] then Format.fprintf fmt "@ ") |
|
| 459 |
(Utils.fprintf_list ~sep:"@ " pp_vhdl_load) d.libraries |
|
| 460 |
(fun fmt -> if d.libraries <> [] then Format.fprintf fmt "@ ") |
|
| 461 |
(Utils.fprintf_list ~sep:"@ " pp_vhdl_entity) d.entities |
|
| 462 |
(fun fmt -> if d.entities <> [] then Format.fprintf fmt "@ ") |
|
| 463 |
(Utils.fprintf_list ~sep:"@ " pp_vhdl_architecture) d.architectures |
|
| 464 |
(fun fmt -> if d.architectures <> [] then Format.fprintf fmt "@ ") |
|
| 349 |
type vhdl_file_t = |
|
| 350 |
{
|
|
| 351 |
design_file: vhdl_design_file_t [@default {design_units=[]}] [@key "DESIGN_FILE"];
|
|
| 352 |
} |
|
| 353 |
[@@deriving show { with_path = false }, yojson];;
|
|
| src/backends/VHDL/vhdl_ast_deriving.ml | ||
|---|---|---|
| 1 |
let base_types = |
|
| 2 |
["integer"; |
|
| 3 |
"character"; |
|
| 4 |
"bit"; |
|
| 5 |
"real"; |
|
| 6 |
"natural"; |
|
| 7 |
"positive"; |
|
| 8 |
"std_logic"; |
|
| 9 |
"std_logic_vector"] |
|
| 10 |
let std_logic_cst = ["U"; "X"; "0"; "1"; "Z"; "W"; "L"; "H"; "-"] |
|
| 11 |
let literal_base = ["B"; "O"; "X"; "UB"; "UO"; "UX"; "SB"; "SO"; "SX"; "D"] |
|
| 12 |
type vhdl_cst_val_t = |
|
| 13 |
| CstInt of int |
|
| 14 |
| CstStdLogic of string |
|
| 15 |
| CstLiteral of string [@name "CST_LITERAL"] |
|
| 16 |
|
|
| 17 |
let rec (pp_vhdl_cst_val_t : |
|
| 18 |
Format.formatter -> vhdl_cst_val_t -> Ppx_deriving_runtime.unit) |
|
| 19 |
= |
|
| 20 |
((let open! Ppx_deriving_runtime in |
|
| 21 |
fun fmt -> |
|
| 22 |
function |
|
| 23 |
| CstInt a0 -> |
|
| 24 |
(Format.fprintf fmt "(@[<2>CstInt@ "; |
|
| 25 |
(Format.fprintf fmt "%d") a0; |
|
| 26 |
Format.fprintf fmt "@])") |
|
| 27 |
| CstStdLogic a0 -> |
|
| 28 |
(Format.fprintf fmt "(@[<2>CstStdLogic@ "; |
|
| 29 |
(Format.fprintf fmt "%S") a0; |
|
| 30 |
Format.fprintf fmt "@])") |
|
| 31 |
| CstLiteral a0 -> |
|
| 32 |
(Format.fprintf fmt "(@[<2>CstLiteral@ "; |
|
| 33 |
(Format.fprintf fmt "%S") a0; |
|
| 34 |
Format.fprintf fmt "@])")) |
|
| 35 |
[@ocaml.warning "-A"]) |
|
| 36 |
|
|
| 37 |
and show_vhdl_cst_val_t : vhdl_cst_val_t -> Ppx_deriving_runtime.string = |
|
| 38 |
fun x -> Format.asprintf "%a" pp_vhdl_cst_val_t x |
|
| 39 |
|
|
| 40 |
let rec (vhdl_cst_val_t_to_yojson : vhdl_cst_val_t -> Yojson.Safe.json) = |
|
| 41 |
((let open! Ppx_deriving_yojson_runtime in |
|
| 42 |
function |
|
| 43 |
| CstInt arg0 -> |
|
| 44 |
`List |
|
| 45 |
[`String "CstInt"; |
|
| 46 |
((fun (x : Ppx_deriving_runtime.int) -> `Int x)) arg0] |
|
| 47 |
| CstStdLogic arg0 -> |
|
| 48 |
`List |
|
| 49 |
[`String "CstStdLogic"; |
|
| 50 |
((fun (x : Ppx_deriving_runtime.string) -> `String x)) arg0] |
|
| 51 |
| CstLiteral arg0 -> |
|
| 52 |
`List |
|
| 53 |
[`String "CST_LITERAL"; |
|
| 54 |
((fun (x : Ppx_deriving_runtime.string) -> `String x)) arg0]) |
|
| 55 |
[@ocaml.warning "-A"]) |
|
| 56 |
|
|
| 57 |
and (vhdl_cst_val_t_of_yojson : |
|
| 58 |
Yojson.Safe.json -> vhdl_cst_val_t Ppx_deriving_yojson_runtime.error_or) |
|
| 59 |
= |
|
| 60 |
((let open! Ppx_deriving_yojson_runtime in |
|
| 61 |
function |
|
| 62 |
| `List ((`String "CstInt")::arg0::[]) -> |
|
| 63 |
((function |
|
| 64 |
| `Int x -> Result.Ok x |
|
| 65 |
| _ -> Result.Error "Vhdl_ast.vhdl_cst_val_t") arg0) >>= |
|
| 66 |
((fun arg0 -> Result.Ok (CstInt arg0))) |
|
| 67 |
| `List ((`String "CstStdLogic")::arg0::[]) -> |
|
| 68 |
((function |
|
| 69 |
| `String x -> Result.Ok x |
|
| 70 |
| _ -> Result.Error "Vhdl_ast.vhdl_cst_val_t") arg0) >>= |
|
| 71 |
((fun arg0 -> Result.Ok (CstStdLogic arg0))) |
|
| 72 |
| `List ((`String "CST_LITERAL")::arg0::[]) -> |
|
| 73 |
((function |
|
| 74 |
| `String x -> Result.Ok x |
|
| 75 |
| _ -> Result.Error "Vhdl_ast.vhdl_cst_val_t") arg0) >>= |
|
| 76 |
((fun arg0 -> Result.Ok (CstLiteral arg0))) |
|
| 77 |
| _ -> Result.Error "Vhdl_ast.vhdl_cst_val_t") |
|
| 78 |
[@ocaml.warning "-A"]) |
|
| 79 |
|
|
| 80 |
type vhdl_type_t = |
|
| 81 |
| Base of string |
|
| 82 |
| Range of string option * int * int |
|
| 83 |
| Bit_vector of int * int |
|
| 84 |
| Array of int * int * vhdl_type_t |
|
| 85 |
| Enumerated of string list |
|
| 86 |
| Void |
|
| 87 |
and vhdl_subtype_indication_t = |
|
| 88 |
{
|
|
| 89 |
name: vhdl_name_t [@default NoName]; |
|
| 90 |
functionName: vhdl_name_t [@default NoName]; |
|
| 91 |
const: vhdl_constraint_t [@default NoConstraint]} |
|
| 92 |
and vhdl_discrete_range_t = |
|
| 93 |
| SubDiscreteRange of vhdl_subtype_indication_t |
|
| 94 |
[@name "SUB_DISCRETE_RANGE"] |
|
| 95 |
| NamedRange of vhdl_name_t [@name "NAMED_RANGE"] |
|
| 96 |
| DirectedRange of |
|
| 97 |
{
|
|
| 98 |
direction: string ; |
|
| 99 |
from: vhdl_expr_t ; |
|
| 100 |
_to: vhdl_expr_t } [@name "RANGE_WITH_DIRECTION"] |
|
| 101 |
and vhdl_constraint_t = |
|
| 102 |
| RefConstraint of {
|
|
| 103 |
ref_name: vhdl_name_t } |
|
| 104 |
| RangeConstraint of {
|
|
| 105 |
range: vhdl_discrete_range_t } [@name "RANGE_CONSTRAINT"] |
|
| 106 |
| IndexConstraint of {
|
|
| 107 |
ranges: vhdl_discrete_range_t list } [@name "INDEX_CONSTRAINT"] |
|
| 108 |
| ArrayConstraint of |
|
| 109 |
{
|
|
| 110 |
ranges: vhdl_discrete_range_t list ; |
|
| 111 |
sub: vhdl_constraint_t } [@name "ARRAY_CONSTRAINT"] |
|
| 112 |
| RecordConstraint |
|
| 113 |
| NoConstraint |
|
| 114 |
and vhdl_definition_t = |
|
| 115 |
| Type of {
|
|
| 116 |
name: vhdl_name_t ; |
|
| 117 |
definition: vhdl_type_t } [@name "TYPE_DECLARATION"] |
|
| 118 |
| Subtype of {
|
|
| 119 |
name: vhdl_name_t ; |
|
| 120 |
typ: vhdl_subtype_indication_t } [@name "SUBTYPE_DECLARATION"] |
|
| 121 |
and vhdl_expr_t = |
|
| 122 |
| Call of vhdl_name_t [@name "CALL"] |
|
| 123 |
| Cst of vhdl_cst_val_t [@name "CONSTANT_VALUE"] |
|
| 124 |
| Op of {
|
|
| 125 |
id: string [@default ""]; |
|
| 126 |
args: vhdl_expr_t list [@default []]} [@name "EXPRESSION"] |
|
| 127 |
| IsNull [@name "IsNull"] |
|
| 128 |
| Time of {
|
|
| 129 |
value: int ; |
|
| 130 |
phy_unit: string [@default ""]} |
|
| 131 |
| Sig of {
|
|
| 132 |
name: vhdl_name_t ; |
|
| 133 |
att: vhdl_signal_attributes_t option } |
|
| 134 |
| SuffixMod of {
|
|
| 135 |
expr: vhdl_expr_t ; |
|
| 136 |
selection: vhdl_suffix_selection_t } |
|
| 137 |
| Aggregate of {
|
|
| 138 |
elems: vhdl_element_assoc_t list } [@name "AGGREGATE"] |
|
| 139 |
| Others [@name "OTHERS"] |
|
| 140 |
and vhdl_name_t = |
|
| 141 |
| Simple of string [@name "SIMPLE_NAME"] |
|
| 142 |
| Identifier of string [@name "IDENTIFIER"] |
|
| 143 |
| Selected of vhdl_name_t list [@name "SELECTED_NAME"] |
|
| 144 |
| Index of {
|
|
| 145 |
id: vhdl_name_t ; |
|
| 146 |
exprs: vhdl_expr_t list } [@name "INDEXED_NAME"] |
|
| 147 |
| Slice of {
|
|
| 148 |
id: vhdl_name_t ; |
|
| 149 |
range: vhdl_discrete_range_t } [@name "SLICE_NAME"] |
|
| 150 |
| Attribute of |
|
| 151 |
{
|
|
| 152 |
id: vhdl_name_t ; |
|
| 153 |
designator: vhdl_name_t ; |
|
| 154 |
expr: vhdl_expr_t [@default IsNull]} [@name "ATTRIBUTE_NAME"] |
|
| 155 |
| Function of {
|
|
| 156 |
id: vhdl_name_t ; |
|
| 157 |
assoc_list: vhdl_assoc_element_t list } [@name "FUNCTION_CALL"] |
|
| 158 |
| NoName |
|
| 159 |
and vhdl_assoc_element_t = |
|
| 160 |
{
|
|
| 161 |
formal_name: vhdl_name_t option [@default Some NoName]; |
|
| 162 |
formal_arg: vhdl_name_t option [@default Some NoName]; |
|
| 163 |
actual_name: vhdl_name_t option [@default Some NoName]; |
|
| 164 |
actual_designator: vhdl_name_t option [@default Some NoName]; |
|
| 165 |
actual_expr: vhdl_expr_t option [@default Some IsNull]} |
|
| 166 |
and vhdl_element_assoc_t = {
|
|
| 167 |
choices: vhdl_expr_t list ; |
|
| 168 |
expr: vhdl_expr_t } |
|
| 169 |
and vhdl_array_attributes_t = |
|
| 170 |
| AAttInt of {
|
|
| 171 |
id: string ; |
|
| 172 |
arg: int } |
|
| 173 |
| AAttAscending |
|
| 174 |
and vhdl_signal_attributes_t = |
|
| 175 |
| SigAtt of string |
|
| 176 |
and vhdl_string_attributes_t = |
|
| 177 |
| StringAtt of string |
|
| 178 |
and vhdl_suffix_selection_t = |
|
| 179 |
| Idx of int |
|
| 180 |
| SuffixRange of int * int |
|
| 181 |
|
|
| 182 |
let rec pp_vhdl_type_t : |
|
| 183 |
Format.formatter -> vhdl_type_t -> Ppx_deriving_runtime.unit = |
|
| 184 |
let __0 () = pp_vhdl_type_t in |
|
| 185 |
((let open! Ppx_deriving_runtime in |
|
| 186 |
fun fmt -> |
|
| 187 |
function |
|
| 188 |
| Base a0 -> |
|
| 189 |
(Format.fprintf fmt "(@[<2>Base@ "; |
|
| 190 |
(Format.fprintf fmt "%S") a0; |
|
| 191 |
Format.fprintf fmt "@])") |
|
| 192 |
| Range (a0,a1,a2) -> |
|
| 193 |
(Format.fprintf fmt "(@[<2>Range (@,"; |
|
| 194 |
((((function |
|
| 195 |
| None -> Format.pp_print_string fmt "None" |
|
| 196 |
| Some x -> |
|
| 197 |
(Format.pp_print_string fmt "(Some "; |
|
| 198 |
(Format.fprintf fmt "%S") x; |
|
| 199 |
Format.pp_print_string fmt ")"))) a0; |
|
| 200 |
Format.fprintf fmt ",@ "; |
|
| 201 |
(Format.fprintf fmt "%d") a1); |
|
| 202 |
Format.fprintf fmt ",@ "; |
|
| 203 |
(Format.fprintf fmt "%d") a2); |
|
| 204 |
Format.fprintf fmt "@,))@]") |
|
| 205 |
| Bit_vector (a0,a1) -> |
|
| 206 |
(Format.fprintf fmt "(@[<2>Bit_vector (@,"; |
|
| 207 |
((Format.fprintf fmt "%d") a0; |
|
| 208 |
Format.fprintf fmt ",@ "; |
|
| 209 |
(Format.fprintf fmt "%d") a1); |
|
| 210 |
Format.fprintf fmt "@,))@]") |
|
| 211 |
| Array (a0,a1,a2) -> |
|
| 212 |
(Format.fprintf fmt "(@[<2>Array (@,"; |
|
| 213 |
(((Format.fprintf fmt "%d") a0; |
|
| 214 |
Format.fprintf fmt ",@ "; |
|
| 215 |
(Format.fprintf fmt "%d") a1); |
|
| 216 |
Format.fprintf fmt ",@ "; |
|
| 217 |
((__0 ()) fmt) a2); |
|
| 218 |
Format.fprintf fmt "@,))@]") |
|
| 219 |
| Enumerated a0 -> |
|
| 220 |
(Format.fprintf fmt "(@[<2>Enumerated@ "; |
|
| 221 |
((fun x -> |
|
| 222 |
Format.fprintf fmt "@[<2>["; |
|
| 223 |
ignore |
|
| 224 |
(List.fold_left |
|
| 225 |
(fun sep -> |
|
| 226 |
fun x -> |
|
| 227 |
if sep then Format.fprintf fmt ";@ "; |
|
| 228 |
(Format.fprintf fmt "%S") x; |
|
| 229 |
true) false x); |
|
| 230 |
Format.fprintf fmt "@,]@]")) a0; |
|
| 231 |
Format.fprintf fmt "@])") |
|
| 232 |
| Void -> Format.pp_print_string fmt "Void") |
|
| 233 |
[@ocaml.warning "-A"]) |
|
| 234 |
|
|
| 235 |
and show_vhdl_type_t : vhdl_type_t -> Ppx_deriving_runtime.string = |
|
| 236 |
fun x -> Format.asprintf "%a" pp_vhdl_type_t x |
|
| 237 |
|
|
| 238 |
and pp_vhdl_subtype_indication_t : |
|
| 239 |
Format.formatter -> vhdl_subtype_indication_t -> Ppx_deriving_runtime.unit |
|
| 240 |
= |
|
| 241 |
let __2 () = pp_vhdl_constraint_t |
|
| 242 |
|
|
| 243 |
and __1 () = pp_vhdl_name_t |
|
| 244 |
|
|
| 245 |
and __0 () = pp_vhdl_name_t |
|
| 246 |
in |
|
| 247 |
((let open! Ppx_deriving_runtime in |
|
| 248 |
fun fmt -> |
|
| 249 |
fun x -> |
|
| 250 |
Format.fprintf fmt "@[<2>{ ";
|
|
| 251 |
(((Format.fprintf fmt "@[%s =@ " "name"; |
|
| 252 |
((__0 ()) fmt) x.name; |
|
| 253 |
Format.fprintf fmt "@]"); |
|
| 254 |
Format.fprintf fmt ";@ "; |
|
| 255 |
Format.fprintf fmt "@[%s =@ " "functionName"; |
|
| 256 |
((__1 ()) fmt) x.functionName; |
|
| 257 |
Format.fprintf fmt "@]"); |
|
| 258 |
Format.fprintf fmt ";@ "; |
|
| 259 |
Format.fprintf fmt "@[%s =@ " "const"; |
|
| 260 |
((__2 ()) fmt) x.const; |
|
| 261 |
Format.fprintf fmt "@]"); |
|
| 262 |
Format.fprintf fmt "@ }@]") |
|
| 263 |
[@ocaml.warning "-A"]) |
|
| 264 |
|
|
| 265 |
and show_vhdl_subtype_indication_t : |
|
| 266 |
vhdl_subtype_indication_t -> Ppx_deriving_runtime.string = |
|
| 267 |
fun x -> Format.asprintf "%a" pp_vhdl_subtype_indication_t x |
|
| 268 |
|
|
| 269 |
and pp_vhdl_discrete_range_t : |
|
| 270 |
Format.formatter -> vhdl_discrete_range_t -> Ppx_deriving_runtime.unit = |
|
| 271 |
let __3 () = pp_vhdl_expr_t |
|
| 272 |
|
|
| 273 |
and __2 () = pp_vhdl_expr_t |
|
| 274 |
|
|
| 275 |
and __1 () = pp_vhdl_name_t |
|
| 276 |
|
|
| 277 |
and __0 () = pp_vhdl_subtype_indication_t |
|
| 278 |
in |
|
| 279 |
((let open! Ppx_deriving_runtime in |
|
| 280 |
fun fmt -> |
|
| 281 |
function |
|
| 282 |
| SubDiscreteRange a0 -> |
|
| 283 |
(Format.fprintf fmt "(@[<2>SubDiscreteRange@ "; |
|
| 284 |
((__0 ()) fmt) a0; |
|
| 285 |
Format.fprintf fmt "@])") |
|
| 286 |
| NamedRange a0 -> |
|
| 287 |
(Format.fprintf fmt "(@[<2>NamedRange@ "; |
|
| 288 |
((__1 ()) fmt) a0; |
|
| 289 |
Format.fprintf fmt "@])") |
|
| 290 |
| DirectedRange { direction = adirection; from = afrom; _to = a_to }
|
|
| 291 |
-> |
|
| 292 |
(Format.fprintf fmt "@[<2>DirectedRange {@,";
|
|
| 293 |
(((Format.fprintf fmt "@[%s =@ " "direction"; |
|
| 294 |
(Format.fprintf fmt "%S") adirection; |
|
| 295 |
Format.fprintf fmt "@]"); |
|
| 296 |
Format.fprintf fmt ";@ "; |
|
| 297 |
Format.fprintf fmt "@[%s =@ " "from"; |
|
| 298 |
((__2 ()) fmt) afrom; |
|
| 299 |
Format.fprintf fmt "@]"); |
|
| 300 |
Format.fprintf fmt ";@ "; |
|
| 301 |
Format.fprintf fmt "@[%s =@ " "_to"; |
|
| 302 |
((__3 ()) fmt) a_to; |
|
| 303 |
Format.fprintf fmt "@]"); |
|
| 304 |
Format.fprintf fmt "@]}")) |
|
| 305 |
[@ocaml.warning "-A"]) |
|
| 306 |
|
|
| 307 |
and show_vhdl_discrete_range_t : |
|
| 308 |
vhdl_discrete_range_t -> Ppx_deriving_runtime.string = |
|
| 309 |
fun x -> Format.asprintf "%a" pp_vhdl_discrete_range_t x |
|
| 310 |
|
|
| 311 |
and pp_vhdl_constraint_t : |
|
| 312 |
Format.formatter -> vhdl_constraint_t -> Ppx_deriving_runtime.unit = |
|
| 313 |
let __4 () = pp_vhdl_constraint_t |
|
| 314 |
|
|
| 315 |
and __3 () = pp_vhdl_discrete_range_t |
|
| 316 |
|
|
| 317 |
and __2 () = pp_vhdl_discrete_range_t |
|
| 318 |
|
|
| 319 |
and __1 () = pp_vhdl_discrete_range_t |
|
| 320 |
|
|
| 321 |
and __0 () = pp_vhdl_name_t |
|
| 322 |
in |
|
| 323 |
((let open! Ppx_deriving_runtime in |
|
| 324 |
fun fmt -> |
|
| 325 |
function |
|
| 326 |
| RefConstraint { ref_name = aref_name } ->
|
|
| 327 |
(Format.fprintf fmt "@[<2>RefConstraint {@,";
|
|
| 328 |
(Format.fprintf fmt "@[%s =@ " "ref_name"; |
|
| 329 |
((__0 ()) fmt) aref_name; |
|
| 330 |
Format.fprintf fmt "@]"); |
|
| 331 |
Format.fprintf fmt "@]}") |
|
| 332 |
| RangeConstraint { range = arange } ->
|
|
| 333 |
(Format.fprintf fmt "@[<2>RangeConstraint {@,";
|
|
| 334 |
(Format.fprintf fmt "@[%s =@ " "range"; |
|
| 335 |
((__1 ()) fmt) arange; |
|
| 336 |
Format.fprintf fmt "@]"); |
|
| 337 |
Format.fprintf fmt "@]}") |
|
| 338 |
| IndexConstraint { ranges = aranges } ->
|
|
| 339 |
(Format.fprintf fmt "@[<2>IndexConstraint {@,";
|
|
| 340 |
(Format.fprintf fmt "@[%s =@ " "ranges"; |
|
| 341 |
((fun x -> |
|
| 342 |
Format.fprintf fmt "@[<2>["; |
|
| 343 |
ignore |
|
| 344 |
(List.fold_left |
|
| 345 |
(fun sep -> |
|
| 346 |
fun x -> |
|
| 347 |
if sep then Format.fprintf fmt ";@ "; |
|
| 348 |
((__2 ()) fmt) x; |
|
| 349 |
true) false x); |
|
| 350 |
Format.fprintf fmt "@,]@]")) aranges; |
|
| 351 |
Format.fprintf fmt "@]"); |
|
| 352 |
Format.fprintf fmt "@]}") |
|
| 353 |
| ArrayConstraint { ranges = aranges; sub = asub } ->
|
|
| 354 |
(Format.fprintf fmt "@[<2>ArrayConstraint {@,";
|
|
| 355 |
((Format.fprintf fmt "@[%s =@ " "ranges"; |
|
| 356 |
((fun x -> |
|
| 357 |
Format.fprintf fmt "@[<2>["; |
|
| 358 |
ignore |
|
| 359 |
(List.fold_left |
|
| 360 |
(fun sep -> |
|
| 361 |
fun x -> |
|
| 362 |
if sep then Format.fprintf fmt ";@ "; |
|
| 363 |
((__3 ()) fmt) x; |
|
| 364 |
true) false x); |
|
| 365 |
Format.fprintf fmt "@,]@]")) aranges; |
|
| 366 |
Format.fprintf fmt "@]"); |
|
| 367 |
Format.fprintf fmt ";@ "; |
|
| 368 |
Format.fprintf fmt "@[%s =@ " "sub"; |
|
| 369 |
((__4 ()) fmt) asub; |
|
| 370 |
Format.fprintf fmt "@]"); |
|
| 371 |
Format.fprintf fmt "@]}") |
|
| 372 |
| RecordConstraint -> Format.pp_print_string fmt "RecordConstraint" |
|
| 373 |
| NoConstraint -> Format.pp_print_string fmt "NoConstraint") |
|
| 374 |
[@ocaml.warning "-A"]) |
|
| 375 |
|
|
| 376 |
and show_vhdl_constraint_t : vhdl_constraint_t -> Ppx_deriving_runtime.string |
|
| 377 |
= fun x -> Format.asprintf "%a" pp_vhdl_constraint_t x |
|
| 378 |
|
|
| 379 |
and pp_vhdl_definition_t : |
|
| 380 |
Format.formatter -> vhdl_definition_t -> Ppx_deriving_runtime.unit = |
|
| 381 |
let __3 () = pp_vhdl_subtype_indication_t |
|
| 382 |
|
|
| 383 |
and __2 () = pp_vhdl_name_t |
|
| 384 |
|
|
| 385 |
and __1 () = pp_vhdl_type_t |
|
| 386 |
|
|
| 387 |
and __0 () = pp_vhdl_name_t |
|
| 388 |
in |
|
| 389 |
((let open! Ppx_deriving_runtime in |
|
| 390 |
fun fmt -> |
|
| 391 |
function |
|
| 392 |
| Type { name = aname; definition = adefinition } ->
|
|
| 393 |
(Format.fprintf fmt "@[<2>Type {@,";
|
|
| 394 |
((Format.fprintf fmt "@[%s =@ " "name"; |
|
| 395 |
((__0 ()) fmt) aname; |
|
| 396 |
Format.fprintf fmt "@]"); |
|
| 397 |
Format.fprintf fmt ";@ "; |
|
| 398 |
Format.fprintf fmt "@[%s =@ " "definition"; |
|
| 399 |
((__1 ()) fmt) adefinition; |
|
| 400 |
Format.fprintf fmt "@]"); |
|
| 401 |
Format.fprintf fmt "@]}") |
|
| 402 |
| Subtype { name = aname; typ = atyp } ->
|
|
| 403 |
(Format.fprintf fmt "@[<2>Subtype {@,";
|
|
| 404 |
((Format.fprintf fmt "@[%s =@ " "name"; |
|
| 405 |
((__2 ()) fmt) aname; |
|
| 406 |
Format.fprintf fmt "@]"); |
|
| 407 |
Format.fprintf fmt ";@ "; |
|
| 408 |
Format.fprintf fmt "@[%s =@ " "typ"; |
|
| 409 |
((__3 ()) fmt) atyp; |
|
| 410 |
Format.fprintf fmt "@]"); |
|
| 411 |
Format.fprintf fmt "@]}")) |
|
| 412 |
[@ocaml.warning "-A"]) |
|
| 413 |
|
|
| 414 |
and show_vhdl_definition_t : vhdl_definition_t -> Ppx_deriving_runtime.string |
|
| 415 |
= fun x -> Format.asprintf "%a" pp_vhdl_definition_t x |
|
| 416 |
|
|
| 417 |
and pp_vhdl_expr_t : |
|
| 418 |
Format.formatter -> vhdl_expr_t -> Ppx_deriving_runtime.unit = |
|
| 419 |
let __7 () = pp_vhdl_element_assoc_t |
|
| 420 |
|
|
| 421 |
and __6 () = pp_vhdl_suffix_selection_t |
|
| 422 |
|
|
| 423 |
and __5 () = pp_vhdl_expr_t |
|
| 424 |
|
|
| 425 |
and __4 () = pp_vhdl_signal_attributes_t |
|
| 426 |
|
|
| 427 |
and __3 () = pp_vhdl_name_t |
|
| 428 |
|
|
| 429 |
and __2 () = pp_vhdl_expr_t |
|
| 430 |
|
|
| 431 |
and __1 () = pp_vhdl_cst_val_t |
|
| 432 |
|
|
| 433 |
and __0 () = pp_vhdl_name_t |
|
| 434 |
in |
|
| 435 |
((let open! Ppx_deriving_runtime in |
|
| 436 |
fun fmt -> |
|
| 437 |
function |
|
| 438 |
| Call a0 -> |
|
| 439 |
(Format.fprintf fmt "(@[<2>Call@ "; |
|
| 440 |
((__0 ()) fmt) a0; |
|
| 441 |
Format.fprintf fmt "@])") |
|
| 442 |
| Cst a0 -> |
|
| 443 |
(Format.fprintf fmt "(@[<2>Cst@ "; |
|
| 444 |
((__1 ()) fmt) a0; |
|
| 445 |
Format.fprintf fmt "@])") |
|
| 446 |
| Op { id = aid; args = aargs } ->
|
|
| 447 |
(Format.fprintf fmt "@[<2>Op {@,";
|
|
| 448 |
((Format.fprintf fmt "@[%s =@ " "id"; |
|
| 449 |
(Format.fprintf fmt "%S") aid; |
|
| 450 |
Format.fprintf fmt "@]"); |
|
| 451 |
Format.fprintf fmt ";@ "; |
|
| 452 |
Format.fprintf fmt "@[%s =@ " "args"; |
|
| 453 |
((fun x -> |
|
| 454 |
Format.fprintf fmt "@[<2>["; |
|
| 455 |
ignore |
|
| 456 |
(List.fold_left |
|
| 457 |
(fun sep -> |
|
| 458 |
fun x -> |
|
| 459 |
if sep then Format.fprintf fmt ";@ "; |
|
| 460 |
((__2 ()) fmt) x; |
|
| 461 |
true) false x); |
|
| 462 |
Format.fprintf fmt "@,]@]")) aargs; |
|
| 463 |
Format.fprintf fmt "@]"); |
|
| 464 |
Format.fprintf fmt "@]}") |
|
| 465 |
| IsNull -> Format.pp_print_string fmt "IsNull" |
|
| 466 |
| Time { value = avalue; phy_unit = aphy_unit } ->
|
|
| 467 |
(Format.fprintf fmt "@[<2>Time {@,";
|
|
| 468 |
((Format.fprintf fmt "@[%s =@ " "value"; |
|
| 469 |
(Format.fprintf fmt "%d") avalue; |
|
| 470 |
Format.fprintf fmt "@]"); |
|
| 471 |
Format.fprintf fmt ";@ "; |
|
| 472 |
Format.fprintf fmt "@[%s =@ " "phy_unit"; |
|
| 473 |
(Format.fprintf fmt "%S") aphy_unit; |
|
| 474 |
Format.fprintf fmt "@]"); |
|
| 475 |
Format.fprintf fmt "@]}") |
|
| 476 |
| Sig { name = aname; att = aatt } ->
|
|
| 477 |
(Format.fprintf fmt "@[<2>Sig {@,";
|
|
| 478 |
((Format.fprintf fmt "@[%s =@ " "name"; |
|
| 479 |
((__3 ()) fmt) aname; |
|
| 480 |
Format.fprintf fmt "@]"); |
|
| 481 |
Format.fprintf fmt ";@ "; |
|
| 482 |
Format.fprintf fmt "@[%s =@ " "att"; |
|
| 483 |
((function |
|
| 484 |
| None -> Format.pp_print_string fmt "None" |
|
| 485 |
| Some x -> |
|
| 486 |
(Format.pp_print_string fmt "(Some "; |
|
| 487 |
((__4 ()) fmt) x; |
|
| 488 |
Format.pp_print_string fmt ")"))) aatt; |
|
| 489 |
Format.fprintf fmt "@]"); |
|
| 490 |
Format.fprintf fmt "@]}") |
|
| 491 |
| SuffixMod { expr = aexpr; selection = aselection } ->
|
|
| 492 |
(Format.fprintf fmt "@[<2>SuffixMod {@,";
|
|
| 493 |
((Format.fprintf fmt "@[%s =@ " "expr"; |
|
| 494 |
((__5 ()) fmt) aexpr; |
|
| 495 |
Format.fprintf fmt "@]"); |
|
| 496 |
Format.fprintf fmt ";@ "; |
|
| 497 |
Format.fprintf fmt "@[%s =@ " "selection"; |
|
| 498 |
((__6 ()) fmt) aselection; |
|
| 499 |
Format.fprintf fmt "@]"); |
|
| 500 |
Format.fprintf fmt "@]}") |
|
| 501 |
| Aggregate { elems = aelems } ->
|
|
| 502 |
(Format.fprintf fmt "@[<2>Aggregate {@,";
|
|
| 503 |
(Format.fprintf fmt "@[%s =@ " "elems"; |
|
| 504 |
((fun x -> |
|
| 505 |
Format.fprintf fmt "@[<2>["; |
|
| 506 |
ignore |
|
| 507 |
(List.fold_left |
|
| 508 |
(fun sep -> |
|
| 509 |
fun x -> |
|
| 510 |
if sep then Format.fprintf fmt ";@ "; |
|
| 511 |
((__7 ()) fmt) x; |
|
| 512 |
true) false x); |
|
| 513 |
Format.fprintf fmt "@,]@]")) aelems; |
|
| 514 |
Format.fprintf fmt "@]"); |
|
| 515 |
Format.fprintf fmt "@]}") |
|
| 516 |
| Others -> Format.pp_print_string fmt "Others") |
|
| 517 |
[@ocaml.warning "-A"]) |
|
| 518 |
|
|
| 519 |
and show_vhdl_expr_t : vhdl_expr_t -> Ppx_deriving_runtime.string = |
|
| 520 |
fun x -> Format.asprintf "%a" pp_vhdl_expr_t x |
|
| 521 |
|
|
| 522 |
and pp_vhdl_name_t : |
|
| 523 |
Format.formatter -> vhdl_name_t -> Ppx_deriving_runtime.unit = |
|
| 524 |
let __9 () = pp_vhdl_assoc_element_t |
|
| 525 |
|
|
| 526 |
and __8 () = pp_vhdl_name_t |
|
| 527 |
|
|
| 528 |
and __7 () = pp_vhdl_expr_t |
|
| 529 |
|
|
| 530 |
and __6 () = pp_vhdl_name_t |
|
| 531 |
|
|
| 532 |
and __5 () = pp_vhdl_name_t |
|
| 533 |
|
|
| 534 |
and __4 () = pp_vhdl_discrete_range_t |
|
| 535 |
|
|
| 536 |
and __3 () = pp_vhdl_name_t |
|
| 537 |
|
|
| 538 |
and __2 () = pp_vhdl_expr_t |
|
| 539 |
|
|
| 540 |
and __1 () = pp_vhdl_name_t |
|
| 541 |
|
|
| 542 |
and __0 () = pp_vhdl_name_t |
|
| 543 |
in |
|
| 544 |
((let open! Ppx_deriving_runtime in |
|
| 545 |
fun fmt -> |
|
| 546 |
function |
|
| 547 |
| Simple a0 -> |
|
| 548 |
(Format.fprintf fmt "(@[<2>Simple@ "; |
|
| 549 |
(Format.fprintf fmt "%S") a0; |
|
| 550 |
Format.fprintf fmt "@])") |
|
| 551 |
| Identifier a0 -> |
|
| 552 |
(Format.fprintf fmt "(@[<2>Identifier@ "; |
|
| 553 |
(Format.fprintf fmt "%S") a0; |
|
| 554 |
Format.fprintf fmt "@])") |
|
| 555 |
| Selected a0 -> |
|
| 556 |
(Format.fprintf fmt "(@[<2>Selected@ "; |
|
| 557 |
((fun x -> |
|
| 558 |
Format.fprintf fmt "@[<2>["; |
|
| 559 |
ignore |
|
| 560 |
(List.fold_left |
|
| 561 |
(fun sep -> |
|
| 562 |
fun x -> |
|
| 563 |
if sep then Format.fprintf fmt ";@ "; |
|
| 564 |
((__0 ()) fmt) x; |
|
| 565 |
true) false x); |
|
| 566 |
Format.fprintf fmt "@,]@]")) a0; |
|
| 567 |
Format.fprintf fmt "@])") |
|
| 568 |
| Index { id = aid; exprs = aexprs } ->
|
|
| 569 |
(Format.fprintf fmt "@[<2>Index {@,";
|
|
| 570 |
((Format.fprintf fmt "@[%s =@ " "id"; |
|
| 571 |
((__1 ()) fmt) aid; |
|
| 572 |
Format.fprintf fmt "@]"); |
|
| 573 |
Format.fprintf fmt ";@ "; |
|
| 574 |
Format.fprintf fmt "@[%s =@ " "exprs"; |
|
| 575 |
((fun x -> |
|
| 576 |
Format.fprintf fmt "@[<2>["; |
|
| 577 |
ignore |
|
| 578 |
(List.fold_left |
|
| 579 |
(fun sep -> |
|
| 580 |
fun x -> |
|
| 581 |
if sep then Format.fprintf fmt ";@ "; |
|
| 582 |
((__2 ()) fmt) x; |
|
| 583 |
true) false x); |
|
| 584 |
Format.fprintf fmt "@,]@]")) aexprs; |
|
| 585 |
Format.fprintf fmt "@]"); |
|
| 586 |
Format.fprintf fmt "@]}") |
|
| 587 |
| Slice { id = aid; range = arange } ->
|
|
| 588 |
(Format.fprintf fmt "@[<2>Slice {@,";
|
|
| 589 |
((Format.fprintf fmt "@[%s =@ " "id"; |
|
| 590 |
((__3 ()) fmt) aid; |
|
| 591 |
Format.fprintf fmt "@]"); |
|
| 592 |
Format.fprintf fmt ";@ "; |
|
| 593 |
Format.fprintf fmt "@[%s =@ " "range"; |
|
| 594 |
((__4 ()) fmt) arange; |
|
| 595 |
Format.fprintf fmt "@]"); |
|
| 596 |
Format.fprintf fmt "@]}") |
|
| 597 |
| Attribute { id = aid; designator = adesignator; expr = aexpr } ->
|
|
| 598 |
(Format.fprintf fmt "@[<2>Attribute {@,";
|
|
| 599 |
(((Format.fprintf fmt "@[%s =@ " "id"; |
|
| 600 |
((__5 ()) fmt) aid; |
|
| 601 |
Format.fprintf fmt "@]"); |
|
| 602 |
Format.fprintf fmt ";@ "; |
|
| 603 |
Format.fprintf fmt "@[%s =@ " "designator"; |
|
| 604 |
((__6 ()) fmt) adesignator; |
|
| 605 |
Format.fprintf fmt "@]"); |
|
| 606 |
Format.fprintf fmt ";@ "; |
|
| 607 |
Format.fprintf fmt "@[%s =@ " "expr"; |
|
| 608 |
((__7 ()) fmt) aexpr; |
|
| 609 |
Format.fprintf fmt "@]"); |
|
| 610 |
Format.fprintf fmt "@]}") |
|
| 611 |
| Function { id = aid; assoc_list = aassoc_list } ->
|
|
| 612 |
(Format.fprintf fmt "@[<2>Function {@,";
|
|
| 613 |
((Format.fprintf fmt "@[%s =@ " "id"; |
|
| 614 |
((__8 ()) fmt) aid; |
|
| 615 |
Format.fprintf fmt "@]"); |
|
| 616 |
Format.fprintf fmt ";@ "; |
|
| 617 |
Format.fprintf fmt "@[%s =@ " "assoc_list"; |
|
| 618 |
((fun x -> |
|
| 619 |
Format.fprintf fmt "@[<2>["; |
|
| 620 |
ignore |
|
| 621 |
(List.fold_left |
|
| 622 |
(fun sep -> |
|
| 623 |
fun x -> |
|
| 624 |
if sep then Format.fprintf fmt ";@ "; |
|
| 625 |
((__9 ()) fmt) x; |
|
| 626 |
true) false x); |
|
| 627 |
Format.fprintf fmt "@,]@]")) aassoc_list; |
|
| 628 |
Format.fprintf fmt "@]"); |
|
| 629 |
Format.fprintf fmt "@]}") |
|
| 630 |
| NoName -> Format.pp_print_string fmt "NoName") |
|
| 631 |
[@ocaml.warning "-A"]) |
|
| 632 |
|
|
| 633 |
and show_vhdl_name_t : vhdl_name_t -> Ppx_deriving_runtime.string = |
|
| 634 |
fun x -> Format.asprintf "%a" pp_vhdl_name_t x |
|
| 635 |
|
|
| 636 |
and pp_vhdl_assoc_element_t : |
|
| 637 |
Format.formatter -> vhdl_assoc_element_t -> Ppx_deriving_runtime.unit = |
|
| 638 |
let __4 () = pp_vhdl_expr_t |
|
| 639 |
|
|
| 640 |
and __3 () = pp_vhdl_name_t |
|
| 641 |
|
|
| 642 |
and __2 () = pp_vhdl_name_t |
|
| 643 |
|
|
| 644 |
and __1 () = pp_vhdl_name_t |
|
| 645 |
|
|
| 646 |
and __0 () = pp_vhdl_name_t |
|
| 647 |
in |
|
| 648 |
((let open! Ppx_deriving_runtime in |
|
| 649 |
fun fmt -> |
|
| 650 |
fun x -> |
|
| 651 |
Format.fprintf fmt "@[<2>{ ";
|
|
| 652 |
(((((Format.fprintf fmt "@[%s =@ " "formal_name"; |
|
| 653 |
((function |
|
| 654 |
| None -> Format.pp_print_string fmt "None" |
|
| 655 |
| Some x -> |
|
| 656 |
(Format.pp_print_string fmt "(Some "; |
|
| 657 |
((__0 ()) fmt) x; |
|
| 658 |
Format.pp_print_string fmt ")"))) x.formal_name; |
|
| 659 |
Format.fprintf fmt "@]"); |
|
| 660 |
Format.fprintf fmt ";@ "; |
|
| 661 |
Format.fprintf fmt "@[%s =@ " "formal_arg"; |
|
| 662 |
((function |
|
| 663 |
| None -> Format.pp_print_string fmt "None" |
|
| 664 |
| Some x -> |
|
| 665 |
(Format.pp_print_string fmt "(Some "; |
|
| 666 |
((__1 ()) fmt) x; |
|
| 667 |
Format.pp_print_string fmt ")"))) x.formal_arg; |
|
| 668 |
Format.fprintf fmt "@]"); |
|
| 669 |
Format.fprintf fmt ";@ "; |
|
| 670 |
Format.fprintf fmt "@[%s =@ " "actual_name"; |
|
| 671 |
((function |
|
| 672 |
| None -> Format.pp_print_string fmt "None" |
|
| 673 |
| Some x -> |
|
| 674 |
(Format.pp_print_string fmt "(Some "; |
|
| 675 |
((__2 ()) fmt) x; |
|
| 676 |
Format.pp_print_string fmt ")"))) x.actual_name; |
|
| 677 |
Format.fprintf fmt "@]"); |
|
| 678 |
Format.fprintf fmt ";@ "; |
|
| 679 |
Format.fprintf fmt "@[%s =@ " "actual_designator"; |
|
| 680 |
((function |
|
| 681 |
| None -> Format.pp_print_string fmt "None" |
|
| 682 |
| Some x -> |
|
| 683 |
(Format.pp_print_string fmt "(Some "; |
|
| 684 |
((__3 ()) fmt) x; |
|
| 685 |
Format.pp_print_string fmt ")"))) x.actual_designator; |
|
| 686 |
Format.fprintf fmt "@]"); |
|
| 687 |
Format.fprintf fmt ";@ "; |
|
| 688 |
Format.fprintf fmt "@[%s =@ " "actual_expr"; |
|
| 689 |
((function |
|
| 690 |
| None -> Format.pp_print_string fmt "None" |
|
| 691 |
| Some x -> |
|
| 692 |
(Format.pp_print_string fmt "(Some "; |
|
| 693 |
((__4 ()) fmt) x; |
|
| 694 |
Format.pp_print_string fmt ")"))) x.actual_expr; |
|
| 695 |
Format.fprintf fmt "@]"); |
|
| 696 |
Format.fprintf fmt "@ }@]") |
|
| 697 |
[@ocaml.warning "-A"]) |
|
| 698 |
|
|
| 699 |
and show_vhdl_assoc_element_t : |
|
| 700 |
vhdl_assoc_element_t -> Ppx_deriving_runtime.string = |
|
| 701 |
fun x -> Format.asprintf "%a" pp_vhdl_assoc_element_t x |
|
| 702 |
|
|
| 703 |
and pp_vhdl_element_assoc_t : |
|
| 704 |
Format.formatter -> vhdl_element_assoc_t -> Ppx_deriving_runtime.unit = |
|
| 705 |
let __1 () = pp_vhdl_expr_t |
|
| 706 |
|
|
| 707 |
and __0 () = pp_vhdl_expr_t |
|
| 708 |
in |
|
| 709 |
((let open! Ppx_deriving_runtime in |
|
| 710 |
fun fmt -> |
|
| 711 |
fun x -> |
|
| 712 |
Format.fprintf fmt "@[<2>{ ";
|
|
| 713 |
((Format.fprintf fmt "@[%s =@ " "choices"; |
|
| 714 |
((fun x -> |
|
| 715 |
Format.fprintf fmt "@[<2>["; |
|
| 716 |
ignore |
|
| 717 |
(List.fold_left |
|
| 718 |
(fun sep -> |
|
| 719 |
fun x -> |
|
| 720 |
if sep then Format.fprintf fmt ";@ "; |
|
| 721 |
((__0 ()) fmt) x; |
|
| 722 |
true) false x); |
|
| 723 |
Format.fprintf fmt "@,]@]")) x.choices; |
|
| 724 |
Format.fprintf fmt "@]"); |
|
| 725 |
Format.fprintf fmt ";@ "; |
|
| 726 |
Format.fprintf fmt "@[%s =@ " "expr"; |
|
| 727 |
((__1 ()) fmt) x.expr; |
|
| 728 |
Format.fprintf fmt "@]"); |
|
| 729 |
Format.fprintf fmt "@ }@]") |
|
| 730 |
[@ocaml.warning "-A"]) |
|
| 731 |
|
|
| 732 |
and show_vhdl_element_assoc_t : |
|
| 733 |
vhdl_element_assoc_t -> Ppx_deriving_runtime.string = |
|
| 734 |
fun x -> Format.asprintf "%a" pp_vhdl_element_assoc_t x |
|
| 735 |
|
|
| 736 |
and (pp_vhdl_array_attributes_t : |
|
| 737 |
Format.formatter -> |
|
| 738 |
vhdl_array_attributes_t -> Ppx_deriving_runtime.unit) |
|
| 739 |
= |
|
| 740 |
((let open! Ppx_deriving_runtime in |
|
| 741 |
fun fmt -> |
|
| 742 |
function |
|
| 743 |
| AAttInt { id = aid; arg = aarg } ->
|
|
| 744 |
(Format.fprintf fmt "@[<2>AAttInt {@,";
|
|
| 745 |
((Format.fprintf fmt "@[%s =@ " "id"; |
|
| 746 |
(Format.fprintf fmt "%S") aid; |
|
| 747 |
Format.fprintf fmt "@]"); |
|
| 748 |
Format.fprintf fmt ";@ "; |
|
| 749 |
Format.fprintf fmt "@[%s =@ " "arg"; |
|
| 750 |
(Format.fprintf fmt "%d") aarg; |
|
| 751 |
Format.fprintf fmt "@]"); |
|
| 752 |
Format.fprintf fmt "@]}") |
|
| 753 |
| AAttAscending -> Format.pp_print_string fmt "AAttAscending") |
|
| 754 |
[@ocaml.warning "-A"]) |
|
| 755 |
|
|
| 756 |
and show_vhdl_array_attributes_t : |
|
| 757 |
vhdl_array_attributes_t -> Ppx_deriving_runtime.string = |
|
| 758 |
fun x -> Format.asprintf "%a" pp_vhdl_array_attributes_t x |
|
| 759 |
|
|
| 760 |
and (pp_vhdl_signal_attributes_t : |
|
| 761 |
Format.formatter -> |
|
| 762 |
vhdl_signal_attributes_t -> Ppx_deriving_runtime.unit) |
|
| 763 |
= |
|
| 764 |
((let open! Ppx_deriving_runtime in |
|
| 765 |
fun fmt -> |
|
| 766 |
function |
|
| 767 |
| SigAtt a0 -> |
|
| 768 |
(Format.fprintf fmt "(@[<2>SigAtt@ "; |
|
| 769 |
(Format.fprintf fmt "%S") a0; |
|
| 770 |
Format.fprintf fmt "@])")) |
|
| 771 |
[@ocaml.warning "-A"]) |
|
| 772 |
|
|
| 773 |
and show_vhdl_signal_attributes_t : |
|
| 774 |
vhdl_signal_attributes_t -> Ppx_deriving_runtime.string = |
|
| 775 |
fun x -> Format.asprintf "%a" pp_vhdl_signal_attributes_t x |
|
| 776 |
|
|
| 777 |
and (pp_vhdl_string_attributes_t : |
|
| 778 |
Format.formatter -> |
|
| 779 |
vhdl_string_attributes_t -> Ppx_deriving_runtime.unit) |
|
| 780 |
= |
|
| 781 |
((let open! Ppx_deriving_runtime in |
|
| 782 |
fun fmt -> |
|
| 783 |
function |
|
| 784 |
| StringAtt a0 -> |
|
| 785 |
(Format.fprintf fmt "(@[<2>StringAtt@ "; |
|
| 786 |
(Format.fprintf fmt "%S") a0; |
|
| 787 |
Format.fprintf fmt "@])")) |
|
| 788 |
[@ocaml.warning "-A"]) |
|
| 789 |
|
|
Also available in: Unified diff
New version of the vhdl import + compilation