Project

General

Profile

« Previous | Next » 

Revision fd834769

Added by Guillaume DAVY over 5 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.ml
12 12
open Format
13 13
open Machine_code_types
14 14

  
15
let gen_ada destname print suffix machine =
16
  (* Next line permit to get the final package name mostly to clean the
17
    identifier for Ada *)
18
  let name = asprintf "%a" Ada_backend_common.pp_package_name machine.mname in
19
  let name = String.lowercase_ascii name in
20
  let path = destname ^ name ^ suffix in
15
open Ada_backend_common
16

  
17
let indent_size = 2
18

  
19
(** Log at level 2 a string message with some indentation.
20
   @param indent the indentation level
21
   @param info the message
22
**)
23
let log_str_level_two indent info =
24
  let str_indent = String.make (indent*indent_size) ' ' in
25
  let pp_message fmt = fprintf fmt "%s.. %s@." str_indent info in
26
  Log.report ~level:2 pp_message
27

  
28
(** Encapsulate a pretty print function to lower case its result when applied
29
   @param pp the pretty print function
30
   @param fmt the formatter
31
   @param arg the argument of the pp function
32
**)
33
let pp_lowercase pp fmt arg =
34
  let str = asprintf "%a" pp arg in
35
  fprintf fmt "%s" (String. lowercase_ascii str)
36

  
37
(** Write a new file with formatter
38
   @param destname folder where the file shoudl be created
39
   @param pp_filename function printing the filename
40
   @param pp_file function wich pretty print the file
41
   @param arg will be given to pp_filename and pp_file
42
**)
43
let write_file destname pp_filename pp_file arg =
44
  let path = asprintf "%s%a" destname pp_filename arg in
21 45
  let out = open_out path in
22 46
  let fmt = formatter_of_out_channel out in
23
  print fmt machine;
47
  pp_file fmt arg;
48
  pp_print_flush fmt ();
24 49
  close_out out;
25
  Log.report ~level:2 (fun fmt -> fprintf fmt "    .. %s generated @." path)
50
  log_str_level_two 2 (path^" generated")
51

  
26 52

  
53
(** Print the filename of a package by lowercasing it and appending
54
  an extension.
55
   @param extension the extension to append to the package name
56
   @param fmt the formatter
57
   @param fmt the machine corresponding to the package
58
**)
59
let pp_machine_filename extension fmt machine =
60
  fprintf fmt "%a.%s"
61
    (pp_lowercase pp_package_name) machine.mname
62
    extension
63

  
64
(** Exception raised when a machine contains a feature not supported by the
65
  Ada backend*)
27 66
exception CheckFailed of string
28 67

  
68

  
69
(** Check that a machine match the requirement for an Ada compilation :
70
      - No constants.
71
   @param machine the machine to test
72
**)
29 73
let check machine =
30 74
  match machine.mconst with
31 75
    | [] -> ()
32 76
    | _ -> raise (CheckFailed "machine.mconst should be void")
33 77

  
78
(** Print the name of the ada project file.
79
   @param fmt the formater to print on
80
   @param main_machine the machine associated to the main node
81
**)
82
let pp_project_name fmt main_machine =
83
  fprintf fmt "%a.gpr" pp_package_name main_machine.mname
84

  
85
(** Main function of the Ada backend. It calls all the subfunction creating all
86
the file and fill them with Ada code representing the machines list given.
87
   @param basename useless
88
   @param prog useless
89
   @param prog list of machines to translate
90
   @param dependencies useless
91
**)
34 92
let translate_to_ada basename prog machines dependencies =
35 93
  let module Ads = Ada_backend_ads.Main in
36 94
  let module Adb = Ada_backend_adb.Main in
37 95
  let module Wrapper = Ada_backend_wrapper.Main in
38 96

  
39
  let destname = !Options.dest_dir ^ "/" in
97
  (* Extract the main machine if there is one *)
98
  let main_machine = (match !Options.main_node with
99
  | "" -> None
100
  | main_node -> (
101
    match Machine_code_common.get_machine_opt main_node machines with
102
    | None -> begin
103
      Format.eprintf "Ada Code generation error: %a@." Error.pp_error_msg Error.Main_not_found;
104
      raise (Corelang.Error (Location.dummy_loc, Error.Main_not_found))
105
    end
106
    | Some m -> Some m
107
  )) in
40 108

  
41
  Log.report ~level:2 (fun fmt -> fprintf fmt "  .. Checking machines@.");
