Revision b12a91e0 src/backends/Ada/ada_backend_common.ml
src/backends/Ada/ada_backend_common.ml | ||
---|---|---|
5 | 5 |
open Corelang |
6 | 6 |
open Machine_code_common |
7 | 7 |
|
8 |
(** All the pretty print functions common to the ada backend **) |
|
9 |
|
|
10 |
(* Package pretty print functions *) |
|
11 |
|
|
8 | 12 |
(** Print the name of a package associated to a machine. |
9 | 13 |
@param fmt the formater to print on |
10 | 14 |
@param machine the machine |
... | ... | |
12 | 16 |
let pp_package_name fmt machine = |
13 | 17 |
fprintf fmt "%s" machine.mname.node_id |
14 | 18 |
|
15 |
|
|
16 | 19 |
(** Print the ada package introduction sentence it can be used for body and |
17 | 20 |
declaration. Boolean parameter body should be true if it is a body delcaration. |
18 | 21 |
@param fmt the formater to print on |
... | ... | |
30 | 33 |
*) |
31 | 34 |
let pp_end_package fmt machine = |
32 | 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, []) |
Also available in: Unified diff