Revision c06b3b47 src/backends/Ada/ada_backend_common.ml
src/backends/Ada/ada_backend_common.ml | ||
---|---|---|
35 | 35 |
fprintf fmt "end %a;" pp_package_name machine |
36 | 36 |
|
37 | 37 |
|
38 |
(* Variable pretty print functions *)
|
|
38 |
(* Type pretty print functions *)
|
|
39 | 39 |
|
40 |
(** Print the name of a variable.
|
|
40 |
(** Print a type declaration
|
|
41 | 41 |
@param fmt the formater to print on |
42 |
@param id the variable |
|
42 |
@param pp_name a format printer which print the type name |
|
43 |
@param pp_value a format printer which print the type definition |
|
43 | 44 |
*) |
44 |
let pp_var_name fmt id = |
|
45 |
fprintf fmt "%s" id.var_id |
|
45 |
let pp_type_decl fmt (pp_name, pp_definition) = |
|
46 |
fprintf fmt "type %t is %t" pp_name pp_definition |
|
47 |
|
|
48 |
(** Print a private type declaration |
|
49 |
@param fmt the formater to print on |
|
50 |
@param pp_name a format printer which print the type name |
|
51 |
*) |
|
52 |
let pp_private_type_decl fmt pp_name = |
|
53 |
let pp_definition fmt = fprintf fmt "private" in |
|
54 |
pp_type_decl fmt (pp_name, pp_definition) |
|
55 |
|
|
56 |
(** Print the type of the state variable. |
|
57 |
@param fmt the formater to print on |
|
58 |
*) |
|
59 |
let pp_state_type fmt = |
|
60 |
fprintf fmt "State" |
|
46 | 61 |
|
47 | 62 |
(** Print the type of a variable. |
48 | 63 |
@param fmt the formater to print on |
... | ... | |
50 | 65 |
*) |
51 | 66 |
let pp_var_type fmt id = fprintf fmt |
52 | 67 |
(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"
|
|
68 |
| Types.Tbasic Types.Basic.Tint -> "Integer"
|
|
69 |
| Types.Tbasic Types.Basic.Treal -> "Float"
|
|
70 |
| Types.Tbasic Types.Basic.Tbool -> "Boolean"
|
|
56 | 71 |
| _ -> eprintf "Type error : %a@." Types.print_ty id.var_type; assert false (*TODO*) |
57 | 72 |
) |
73 |
|
|
58 | 74 |
|
75 |
(* Variable pretty print functions *) |
|
59 | 76 |
|
60 |
(* Prototype pretty print functions *) |
|
61 |
|
|
62 |
type prototype_modifiers = In | Out |
|
77 |
(** Represent the possible mode for a type of a procedure parameter **) |
|
78 |
type parameter_mode = NoMode | In | Out | InOut |
|
63 | 79 |
|
64 |
(** Print a prototype_modifiers. |
|
80 |
(** Print a parameter_mode. |
|
81 |
@param fmt the formater to print on |
|
82 |
@param mode the modifier |
|
83 |
*) |
|
84 |
let pp_parameter_mode fmt mode = |
|
85 |
fprintf fmt "%s" (match mode with |
|
86 |
| NoMode -> "" |
|
87 |
| In -> "in" |
|
88 |
| Out -> "out" |
|
89 |
| InOut -> "in out") |
|
90 |
|
|
91 |
(** Print the name of the state variable. |
|
65 | 92 |
@param fmt the formater to print on |
66 |
@param modifier the modifier |
|
67 | 93 |
*) |
68 |
let pp_prototype_modifiers fmt modifier = |
|
69 |
fprintf fmt "%s" (match modifier with |
|
70 |
| In -> "in" |
|
71 |
| Out -> "out") |
|
94 |
let pp_state_name fmt = |
|
95 |
fprintf fmt "state" |
|
72 | 96 |
|
73 |
(** Print a variable declaration.
|
|
97 |
(** Print the name of a variable.
|
|
74 | 98 |
@param fmt the formater to print on |
75 | 99 |
@param id the variable |
76 | 100 |
*) |
77 |
let pp_var_decl fmt id = |
|
78 |
fprintf fmt "type %a is %a;" |
|
79 |
pp_var_name id |
|
80 |
pp_var_type id |
|
101 |
let pp_var_name fmt id = |
|
102 |
fprintf fmt "%s" id.var_id |
|
81 | 103 |
|
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 |
|
104 |
(** Print a variable declaration |
|
105 |
@param mode input/output mode of the parameter |
|
106 |
@param pp_name a format printer wich print the variable name |
|
107 |
@param pp_type a format printer wich print the variable type |
|
108 |
@param fmt the formater to print on |
|
109 |
@param id the variable |
|
110 |
*) |
|
111 |
let pp_var_decl fmt (mode, pp_name, pp_type) = |
|
112 |
fprintf fmt "%t: %a %t" |
|
113 |
pp_name |
|
114 |
pp_parameter_mode mode |
|
115 |
pp_type |
|
116 |
|
|
117 |
(** Print variable declaration for machine variable |
|
118 |
@param mode input/output mode of the parameter |
|
85 | 119 |
@param fmt the formater to print on |
86 | 120 |
@param id the variable |
87 | 121 |
*) |
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 |
|
122 |
let pp_machine_var_decl mode fmt id = |
|
123 |
let pp_name = function fmt -> pp_var_name fmt id in |
|
124 |
let pp_type = function fmt -> pp_var_type fmt id in |
|
125 |
pp_var_decl fmt (mode, pp_name, pp_type) |
|
126 |
|
|
127 |
(** Print variable declaration for state variable |
|
128 |
@param fmt the formater to print on |
|
129 |
@param mode input/output mode of the parameter |
|
130 |
*) |
|
131 |
let pp_state_var_decl fmt mode = |
|
132 |
let pp_name = pp_state_name in |
|
133 |
let pp_type = pp_state_type in |
|
134 |
pp_var_decl fmt (mode, pp_name, pp_type) |
|
135 |
|
|
136 |
(** Print a record definition. |
|
137 |
@param fmt the formater to print on |
|
138 |
@param var_list list of machine variable |
|
139 |
*) |
|
140 |
let pp_record_definition fmt var_list = |
|
141 |
fprintf fmt "@, @[<v>record@, @[<v>%a%t@]@,end record@]" |
|
142 |
(Utils.fprintf_list ~sep:";@;" (pp_machine_var_decl NoMode)) var_list |
|
143 |
(Utils.pp_final_char_if_non_empty "," var_list) |
|
144 |
|
|
145 |
|
|
146 |
(* Prototype pretty print functions *) |
|
93 | 147 |
|
94 |
(** Print the prototype of a procedure |
|
148 |
(** Print the prototype of a machine procedure. The first parameter is always |
|
149 |
the state, state_modifier specify the modifier applying to it. The next |
|
150 |
parameters are inputs and the last parameters are the outputs. |
|
95 | 151 |
@param fmt the formater to print on |
96 | 152 |
@param name the name of the procedure |
153 |
@param state_mode the input/output mode for the state parameter |
|
97 | 154 |
@param input list of the input parameter of the procedure |
98 | 155 |
@param output list of the output parameter of the procedure |
99 | 156 |
*) |
100 |
let pp_simple_prototype fmt (name, input, output) = |
|
101 |
fprintf fmt "procedure %s(@[<v>@[%a%t%a@])@]"
|
|
157 |
let pp_simple_prototype fmt (name, state_mode, input, output) =
|
|
158 |
fprintf fmt "procedure %s(@[<v>%a%t@[%a@]%t@[%a@])@]"
|
|
102 | 159 |
name |
103 |
(Utils.fprintf_list ~sep:",@ " (pp_parameter [In])) input
|
|
160 |
pp_state_var_decl state_mode
|
|
104 | 161 |
(Utils.pp_final_char_if_non_empty ",@," input) |
105 |
(Utils.fprintf_list ~sep:",@ " (pp_parameter [Out])) output |
|
162 |
(Utils.fprintf_list ~sep:",@ " (pp_machine_var_decl In)) input |
|
163 |
(Utils.pp_final_char_if_non_empty ",@," output) |
|
164 |
(Utils.fprintf_list ~sep:",@ " (pp_machine_var_decl Out)) output |
|
106 | 165 |
|
107 | 166 |
(** Print the prototype of the init procedure of a machine. |
108 | 167 |
@param fmt the formater to print on |
109 | 168 |
@param m the machine |
110 | 169 |
*) |
111 | 170 |
let pp_init_prototype fmt m = |
112 |
pp_simple_prototype fmt ("init", m.mstatic, []) |
|
171 |
pp_simple_prototype fmt ("init", Out, m.mstatic, [])
|
|
113 | 172 |
|
114 | 173 |
(** Print the prototype of the step procedure of a machine. |
115 | 174 |
@param fmt the formater to print on |
116 | 175 |
@param m the machine |
117 | 176 |
*) |
118 | 177 |
let pp_step_prototype fmt m = |
119 |
pp_simple_prototype fmt ("step", m.mstep.step_inputs, m.mstep.step_outputs) |
|
178 |
pp_simple_prototype fmt ("step", InOut, m.mstep.step_inputs, m.mstep.step_outputs)
|
|
120 | 179 |
|
121 | 180 |
(** Print the prototype of the reset procedure of a machine. |
122 | 181 |
@param fmt the formater to print on |
123 | 182 |
@param m the machine |
124 | 183 |
*) |
125 | 184 |
let pp_reset_prototype fmt m = |
126 |
pp_simple_prototype fmt ("reset", m.mstatic, []) |
|
185 |
pp_simple_prototype fmt ("reset", InOut, m.mstatic, [])
|
|
127 | 186 |
|
128 | 187 |
(** Print the prototype of the clear procedure of a machine. |
129 | 188 |
@param fmt the formater to print on |
130 | 189 |
@param m the machine |
131 | 190 |
*) |
132 | 191 |
let pp_clear_prototype fmt m = |
133 |
pp_simple_prototype fmt ("clear", m.mstatic, []) |
|
192 |
pp_simple_prototype fmt ("clear", InOut, m.mstatic, []) |
Also available in: Unified diff