109
  let destname = !Options.dest_dir ^ "/" in
42 110

  
111
  log_str_level_two 1 "Checking machines";
43 112
  List.iter check machines;
44 113

  
45
  Log.report ~level:2 (fun fmt -> fprintf fmt "  .. Generating ads@.");
114
  log_str_level_two 1 "Generating ads";
115
  List.iter (write_file destname (pp_machine_filename "ads") Ads.pp_file) machines;
46 116

  
47
  List.iter (gen_ada destname Ads.print ".ads") machines;
117
  log_str_level_two 1 "Generating adb";
118
  List.iter (write_file destname (pp_machine_filename "adb") Adb.pp_file) machines;
48 119

  
49
  Log.report ~level:2 (fun fmt -> fprintf fmt "  .. Generating adb@.");
120
  (* If a main node is given we generate a main adb file and a project file *)
121
  log_str_level_two 1 "Generating wrapper files";
122
  match main_machine with
123
    | None -> log_str_level_two 2 "File not generated(no -node argument)";
124
    | Some machine -> begin
125
        write_file destname pp_project_name Wrapper.pp_project_file machine;
126
        write_file destname pp_main_filename Wrapper.pp_main_file machine;
127
      end
50 128

  
51
  List.iter (gen_ada destname Adb.print ".adb") machines
52 129

  
53 130
(* Local Variables: *)
54 131
(* compile-command:"make -C ../../.." *)
src/backends/Ada/ada_backend_adb.ml
22 22
struct
23 23

  
24 24
let pp_machine_instr machine fmt instr =
25
    fprintf fmt "instruction"
26

  
25
    fprintf fmt "NULL"
