Project

General

Profile

Revision 8f9ce6d4

View differences:

src/backends/VHDL/vhdl_ast.ml
1 1
(* source: Synario VHDL Reference Manual - March 1997 *)
2 2

  
3
(* TODO ? *)
3
(************************************************************************************)		   
4
(*                       Types                                                      *)
5
(************************************************************************************)		   
6
let base_types = ["integer"; "character"; "bit"; "real"; "natural"; "positive"; "std_logic"; "std_logic_vector" ]
7

  
4 8
type vhdl_type_t =
5
  | Integer | Natural | Positive
6
  | Real
9
  | Base of string
7 10
  | Range of string option * int * int
8
  | Byte
9
  | Bit_vector of int * int
11
  | Bit_vector of int * int			  
12
  | Array of int * int * vhdl_type_t 
10 13
  | Enumerated of string list
11 14
  
12
let pp_vhdl_type fmt t =
15
let rec pp_vhdl_type fmt t =
13 16
  match t with
14
  | Integer -> Format.fprintf fmt "integer"
15
  | Natural -> Format.fprintf fmt "natural"
16
  | Positive -> Format.fprintf fmt "positive"
17
  | Real -> Format.fprintf fmt "real"
18
  | 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
19
  | Byte -> Format.fprintf fmt "byte"
17
  | Base s -> Format.fprintf fmt "%s" s 
20 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 21
  | Enumerated sl -> Format.fprintf fmt "(%a)" (Utils.fprintf_list ~sep:", " Format.pp_print_string) sl
22 22

  
23
type vhdl_definition_t =
24
  | Type of {name : string ; definition: vhdl_type_t}
25
  | Subtype of {name : string ; definition: vhdl_type_t}
26
					
27
let pp_vhdl_definition fmt def =
28
  match def with
29
  | Type s -> Format.fprintf fmt "type %s is %a;" s.name pp_vhdl_type s.definition
30
  | Subtype s -> Format.fprintf fmt "subtype %s is %a;" s.name pp_vhdl_type s.definition
31

  
32
(* Optional. Describes shared definitions *)
33
type vhdl_package_t =
34
  {
35
    name: string;
36
    shared_defs: vhdl_definition_t list;
37
  }
38

  
39
let pp_vhdl_package fmt p =
40
  Format.fprintf
41
    fmt
42
    "@[<v 3>package %s is@ %a@ end %s;@]@ "
43
    p.name
44
    (Utils.fprintf_list  ~sep:"@ " pp_vhdl_definition) p.shared_defs
45
    p.name
46

  
47
type vhdl_load_t = Library of string | Use of string list
48
let pp_vhdl_load fmt l =
49
  match l with
50
  | Library s -> Format.fprintf fmt "library %s;" s
51
  | Use sl -> Format.fprintf fmt "use %a;s" (Utils.fprintf_list ~sep:"." Format.pp_print_string) sl
52

  
53

  
54
(* TODO *)
55
type vhdl_generic_t = unit
56
let pp_vhdl_generic fmt g = ()
57 23

  
58
			      
59
type vhdl_port_kind_t = InPort | OutPort | InoutPort | BufferPort
60
let pp_vhdl_port_kind fmt p =
61
  match p with
62
  | InPort -> Format.fprintf fmt "in"
63
  | OutPort -> Format.fprintf fmt "in"
64
  | InoutPort -> Format.fprintf fmt "inout"
65
  | BufferPort -> Format.fprintf fmt "buffer"
66

  
67
		     
68
type vhdl_port_t =
69
  {
70
    name: string;
71
    kind: vhdl_port_kind_t;
72
    typ: vhdl_type_t;
73
  }
74 24

  
75
let pp_vhdl_port fmt p =
76
  Format.fprintf fmt "%s : %a %a"
77
		 p.name
78
		 pp_vhdl_port_kind p.kind
79
		 pp_vhdl_type p.typ
80
	 
81
			     
