Project

General

Profile

« Previous | Next » 

Revision fd834769

Added by Guillaume DAVY almost 3 years ago

Ada: Add the generation of the wrapper file : the main ada file and the project. It is called
only if the main node option is given to lustrec. This feature implied some refactoring. Also
added some OCaml Doc to undocummented functions.

View differences:

src/backends/Ada/ada_backend_common.ml
7 7

  
8 8
(** All the pretty print functions common to the ada backend **)
9 9

  
10
(* Misc pretty print functions *)
10 11

  
11 12
(** Print a cleaned an identifier for ada exportation : Ada names must not start by an
12 13
    underscore and must not contain a double underscore 
13 14
   @param var name to be cleaned*)
14
let print_clean_ada_identifier fmt name =
15
let pp_clean_ada_identifier fmt name =
15 16
  let base_size = String.length name in
16 17
  assert(base_size > 0);
17 18
  let rec remove_double_underscore s = function
......
29 30
  in
30 31
  fprintf fmt "%s%s" prefix name
31 32

  
32

  
33 33
(* Package pretty print functions *)
34 34

  
35 35
(** Print the name of a package associated to a machine.
......
37 37
   @param machine the machine
38 38
**)
39 39
let pp_package_name fmt node =
40
    fprintf fmt "%a" print_clean_ada_identifier node.node_id
40
    fprintf fmt "%a" pp_clean_ada_identifier node.node_id