27 26

  
28 27
(** Keep only the MReset from an instruction list.
29 28
  @param list to filter
......
32 31
  (fun i -> match get_instr_desc i with MReset i -> i | _ -> assert false)
33 32
  instr_list
34 33

  
35
(** Print the definition of a procedure
36
   @param fmt the formater to print on
37
   @param m the machine
38
   @param pp_procedure_name the procedure name printer
39
   @param pp_prototype the prototype printer
40
   @param instrs the instructions of the procedure
41
**)
42
let pp_procedure_definition fmt (m, pp_procedure_name, pp_prototype, instrs) =
43
  let pp_instr = pp_machine_instr m in
44
  fprintf fmt "%a is@,begin@,  @[<v>%a%t@]@,end %t"
45
    pp_prototype m
46
    (Utils.fprintf_list ~sep:";@," pp_instr) instrs
47
    (Utils.pp_final_char_if_non_empty ";" instrs)
48
    pp_procedure_name
49

  
50 34
(** Print the definition of the init procedure from a machine.
51 35
   @param fmt the formater to print on
52 36
   @param machine the machine
53 37
**)
54
let pp_init_definition fmt m =
55
  pp_procedure_definition fmt
56
    (m, pp_init_procedure_name, pp_init_prototype, m.minit)
38
let pp_init_definition fmt m = pp_procedure_definition
39
      pp_init_procedure_name
40
      (pp_init_prototype m)
41
      pp_var_decl
42
      (pp_machine_instr m)
43
      fmt
44
      ([], m.minit)
57 45

  
58 46
(** Print the definition of the step procedure from a machine.
59 47
   @param fmt the formater to print on
60 48
   @param machine the machine
61 49
**)
62
let pp_step_definition fmt m =
63
  pp_procedure_definition fmt
64
    (m, pp_step_procedure_name, pp_step_prototype, m.minit)
50
let pp_step_definition fmt m = pp_procedure_definition
51
      pp_step_procedure_name
52
      (pp_step_prototype m)
53
      pp_var_decl
54
      (pp_machine_instr m)
55
      fmt
56
      ([], m.minit)
65 57

  
66 58
(** Print the definition of the reset procedure from a machine.
67 59
   @param fmt the formater to print on
68 60
   @param machine the machine
69 61
**)
70
let pp_reset_definition fmt m =
71
  pp_procedure_definition fmt
72
    (m, pp_reset_procedure_name, pp_reset_prototype, filter_reset m.minit)
62
let pp_reset_definition fmt m = pp_procedure_definition
63
      pp_reset_procedure_name
64
      (pp_reset_prototype m)
65
      pp_var_decl
66
      (pp_machine_instr m)
67
      fmt
68
      ([], m.minit)
73 69

  
74 70
(** Print the definition of the clear procedure from a machine.
75 71
   @param fmt the formater to print on
76 72
   @param machine the machine
77 73
**)
78
let pp_clear_definition fmt m =
79
  pp_procedure_definition fmt
80
    (m, pp_clear_procedure_name, pp_clear_prototype, filter_reset m.minit)
74
let pp_clear_definition fmt m = pp_procedure_definition
75
      pp_clear_procedure_name
76
      (pp_clear_prototype m)
77
      pp_var_decl
78
      (pp_machine_instr m)
79
      fmt
80
      ([], filter_reset m.minit)
81 81

  
82 82
(** Print the package definition(adb) of a machine.
83 83
   @param fmt the formater to print on
84 84
   @param machine the machine
85 85
**)
86
let print fmt machine =
86
let pp_file fmt machine =
87 87
  fprintf fmt "%a@,  @[<v>@,%a;@,@,%a;@,@,%a;@,@,%a;@,@]@,%a;@."
88 88
    (pp_begin_package true) machine (*Begin the package*)
89 89
    pp_init_definition machine (*Define the init procedure*)
src/backends/Ada/ada_backend_ads.ml
22 22
module Main =
23 23
struct
24 24

  
25
(** Print name of a node associated to an instance.
25
(** Print a with statement to include an instance.
26 26
   @param fmt the formater to print on
27 27
   @param instance the instance
28 28
**)
29
let pp_instance_node_name fmt instance =
30
  let (_, (node, _)) = instance in
31
  let node = match node.top_decl_desc with 
32
              | Node nd         -> nd
33
              | _ -> assert false (*TODO*) in
34
  pp_package_name fmt node
29
let pp_with_subinstance fmt instance =
30
  pp_with_node fmt (extract_node instance)
35 31

  
36 32
(** Print the declaration of a state element of a subinstance of a machine.
37 33
   @param fmt the formater to print on
38 34
   @param instance the instance
39 35
**)
40 36
let pp_machine_subinstance_state_decl fmt instance =
41
  let (name, (node, static)) = instance in
42
  let pp_package fmt = pp_instance_node_name fmt instance in
43
  let pp_type fmt = pp_package_access fmt (pp_package, pp_state_type) in
44
  let pp_name fmt = print_clean_ada_identifier fmt name in
45
  pp_var_decl fmt (NoMode, pp_name, pp_type)
37
  pp_node_state_decl (fst instance) fmt (extract_node instance)
46 38

  
47 39
(** Print the state record for a machine.
48 40
   @param fmt the formater to print on
......
55 47
    (Utils.fprintf_list ~sep:";@;" (pp_machine_var_decl NoMode)) var_list
56 48
    (Utils.pp_final_char_if_non_empty ";" var_list)
57 49

  
58
(** Print a with statement to include an instance.
59
   @param fmt the formater to print on
60
   @param instance the instance
61
**)
62
let pp_with_subinstance fmt instance =
63
  fprintf fmt "private with %a" pp_instance_node_name instance
64

  
65 50
(** Print the package declaration(ads) of a machine.
66 51
   @param fmt the formater to print on
67
   @param machine the machine
52
   @param m the machine
68 53
**)
69
let print fmt machine =
54
let pp_file fmt m =
70 55
  (* Take apart the arrow instance from the instance list and transform them
71 56
     into simple boolean variable *)
72 57
  let extract (instances, arrows) instance =
......
75 60
      (instances, (dummy_var_decl name Type_predef.type_bool)::arrows)
76 61
    else
77 62
      (instance::instances, arrows) in
78
  let instances, arrows = List.fold_left extract ([], []) machine.minstances in
63
  let instances, arrows = List.fold_left extract ([], []) m.minstances in
79 64
  (* Add the boolean variable reated for arrow instance to the list of all variable *)
80
  let var_list = arrows@machine.mmemory in
65
  let var_list = arrows@m.mmemory in
81 66
  let pp_record fmt = pp_state_record_definition fmt (var_list, instances) in
82 67
  fprintf fmt "@[<v>%a%t@,%a@,  @[<v>@,%a;@,@,%a;@,@,%a;@,@,%a;@,@,%a;@,@,private@,@,%a;@,@]@,%a;@.@]"
83
    (Utils.fprintf_list ~sep:";@," pp_with_subinstance) instances (* Include all the subinstance*)
68
    
69
    (* Include all the subinstance*)
70
    (Utils.fprintf_list ~sep:";@," pp_with_subinstance) instances
84 71
    (Utils.pp_final_char_if_non_empty ";@," instances)
85
    (pp_begin_package false) machine (*Begin the package*)
86
    pp_private_type_decl pp_state_type (*Declare the state type*)
87
    pp_init_prototype machine (*Declare the init procedure*)
88
    pp_step_prototype machine (*Declare the step procedure*)
89
    pp_reset_prototype machine (*Declare the reset procedure*)
90
    pp_clear_prototype machine (*Declare the clear procedure*)
91
    pp_type_decl (pp_state_type, pp_record) (*Define the state type*)
92
    pp_end_package machine  (*End the package*)
72
    
73
    (*Begin the package*)
74
    (pp_begin_package false) m
75
    
76
    (*Declare the state type*)
77
    pp_private_type_decl pp_state_type
78
    
79
    (*Declare the init procedure*)
80
    (pp_init_prototype m) pp_init_procedure_name
81
    
82
    (*Declare the step procedure*)
83
    (pp_step_prototype m) pp_step_procedure_name
84
    
85
    (*Declare the reset procedure*)
86
    (pp_reset_prototype m) pp_reset_procedure_name
87
    
88
    (*Declare the clear procedure*)
89
    (pp_clear_prototype m) pp_clear_procedure_name
90
    
91
    (*Define the state type*)
92
    pp_type_decl (pp_state_type, pp_record)
93
    
94
    (*End the package*)
95
    pp_end_package m
93 96

  
94 97
end
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

  
src/backends/Ada/ada_backend_wrapper.ml
9 9
(*                                                                  *)
10 10
(********************************************************************)
11 11

  
12
open Format
13

  
14
open Machine_code_types
15
open Ada_backend_common
16

  
12 17
module Main =
13 18
struct
19

  
20
(** Print the main procedure
21
   @param fmt the formater to print on
22
   @param machine the main machine
23
   @param locals list of local variable printers
24
   @param instrs list of instructions printer
25
**)
26
let pp_main_procedure_definition machine fmt (locals, instrs) =
27
    pp_procedure_definition
28
      (pp_main_procedure_name machine)
29
      pp_simple_prototype
30
      (fun fmt local -> fprintf fmt "%t" local)
31
      (fun fmt instr -> fprintf fmt "%t" instr)
32
      fmt
33
      (locals, instrs)
34

  
35
(** Print call to machine procedure on state.
36
   @param instance name of the variable
37
   @param fmt the formater to print on
38
   @param instance node
39
**)
40
let pp_node_init_call name fmt node =
41
  let pp_package fmt = pp_package_name fmt node in
42
  let pp_type fmt = pp_package_access fmt (pp_package, pp_state_type) in
43
  let pp_name fmt = pp_clean_ada_identifier fmt name in
44
  pp_var_decl fmt (NoMode, pp_name, pp_type)
45

  
46
(** Print the main file calling in a loop the step function of the main machine.
47
   @param fmt the formater to print on
48
   @param machine the main machine
49
**)
50
let pp_main_file fmt machine =
51
  let stateVar = "state" in
52
  let step_parameters = machine.mstep.step_inputs@machine.mstep.step_outputs in
53
  let pp_local_state_var_decl fmt = pp_node_state_decl stateVar fmt machine.mname in
54
  let apply_pp_var_decl var fmt = pp_machine_var_decl NoMode fmt var in
55
  let locals = List.map apply_pp_var_decl step_parameters in
56
  let locals = pp_local_state_var_decl::locals in
57
  let pp_init fmt =
58
    fprintf fmt "%a.init(%s)"
59
      pp_package_name machine.mname
60
      stateVar in
61
  let pp_loop fmt =
62
    fprintf fmt "while true loop@,  %a.step(@[%s,@ %a@]);@,end loop"
63
      pp_package_name machine.mname
64
      stateVar
65
      (Utils.fprintf_list ~sep:",@ " pp_var_name) step_parameters
66
      in
67
  let instrs = [pp_init; pp_loop] in
68
  fprintf fmt "@[<v>%a;@,@,%a;@]"
69
    pp_with_node machine.mname
70
    (pp_main_procedure_definition machine) (locals, instrs)
71

  
72

  
73
(** Print the gpr project file.
74
   @param fmt the formater to print on
75
   @param machine the main machine
76
**)
77
let pp_project_file fmt machine =
78
    fprintf fmt "project %a is@.  for Main use (\"%a\");@.end %a;"
79
      pp_package_name machine.mname
80
      pp_main_filename machine
81
      pp_package_name machine.mname
82

  
14 83
end

Also available in: Unified diff