Revision b12a91e0 src/backends/Ada/ada_backend_ads.ml
src/backends/Ada/ada_backend_ads.ml | ||
---|---|---|
18 | 18 |
|
19 | 19 |
open Ada_backend_common |
20 | 20 |
|
21 |
(** Functions printing the .ads file **) |
|
21 | 22 |
module Main = |
22 | 23 |
struct |
23 | 24 |
|
24 |
(** Print the name of a variable. |
|
25 |
@param fmt the formater to print on |
|
26 |
@param id the variable |
|
27 |
*) |
|
28 |
let pp_var_name fmt id = |
|
29 |
fprintf fmt "%s" id.var_id |
|
30 |
|
|
31 |
(** Print the type of a variable. |
|
32 |
@param fmt the formater to print on |
|
33 |
@param id the variable |
|
34 |
*) |
|
35 |
let pp_var_type fmt id = fprintf fmt |
|
36 |
(match (Types.repr id.var_type).Types.tdesc with |
|
37 |
| Types.Tbasic Types.Basic.Tint -> "int" |
|
38 |
| Types.Tbasic Types.Basic.Treal -> "double" |
|
39 |
| Types.Tbasic Types.Basic.Tbool -> "bool" |
|
40 |
| _ -> eprintf "Type error : %a@." Types.print_ty id.var_type; assert false (*TODO*) |
|
41 |
) |
|
42 |
|
|
43 |
type prototype_modifiers = In | Out |
|
44 |
|
|
45 |
(** Print a prototype_modifiers. |
|
46 |
@param fmt the formater to print on |
|
47 |
@param modifier the modifier |
|
48 |
*) |
|
49 |
let pp_prototype_modifiers fmt modifier = |
|
50 |
fprintf fmt "%s" (match modifier with |
|
51 |
| In -> "in" |
|
52 |
| Out -> "out") |
|
53 |
|
|
54 |
(** Print a variable declaration. |
|
55 |
@param fmt the formater to print on |
|
56 |
@param id the variable |
|
57 |
*) |
|
58 |
let pp_var_decl fmt id = |
|
59 |
fprintf fmt "type %a is %a;" |
|
60 |
pp_var_name id |
|
61 |
pp_var_type id |
|
62 |
|
|
63 |
(** Print the parameter of a prototype, a list of modifier(eg. in or out) |
|
64 |
can be given to specify the type. |
|
65 |
@param modifiers list of the modifiers for this parameter |
|
66 |
@param fmt the formater to print on |
|
67 |
@param id the variable |
|
68 |
*) |
|
69 |
let pp_parameter modifiers fmt id = |
|
70 |
fprintf fmt "%a: %a %a" |
|
71 |
pp_var_name id |
|
72 |
(Utils.fprintf_list ~sep:"@ " pp_prototype_modifiers) modifiers |
|
73 |
pp_var_type id |
|
74 |
|
|
75 |
(** Print the prototype of a procedure |
|
76 |
@param fmt the formater to print on |
|
77 |
@param name the name of the procedure |
|
78 |
@param input list of the input parameter of the procedure |
|
79 |
@param output list of the output parameter of the procedure |
|
80 |
*) |
|
81 |
let pp_simple_prototype fmt (name, input, output) = |
|
82 |
fprintf fmt "procedure %s(@[<v>@[%a%t%a@])@]" |
|
83 |
name |
|
84 |
(Utils.fprintf_list ~sep:",@ " (pp_parameter [In])) input |
|
85 |
(Utils.pp_final_char_if_non_empty ",@," input) |
|
86 |
(Utils.fprintf_list ~sep:",@ " (pp_parameter [Out])) output |
|
87 |
|
|
88 |
(** Print the prototype of the init procedure of a machine. |
|
89 |
@param fmt the formater to print on |
|
90 |
@param m the machine |
|
91 |
*) |
|
92 |
let pp_init_prototype fmt m = |
|
93 |
pp_simple_prototype fmt ("init", m.mstatic, []) |
|
94 |
|
|
95 |
(** Print the prototype of the step procedure of a machine. |
|
96 |
@param fmt the formater to print on |
|
97 |
@param m the machine |
|
98 |
*) |
|
99 |
let pp_step_prototype fmt m = |
|
100 |
pp_simple_prototype fmt ("step", m.mstep.step_inputs, m.mstep.step_outputs) |
|
101 |
|
|
102 |
(** Print the prototype of the reset procedure of a machine. |
|
103 |
@param fmt the formater to print on |
|
104 |
@param m the machine |
|
105 |
*) |
|
106 |
let pp_reset_prototype fmt m = |
|
107 |
pp_simple_prototype fmt ("reset", m.mstatic, []) |
|
108 |
|
|
109 |
(** Print the prototype of the clear procedure of a machine. |
|
110 |
@param fmt the formater to print on |
|
111 |
@param m the machine |
|
112 |
*) |
|
113 |
let pp_clear_prototype fmt m = |
|
114 |
pp_simple_prototype fmt ("clear", m.mstatic, []) |
|
115 |
|
|
116 | 25 |
(** Print the package declaration(ads) of a lustre node. |
117 | 26 |
@param fmt the formater to print on |
118 | 27 |
@param machine the machine |
Also available in: Unified diff