Revision dea84f9e
Added by Pierre-Loïc Garoche about 5 years ago
| src/backends/VHDL/vhdl_ast.ml | ||
|---|---|---|
| 39 | 39 |
let std_logic_cst = ["U"; "X"; "0"; "1"; "Z"; "W"; "L"; "H"; "-" ] |
| 40 | 40 |
|
| 41 | 41 |
(* TODO: do we need more constructors ? *) |
| 42 |
type cst_val_t = CstInt of int | CstStdLogic of string |
|
| 42 |
type cst_val_t = CstInt of int | CstStdLogic of string | CstBV of string * string
|
|
| 43 | 43 |
|
| 44 | 44 |
let pp_cst_val fmt c = |
| 45 | 45 |
match c with |
| 46 | 46 |
| CstInt i -> Format.fprintf fmt "%i" i |
| 47 | 47 |
| 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 |
|
| 48 | 49 |
|
| 49 | 50 |
(************************************************************************************) |
| 50 | 51 |
(* Declarations *) |
| 51 | 52 |
(************************************************************************************) |
| 52 | 53 |
|
| 53 | 54 |
|
| 54 |
(* TODO ? Shall we merge definition / declaration *) |
|
| 55 |
(* TODO ? Shall we merge definition / declaration ? Do they appear at the same |
|
| 56 |
place or at different ones ? *) |
|
| 55 | 57 |
type vhdl_definition_t = |
| 56 | 58 |
| Type of {name : string ; definition: vhdl_type_t}
|
| 57 | 59 |
| Subtype of {name : string ; definition: vhdl_type_t}
|
| ... | ... | |
| 123 | 125 |
let signal_att = [ "event"; "stable"; "last_value" ] |
| 124 | 126 |
|
| 125 | 127 |
type vhdl_string_attributes_t = StringAtt of string |
| 126 |
let pp_signal_attribute fmt sa = match sa with
|
|
| 128 |
let pp_string_attribute fmt sa = match sa with
|
|
| 127 | 129 |
| StringAtt s -> Format.fprintf fmt "'%s" s |
| 128 | 130 |
let signal_att = [ "simple_name"; "path_name"; "instance_name" ] |
| 129 | 131 |
|
| ... | ... | |
| 132 | 134 |
(************************************************************************************) |
| 133 | 135 |
|
| 134 | 136 |
|
| 135 |
(* TODO: call to functions? procedures? *) |
|
| 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 |
|
|
| 136 | 145 |
type vhdl_expr_t = |
| 146 |
| Cst of cst_val_t |
|
| 137 | 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 }
|
|
| 138 | 150 |
| Op of { id: string; args: vhdl_expr_t list }
|
| 139 | 151 |
|
| 140 | 152 |
let rec pp_vhdl_expr fmt e = |
| 141 | 153 |
match e with |
| 154 |
| Cst c -> pp_cst_val fmt c |
|
| 142 | 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 |
|
| 143 | 165 |
| Op op -> ( |
| 144 | 166 |
match op.args with |
| 145 | 167 |
| [] -> assert false |
| 146 |
| _ -> Format.fprintf fmt "%s (%a)" op.id (Utils.fprintf_list ~sep:",@ " pp_vhdl_expr) op.args |
|
| 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 *) |
|
| 147 | 171 |
) |
| 148 | 172 |
|
| 173 |
(* Available operators in the standard library. There are some restrictions on |
|
| 174 |
types. See reference doc. *) |
|
| 149 | 175 |
let arith_funs = ["+";"-";"*";"/";"mod"; "rem";"abs";"**"] |
| 150 | 176 |
let bool_funs = ["and"; "or"; "nand"; "nor"; "xor"; "not"] |
| 151 | 177 |
let rel_funs = ["<";">";"<=";">=";"/=";"="] |
| 152 |
|
|
| 153 |
|
|
| 154 | 178 |
|
| 179 |
|
|
| 180 |
type vhdl_if_case_t = {
|
|
| 181 |
if_cond: vhdl_expr_t; |
|
| 182 |
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 |
} |
|
| 155 | 194 |
|
| 156 |
type vhdl_sequential_stmt_t = |
|
| 157 |
| VarAssign of { lhs: string; rhs: vhdl_expr_t }
|
|
| 158 |
(* | Case of { guard: vhdl_expr_t; branches: { case: }
|
|
| 159 |
| Case of { guard: vhdl_expr_t; branches
|
|
| 160 |
*) |
|
| 161 |
|
|
| 162 |
let pp_vhdl_sequential_stmt fmt stmt = |
|
| 195 |
|
|
| 196 |
|
|
| 197 |
let rec pp_vhdl_sequential_stmt fmt stmt = |
|
| 163 | 198 |
match stmt with |
| 164 | 199 |
| VarAssign va -> Format.fprintf fmt "%s := %a;" va.lhs pp_vhdl_expr va.rhs |
| 165 |
|
|
| 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 |
|
|
| 166 | 231 |
type signal_condition_t = |
| 167 | 232 |
{
|
| 168 | 233 |
expr: vhdl_expr_t; (* when expression *) |
| ... | ... | |
| 362 | 427 |
let pp_vhdl_architecture fmt a = |
| 363 | 428 |
Format.fprintf |
| 364 | 429 |
fmt |
| 365 |
"@[<v 3>architecture %s of %s is@ %a@]@ @[<v 3>begin@ %a@]@ end %s" |
|
| 430 |
"@[<v 3>architecture %s of %s is@ %a@]@ @[<v 3>begin@ %a@]@ end %s;"
|
|
| 366 | 431 |
a.name |
| 367 | 432 |
a.entity |
| 368 | 433 |
(Utils.fprintf_list ~sep:"@ " pp_vhdl_declaration) a.declarations |
Also available in: Unified diff
Working example!