41 41

  
42 42
(** Print the ada package introduction sentence it can be used for body and
43 43
declaration. Boolean parameter body should be true if it is a body delcaration.
......
65 65
let pp_package_access fmt (package, item) =
66 66
  fprintf fmt "%t.%t" package item
67 67

  
68
(** Print the name of the main procedure.
69
   @param fmt the formater to print on
70
   @param main_machine the machine associated to the main node
71
**)
72
let pp_main_procedure_name main_machine fmt =
73
  fprintf fmt "main"
74

  
75
(** Print the name of the main ada file.
76
   @param fmt the formater to print on
77
   @param main_machine the machine associated to the main node
78
**)
79
let pp_main_filename fmt main_machine =
80
  fprintf fmt "%t.adb" (pp_main_procedure_name main_machine)
81

  
82
(** Extract a node from an instance.
83
   @param instance the instance
84
**)
85
let extract_node instance =
86
  let (_, (node, _)) = instance in
87
  match node.top_decl_desc with 
88
    | Node nd         -> nd
89
    | _ -> assert false (*TODO*)
90

  
91
(** Print a with statement to include a node.
92
   @param fmt the formater to print on
93
   @param node the node
94
**)
95
let pp_with_node fmt node =
96
  fprintf fmt "private with %a" pp_package_name node
97

  
98

  
68 99
(* Type pretty print functions *)
69 100

  
70 101
(** Print a type declaration
......
148 179
   @param id the variable
149 180
**)
150 181
let pp_var_name fmt id =
151
  fprintf fmt "%a" print_clean_ada_identifier id.var_id
182
  fprintf fmt "%a" pp_clean_ada_identifier id.var_id
152 183

  
153 184
(** Print a variable declaration
154 185
   @param mode input/output mode of the parameter
......
183 214
  let pp_type = pp_state_type in
184 215
  pp_var_decl fmt (mode, pp_name, pp_type)
185 216

  
217
(** Print the declaration of a state element of node.
218
   @param instance name of the variable
219
   @param fmt the formater to print on
220
   @param instance node
221
**)
222
let pp_node_state_decl name fmt node =
223
  let pp_package fmt = pp_package_name fmt node in
224
  let pp_type fmt = pp_package_access fmt (pp_package, pp_state_type) in
225
  let pp_name fmt = pp_clean_ada_identifier fmt name in
226
  pp_var_decl fmt (NoMode, pp_name, pp_type)
186 227

  
187 228
(* Prototype pretty print functions *)
188 229

  
......
198 239
(** Print the clear of the init procedure **)
199 240
let pp_clear_procedure_name fmt = fprintf fmt "clear"
200 241

  
242
(** Print the prototype of a procedure with non input/outputs
243
   @param fmt the formater to print on
244
   @param name the name of the procedure
245
**)
246
let pp_simple_prototype fmt pp_name =
247
  fprintf fmt "procedure %t" pp_name
248

  
201 249
(** Print the prototype of a machine procedure. The first parameter is always
202 250
the state, state_modifier specify the modifier applying to it. The next
203 251
parameters are inputs and the last parameters are the outputs.
204
   @param fmt the formater to print on
205
   @param name the name of the procedure
206 252
   @param state_mode the input/output mode for the state parameter
207 253
   @param input list of the input parameter of the procedure
208 254
   @param output list of the output parameter of the procedure
255
   @param fmt the formater to print on
256
   @param name the name of the procedure
209 257
**)
210
let pp_simple_prototype fmt (pp_name, state_mode, input, output) =
258
let pp_base_prototype state_mode input output fmt pp_name =
211 259
  fprintf fmt "procedure %t(@[<v>%a%t@[%a@]%t@[%a@])@]"
212 260
    pp_name
213 261
    pp_state_var_decl state_mode
......
217 265
    (Utils.fprintf_list ~sep:";@ " (pp_machine_var_decl Out)) output
218 266

  
219 267
(** Print the prototype of the init procedure of a machine.
220
   @param fmt the formater to print on
221 268
   @param m the machine
269
   @param fmt the formater to print on
270
   @param pp_name name function printer
222 271
**)
223
let pp_init_prototype fmt m =
224
  pp_simple_prototype fmt (pp_init_procedure_name, Out, m.mstatic, [])
272
let pp_init_prototype m fmt pp_name =
273
  pp_base_prototype Out m.mstatic [] fmt pp_name
225 274

  
226 275
(** Print the prototype of the step procedure of a machine.
227
   @param fmt the formater to print on
228 276
   @param m the machine
277
   @param fmt the formater to print on
278
   @param pp_name name function printer
229 279
**)
230
let pp_step_prototype fmt m =
231
  pp_simple_prototype fmt (pp_step_procedure_name, InOut, m.mstep.step_inputs, m.mstep.step_outputs)
280
let pp_step_prototype m fmt pp_name =
281
  pp_base_prototype InOut m.mstep.step_inputs m.mstep.step_outputs fmt pp_name
232 282

  
233 283
(** Print the prototype of the reset procedure of a machine.
234
   @param fmt the formater to print on
235 284
   @param m the machine
285
   @param fmt the formater to print on
286
   @param pp_name name function printer
236 287
**)
237
let pp_reset_prototype fmt m =
238
  pp_simple_prototype fmt (pp_reset_procedure_name, InOut, m.mstatic, [])
288
let pp_reset_prototype m fmt pp_name =
289
  pp_base_prototype InOut m.mstatic [] fmt pp_name
239 290

  
240 291
(** Print the prototype of the clear procedure of a machine.
241
   @param fmt the formater to print on
242 292
   @param m the machine
293
   @param fmt the formater to print on
294
   @param pp_name name function printer
243 295
**)
244
let pp_clear_prototype fmt m =
245
  pp_simple_prototype fmt (pp_clear_procedure_name, InOut, m.mstatic, [])
296
let pp_clear_prototype m fmt pp_name =
297
  pp_base_prototype InOut m.mstatic [] fmt pp_name
298

  
299

  
300
(* Procedure pretty print functions *)
301

  
302
(** Print the definition of a procedure
303
   @param pp_name the procedure name printer
304
   @param pp_prototype the prototype printer
305
   @param pp_instr local var printer
306
   @param pp_instr instruction printer
307
   @param fmt the formater to print on
308
   @param locals locals var list
309
   @param instrs instructions list
310
**)
311
let pp_procedure_definition pp_name pp_prototype pp_local pp_instr fmt (locals, instrs) =
312
  fprintf fmt "@[<v>%a is%t@[<v>%a%t@]@,begin@,  @[<v>%a%t@]@,end %t@]"
313
    pp_prototype pp_name
314
    (Utils.pp_final_char_if_non_empty "@,  " locals)
315
    (Utils.fprintf_list ~sep:";@," pp_local) locals
316
    (Utils.pp_final_char_if_non_empty ";" locals)
317
    (Utils.fprintf_list ~sep:";@," pp_instr) instrs
318
    (Utils.pp_final_char_if_non_empty ";" instrs)
319
    pp_name
320

  

Also available in: Unified diff