82
type vhdl_entity_t =
83
  {
84
    name: string;
85
    generics: vhdl_generic_t list;
86
    ports: vhdl_port_t list;
87
  }
88
let pp_vhdl_entity fmt e =
89
  Format.fprintf
90
    fmt
91
    "@[<v 3>entity %s is@ %t%t@]@ end %s;"
92
    e.name
93
    (fun fmt -> List.iter (fun g -> Format.fprintf fmt "generic %a;@ " pp_vhdl_generic g) e.generics)
94
    (fun fmt ->
95
     if e.ports = [] then () else
96
       Format.fprintf fmt "port (@[<hov 0>%a@]);" (Utils.fprintf_list ~sep:"@ " pp_vhdl_port) e.ports)
97
    e.name
25
(************************************************************************************)		   
26
(*                     Constants                                                    *)
27
(************************************************************************************)		   
98 28

  
29
(* Std_logic values :
30
    'U': uninitialized. This signal hasn't been set yet.
31
    'X': unknown. Impossible to determine this value/result.
32
    '0': logic 0
33
    '1': logic 1
34
    'Z': High Impedance
35
    'W': Weak signal, can't tell if it should be 0 or 1.
36
    'L': Weak signal that should probably go to 0
37
    'H': Weak signal that should probably go to 1
38
    '-': Don't care. *)			       
39
let std_logic_cst = ["U"; "X"; "0"; "1"; "Z"; "W"; "L"; "H"; "-" ]
99 40

  
100
(* TODO *)
41
(* TODO: do we need more constructors ? *)
42
type cst_val_t = CstInt of int | CstStdLogic of string
101 43

  
102
type cst_val_t = CstInt of int
103 44
let pp_cst_val fmt c =
104 45
  match c with
105 46
  | CstInt i -> Format.fprintf fmt "%i" i
106
			       
47
  | CstStdLogic s -> if List.mem s std_logic_cst then Format.fprintf fmt "%s" s else assert false
48

  
49
(************************************************************************************)		   
50
(*                     Declarations                                                 *)
51
(************************************************************************************)		   
52

  
53

  
54
(* TODO ? Shall we merge definition / declaration  *)
55
type vhdl_definition_t =
56
  | Type of {name : string ; definition: vhdl_type_t}
57
  | Subtype of {name : string ; definition: vhdl_type_t}
58
					
59
let pp_vhdl_definition fmt def =
60
  match def with
61
  | Type s -> Format.fprintf fmt "type %s is %a;" s.name pp_vhdl_type s.definition
62
  | Subtype s -> Format.fprintf fmt "subtype %s is %a;" s.name pp_vhdl_type s.definition
63
		      
107 64
type vhdl_declaration_t =
108 65
  | VarDecl of { name : string; typ : vhdl_type_t; init_val : cst_val_t option }
109 66
  | CstDecl of { name : string; typ : vhdl_type_t; init_val : cst_val_t  }
......
116 73
		   "variable %s : %a%t;"
117 74
		   v.name
118 75
		   pp_vhdl_type v.typ
119
		   (fun fmt -> match v.init_val with Some initv -> Format.fprintf fmt " := %a" pp_cst_val initv)
76
		   (fun fmt -> match v.init_val with Some initv -> Format.fprintf fmt " := %a" pp_cst_val initv | _ -> ())
120 77
  | CstDecl v -> Format.fprintf
121 78
		   fmt
122 79
		   "constant %s : %a := %a;"
......
128 85
		   "signal %s : %a%t;"
129 86
		   v.name
130 87
		   pp_vhdl_type v.typ
131
		   (fun fmt -> match v.init_val with Some initv -> Format.fprintf fmt " := %a" pp_cst_val initv)
88
		   (fun fmt -> match v.init_val with Some initv -> Format.fprintf fmt " := %a" pp_cst_val initv | _ -> ())
89

  
132 90

  
133 91
(************************************************************************************)		   
134 92
(*            Attributes for types, arrays, signals and strings                     *)
135 93
(************************************************************************************)		   
94

  
136 95
type 'basetype vhdl_type_attributes_t =
137 96
  | TAttNoArg of { id: string }
138 97
  | TAttIntArg of { id: string; arg: int }
......
168 127
  | StringAtt s -> Format.fprintf fmt "'%s" s
169 128
let signal_att = [ "simple_name"; "path_name"; "instance_name" ]
170 129

  
171
				      
172
(* TODO *)  
130
(************************************************************************************)		   
131
(*                        Expressions  / Statements                                 *)
132
(************************************************************************************)		   
133

  
134
			      
135
(* TODO: call to functions? procedures? *)  
173 136
type vhdl_expr_t =
174
  | Binop of { op: string; args: vhdl_expr_t list }
137
  | Var of string (* a signal or a variable *)
138
  | Op of { id: string; args: vhdl_expr_t list } 
175 139
					     
176
let pp_vhdl_expr fmt e = ()
140
let rec pp_vhdl_expr fmt e =
141
  match e with
142
  | Var s -> Format.fprintf fmt "%s" s
143
  | Op op -> (
144
    match op.args with
145
    | [] -> assert false
146
    | _ -> Format.fprintf fmt "%s (%a)" op.id (Utils.fprintf_list ~sep:",@ " pp_vhdl_expr) op.args
147
  )
177 148

  
178 149
let arith_funs = ["+";"-";"*";"/";"mod"; "rem";"abs";"**"]
179 150
let bool_funs  = ["and"; "or"; "nand"; "nor"; "xor"; "not"]
180 151
let rel_funs   = ["<";">";"<=";">=";"/=";"="]
181 152
  
182
			   
153
		   
183 154

  
184 155

  
185
type vhdl_sequential_stmt_t = unit 
186
(*  | VarAssign of { lhs: string; rhs: vhdl_expr_t }
187
  | Case of { guard: vhdl_expr_t; branches: { case: }
156
type vhdl_sequential_stmt_t = 
157
  | VarAssign of { lhs: string; rhs: vhdl_expr_t }
158
(*  | Case of { guard: vhdl_expr_t; branches: { case: }
188 159
	    | Case of { guard: vhdl_expr_t; branches 
189 160
 *)
161

  
162
let pp_vhdl_sequential_stmt fmt stmt =
163
  match stmt with
164
  | VarAssign va -> Format.fprintf fmt "%s := %a;" va.lhs pp_vhdl_expr va.rhs
165
				    
166
type signal_condition_t =
167
  {                            
168
    expr: vhdl_expr_t;              (* when expression *)
169
    else_case: vhdl_expr_t option;  (* optional else case expression. 
170
                                             If None, could be a latch  *)
171
  }
172

  
173
type signal_selection_t =
174
  {
175
    sel_lhs: string;
176
    expr : vhdl_expr_t;
177
    when_sel: vhdl_expr_t option;
178
  }
179

  
180
type conditional_signal_t =
181
  {
182
      lhs: string;                        (* assigned signal *)
183
      rhs: vhdl_expr_t;                   (* expression *)
184
      cond: signal_condition_t option     (* conditional signal statement *)
185
  }
186

  
187
type process_t =
188
  { id: string option; active_sigs: string list; body: vhdl_sequential_stmt_t list }
189

  
190
type selected_signal_t = { sel: vhdl_expr_t;  branches: signal_selection_t list }
191
			   
190 192
type vhdl_concurrent_stmt_t =
191
  | SigAssign of { lhs: string; rhs: vhdl_expr_t }
192
  | Process of { active_sigs: string list; body: vhdl_sequential_stmt_t list }
193
  
193
  | SigAssign of conditional_signal_t 
194
  | Process of process_t 
195
  | SelectedSig of selected_signal_t
196
  (*
194 197
type vhdl_statement_t =
195 198
  
196 199
  (* | DeclarationStmt of declaration_stmt_t *)
197 200
  | ConcurrentStmt of vhdl_concurrent_stmt_t
198 201
  | SequentialStmt of vhdl_sequential_stmt_t
199
			
202
   *)
203
		     
204
let pp_vhdl_concurrent_stmt fmt stmt =
205
  let pp_sig_cond fmt va = 
206
    Format.fprintf
207
      fmt
208
      "%s <= %a%t;"
209
      va.lhs
210
      pp_vhdl_expr va.rhs
211
      (fun fmt -> match va.cond with
212
		  | None -> ()
213
		  | Some cond ->
214
		     Format.fprintf
215
		       fmt
216
		       " when %a%t"
217
		       pp_vhdl_expr cond.expr
218
		       (fun fmt -> match cond.else_case with
219
				   | None -> ()
220
				   | Some else_case ->
221
				      Format.fprintf
222
					fmt
223
					" else %a"
224
					pp_vhdl_expr else_case
225
		       )
226
      )
227
  in
228
  let pp_process fmt p =
229
    Format.fprintf
230
      fmt
231
      "@[<v 0>%tprocess %a@ @[<v 3>begin@ %a@]@ end process;@]"
232
      (fun fmt -> match p.id with Some id -> Format.fprintf fmt "%s: " id| None -> ())
233
      (fun fmt asigs ->
234
       if asigs <> [] then
235
	 Format.fprintf
236
	   fmt
237
	   "(@[<hov 0>%a)@]"
238
	   (Utils.fprintf_list ~sep:",@ " Format.pp_print_string) asigs)
239
      p.active_sigs
240
      (Utils.fprintf_list ~sep:"@ " pp_vhdl_sequential_stmt) p.body
241
  in
242
  let pp_sig_sel fmt va =
243
    Format.fprintf fmt "@[<v 3>with %a select@ %a;@]"
244
		   pp_vhdl_expr va.sel
245
		   (Utils.fprintf_list
246
		      ~sep:"@ "
247
		      (fun fmt b ->
248
		       Format.fprintf
249
			 fmt
250
			 "%s <= %a when %t"
251
			 b.sel_lhs
252
			 pp_vhdl_expr b.expr
253
			 (fun fmt -> match b.when_sel with
254
				     | None -> Format.fprintf fmt "others"
255
				     | Some w -> pp_vhdl_expr fmt w
256
			 ))
257
		   ) va.branches  in
258
  match stmt with
259
  | SigAssign va -> pp_sig_cond fmt va       
260
  | Process p -> pp_process fmt p
261
  | SelectedSig va -> pp_sig_sel fmt va
262
 
200 263

  
201
let rec pp_vhdl_statement fmt stmt = ()
202
(*  match stmt with
203
  | VarAssign va -> Format.fprintf fmt "%s := %a;" va.lhs pp_vhdl_expr va.rhs
204
  | SigAssign va -> Format.fprintf fmt "%s <= %a;" va.lhs pp_vhdl_expr va.rhs
205
  | Process p ->
206
     Format.fprintf
207
       fmt
208
       "@[<v 0>process %a@ @[<v 3>begin@ %a@]@ end process;@]"
209
       (fun fmt asigs ->
210
	if asigs <> [] then
211
	  Format.fprintf
212
	    fmt
213
	    "(@[<hov 0>%a)@]"
214
	    (Utils.fprintf_list ~sep:",@ " Format.pp_print_string) asigs)
215
       p.active_sigs
216
       (Utils.fprintf_list ~sep:"@ " pp_vhdl_statement) p.body
217
 *)     
264
  
265
       
266

  
267

  
268

  
269
(************************************************************************************)		   
270
(*                     Entities                                                     *)
271
(************************************************************************************)		   
272
			     
273
(* TODO? Seems to appear optionally in entities *)
274
type vhdl_generic_t = unit
275
let pp_vhdl_generic fmt g = ()
276

  
277
			      
278
type vhdl_port_kind_t = InPort | OutPort | InoutPort | BufferPort
279
let pp_vhdl_port_kind fmt p =
280
  match p with
281
  | InPort -> Format.fprintf fmt "in"
282
  | OutPort -> Format.fprintf fmt "in"
283
  | InoutPort -> Format.fprintf fmt "inout"
284
  | BufferPort -> Format.fprintf fmt "buffer"
285

  
286
		     
287
type vhdl_port_t =
288
  {
289
    name: string;
290
    kind: vhdl_port_kind_t;
291
    typ: vhdl_type_t;
292
  }
293

  
294
let pp_vhdl_port fmt p =
295
  Format.fprintf fmt "%s : %a %a"
296
		 p.name
297
		 pp_vhdl_port_kind p.kind
298
		 pp_vhdl_type p.typ
299
	 
300
			     
301
type vhdl_entity_t =
302
  {
303
    name: string;
304
    generics: vhdl_generic_t list;
305
    ports: vhdl_port_t list;
306
  }
307
let pp_vhdl_entity fmt e =
308
  Format.fprintf
309
    fmt
310
    "@[<v 3>entity %s is@ %t%t@]@ end %s;@ "
311
    e.name
312
    (fun fmt -> List.iter (fun g -> Format.fprintf fmt "generic %a;@ " pp_vhdl_generic g) e.generics)
313
    (fun fmt ->
314
     if e.ports = [] then () else
315
       Format.fprintf fmt "port (@[<hov 0>%a@]);" (Utils.fprintf_list ~sep:",@ " pp_vhdl_port) e.ports)
316
    e.name
317

  
318

  
319

  
320

  
321
(************************************************************************************)		   
322
(*                    Packages / Library loading                                    *)
323
(************************************************************************************)		   
324

  
325
				
326
				
327
(* Optional. Describes shared definitions *)
328
type vhdl_package_t =
329
  {
330
    name: string;
331
    shared_defs: vhdl_definition_t list;
332
  }
218 333

  
334
let pp_vhdl_package fmt p =
335
  Format.fprintf
336
    fmt
337
    "@[<v 3>package %s is@ %a@]@ end %s;@ "
338
    p.name
339
    (Utils.fprintf_list  ~sep:"@ " pp_vhdl_definition) p.shared_defs
340
    p.name
341

  
342
type vhdl_load_t = Library of string | Use of string list
343
let pp_vhdl_load fmt l =
344
  match l with
345
  | Library s -> Format.fprintf fmt "library %s;@ " s
346
  | Use sl -> Format.fprintf fmt "use %a;@ " (Utils.fprintf_list ~sep:"." Format.pp_print_string) sl
347

  
348

  
349
(************************************************************************************)		   
350
(*                        Architecture / VHDL Design                                *)
351
(************************************************************************************)		   
352
				       
353
				       
219 354
type vhdl_architecture_t =
220 355
  {
221 356
    name: string;
222 357
    entity: string;
223 358
    declarations: vhdl_declaration_t list;
224
    body: vhdl_statement_t list;
359
    body: vhdl_concurrent_stmt_t list;
225 360
  }
226 361
    
227 362
let pp_vhdl_architecture fmt a =
228 363
  Format.fprintf
229 364
    fmt
230
    "@[<v 3>architecture %s of %s is@ %a@]@ @[<v 3>begin@ %a@]end %s"
365
    "@[<v 3>architecture %s of %s is@ %a@]@ @[<v 3>begin@ %a@]@ end %s"
231 366
    a.name
232 367
    a.entity
233 368
    (Utils.fprintf_list ~sep:"@ " pp_vhdl_declaration) a.declarations
234
    (Utils.fprintf_list ~sep:"@ " pp_vhdl_statement) a.body
369
    (Utils.fprintf_list ~sep:"@ " pp_vhdl_concurrent_stmt) a.body
235 370
    a.name
236 371
    
237 372

  
src/backends/VHDL/vhdl_test.ml
32 32
			    Process {
33 33
				id = None;
34 34
				active_sigs = ["clk"; "rst"];
35
				body = [];
35
				body = [
36
				    
37
				  ];
36 38
			      };
37 39
			    SigAssign {
38 40
				lhs = "q";

Also available in: Unified diff