lustrec / src / backends / Ada / ada_backend_common.ml @ b12a91e0
History | View | Annotate | Download (3.88 KB)
1 |
open Format |
---|---|
2 |
|
3 |
open Machine_code_types |
4 |
open Lustre_types |
5 |
open Corelang |
6 |
open Machine_code_common |
7 |
|
8 |
(** All the pretty print functions common to the ada backend **) |
9 |
|
10 |
(* Package pretty print functions *) |
11 |
|
12 |
(** Print the name of a package associated to a machine. |
13 |
@param fmt the formater to print on |
14 |
@param machine the machine |
15 |
*) |
16 |
let pp_package_name fmt machine = |
17 |
fprintf fmt "%s" machine.mname.node_id |
18 |
|
19 |
(** Print the ada package introduction sentence it can be used for body and |
20 |
declaration. Boolean parameter body should be true if it is a body delcaration. |
21 |
@param fmt the formater to print on |
22 |
@param fmt the formater to print on |
23 |
@param machine the machine |
24 |
*) |
25 |
let pp_begin_package body fmt machine = |
26 |
fprintf fmt "package %s %a is" |
27 |
(if body then "body" else "") |
28 |
pp_package_name machine |
29 |
|
30 |
(** Print the ada package conclusion sentence. |
31 |
@param fmt the formater to print on |
32 |
@param machine the machine |
33 |
*) |
34 |
let pp_end_package fmt machine = |
35 |
fprintf fmt "end %a;" pp_package_name machine |
36 |
|
37 |
|
38 |
(* Variable pretty print functions *) |
39 |
|
40 |
(** Print the name of a variable. |
41 |
@param fmt the formater to print on |
42 |
@param id the variable |
43 |
*) |
44 |
let pp_var_name fmt id = |
45 |
fprintf fmt "%s" id.var_id |
46 |
|
47 |
(** Print the type of a variable. |
48 |
@param fmt the formater to print on |
49 |
@param id the variable |
50 |
*) |
51 |
let pp_var_type fmt id = fprintf fmt |
52 |
(match (Types.repr id.var_type).Types.tdesc with |
53 |
| Types.Tbasic Types.Basic.Tint -> "int" |
54 |
| Types.Tbasic Types.Basic.Treal -> "double" |
55 |
| Types.Tbasic Types.Basic.Tbool -> "bool" |
56 |
| _ -> eprintf "Type error : %a@." Types.print_ty id.var_type; assert false (*TODO*) |
57 |
) |
58 |
|
59 |
|
60 |
(* Prototype pretty print functions *) |
61 |
|
62 |
type prototype_modifiers = In | Out |
63 |
|
64 |
(** Print a prototype_modifiers. |
65 |
@param fmt the formater to print on |
66 |
@param modifier the modifier |
67 |
*) |
68 |
let pp_prototype_modifiers fmt modifier = |
69 |
fprintf fmt "%s" (match modifier with |
70 |
| In -> "in" |
71 |
| Out -> "out") |
72 |
|
73 |
(** Print a variable declaration. |
74 |
@param fmt the formater to print on |
75 |
@param id the variable |
76 |
*) |
77 |
let pp_var_decl fmt id = |
78 |
fprintf fmt "type %a is %a;" |
79 |
pp_var_name id |
80 |
pp_var_type id |
81 |
|
82 |
(** Print the parameter of a prototype, a list of modifier(eg. in or out) |
83 |
can be given to specify the type. |
84 |
@param modifiers list of the modifiers for this parameter |
85 |
@param fmt the formater to print on |
86 |
@param id the variable |
87 |
*) |
88 |
let pp_parameter modifiers fmt id = |
89 |
fprintf fmt "%a: %a %a" |
90 |
pp_var_name id |
91 |
(Utils.fprintf_list ~sep:"@ " pp_prototype_modifiers) modifiers |
92 |
pp_var_type id |
93 |
|
94 |
(** Print the prototype of a procedure |
95 |
@param fmt the formater to print on |
96 |
@param name the name of the procedure |
97 |
@param input list of the input parameter of the procedure |
98 |
@param output list of the output parameter of the procedure |
99 |
*) |
100 |
let pp_simple_prototype fmt (name, input, output) = |
101 |
fprintf fmt "procedure %s(@[<v>@[%a%t%a@])@]" |
102 |
name |
103 |
(Utils.fprintf_list ~sep:",@ " (pp_parameter [In])) input |
104 |
(Utils.pp_final_char_if_non_empty ",@," input) |
105 |
(Utils.fprintf_list ~sep:",@ " (pp_parameter [Out])) output |
106 |
|
107 |
(** Print the prototype of the init procedure of a machine. |
108 |
@param fmt the formater to print on |
109 |
@param m the machine |
110 |
*) |
111 |
let pp_init_prototype fmt m = |
112 |
pp_simple_prototype fmt ("init", m.mstatic, []) |
113 |
|
114 |
(** Print the prototype of the step procedure of a machine. |
115 |
@param fmt the formater to print on |
116 |
@param m the machine |
117 |
*) |
118 |
let pp_step_prototype fmt m = |
119 |
pp_simple_prototype fmt ("step", m.mstep.step_inputs, m.mstep.step_outputs) |
120 |
|
121 |
(** Print the prototype of the reset procedure of a machine. |
122 |
@param fmt the formater to print on |
123 |
@param m the machine |
124 |
*) |
125 |
let pp_reset_prototype fmt m = |
126 |
pp_simple_prototype fmt ("reset", m.mstatic, []) |
127 |
|
128 |
(** Print the prototype of the clear procedure of a machine. |
129 |
@param fmt the formater to print on |
130 |
@param m the machine |
131 |
*) |
132 |
let pp_clear_prototype fmt m = |
133 |
pp_simple_prototype fmt ("clear", m.mstatic, []) |