Project

General

Profile

« Previous | Next » 

Revision 9e5f8085

Added by Guillaume DAVY over 4 years ago

Ada: Add support for arrows as an independent generic package, instantiated in each
package using it. It required a lot of refactoring.

View differences:

src/backends/Ada/ada_backend.ml
25 25
  let pp_message fmt = fprintf fmt "%s.. %s@." str_indent info in
26 26
  Log.report ~level:2 pp_message
27 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 28
(** Write a new file with formatter
38 29
   @param destname folder where the file shoudl be created
39 30
   @param pp_filename function printing the filename
......
50 41
  log_str_level_two 2 (path^" generated")
51 42

  
52 43

  
53
(** Print the filename of a package by lowercasing it and appending
54
  an extension.
44
(** Print the filename of a machine package.
55 45
   @param extension the extension to append to the package name
56 46
   @param fmt the formatter
57
   @param fmt the machine corresponding to the package
47
   @param machine the machine corresponding to the package
58 48
**)
59 49
let pp_machine_filename extension fmt machine =
60
  fprintf fmt "%a.%s"
61
    (pp_lowercase pp_package_name) machine.mname
62
    extension
50
  pp_filename extension fmt (function fmt -> pp_package_name fmt machine)
63 51

  
64 52
(** Exception raised when a machine contains a feature not supported by the
65 53
  Ada backend*)
......
80 68
   @param main_machine the machine associated to the main node
81 69
**)
82 70
let pp_project_name fmt main_machine =
83
  fprintf fmt "%a.gpr" pp_package_name main_machine.mname
71
  fprintf fmt "%a.gpr" pp_package_name main_machine
84 72

  
85 73
(** Main function of the Ada backend. It calls all the subfunction creating all
86 74
the file and fill them with Ada code representing the machines list given.
......
112 100
  List.iter check machines;
113 101

  
114 102
  log_str_level_two 1 "Generating ads";
115
  List.iter (write_file destname (pp_machine_filename "ads") Ads.pp_file) machines;
103
  List.iter (write_file destname (pp_machine_filename "ads") (Ads.pp_file machines) ) machines;
116 104

  
117 105
  log_str_level_two 1 "Generating adb";
118 106
  List.iter (write_file destname (pp_machine_filename "adb") Adb.pp_file) machines;
......
121 109
  log_str_level_two 1 "Generating wrapper files";
122 110
  match main_machine with
123 111
    | 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
112
    | Some machine ->
113
begin
114
  let pp_main_filename fmt _ =
115
    pp_filename "adb" fmt pp_main_procedure_name in
116
  write_file destname pp_project_name Wrapper.pp_project_file machine;
117
  write_file destname pp_main_filename Wrapper.pp_main_adb machine;
118
end
128 119

  
129 120

  
130 121
(* Local Variables: *)
src/backends/Ada/ada_backend_ads.ml
22 22
module Main =
23 23
struct
24 24

  
25
(** Print a with statement to include an instance.
26
   @param fmt the formater to print on
27
   @param instance the instance
25
(** Find a submachine step call in a list of instructions.
26
    @param ident submachine instance ident
27
    @param instr_list List of instruction sto search
28
    @return a list of pair containing input types and output types for each step call found
29
**)
30
let rec find_submachine_step_call ident instr_list =
31
  let search_instr instruction = 
32
    match instruction.instr_desc with
33
      | MStep (il, i, vl) when String.equal i ident -> [
34
        (List.map (function x-> x.var_type) il,
35
           List.map (function x-> x.value_type) vl)]
36
      | MBranch (_, l) -> List.flatten
37
          (List.map (function x, y -> find_submachine_step_call ident y) l)
38
      | _ -> []
39
  in
40
  List.flatten (List.map search_instr instr_list)
41

  
42
(** Check that two types are the same.
43
   @param t1 a type
44
   @param t2 an other type
45
   @param return true if the two types are Tbasic or Tunivar and equal
46
**)
47
let check_type_equal (t1:Types.type_expr) (t2:Types.type_expr) =
48
  match (Types.repr t1).Types.tdesc, (Types.repr t2).Types.tdesc with
49
    | Types.Tbasic x, Types.Tbasic y -> x = y
50
    | Types.Tunivar,  Types.Tunivar  -> t1.tid = t2.tid
51
    | _ -> assert false (* TODO *)
52

  
53
(** Extend a substitution to unify the two given types. Only the
54
  first type can be polymorphic.
55
    @param subsitution the base substitution
56
    @param type_poly the type which can be polymorphic
57
    @param typ the type to match type_poly with
58
**)
59
let unification (substituion:(int*Types.type_expr) list) ((type_poly:Types.type_expr), (typ:Types.type_expr)) =
60
  assert(not (is_Tunivar typ));
61
  (* If type_poly is polymorphic *)
62
  if is_Tunivar type_poly then
63
    (* If a subsitution exists for it *)
64
    if List.mem_assoc type_poly.tid substituion then
65
    begin
66
      (* We check that the type corresponding to type_poly in the subsitution
67
         match typ *)
68
      assert(check_type_equal (List.assoc type_poly.tid substituion) typ);
69
      (* We return the original substituion, it is already correct *)
70
      substituion
71
    end
72
    (* If type_poly is not in the subsitution *)
73
    else
74
      (* We add it to the substituion *)
75
      (type_poly.tid, typ)::substituion
76
  (* iftype_poly is not polymorphic *)
77
  else
78
  begin
79
    (* We check that type_poly and typ are the same *)
80
    assert(check_type_equal type_poly typ);
81
    (* We return the original substituion, it is already correct *)
82
    substituion
83
  end
84

  
85
(** Check that two calls are equal. A call is
86
  a pair of list of types, the inputs and the outputs.
87
   @param calls a list of pair of list of types
88
   @param return true if the two pairs are equal
28 89
**)
29
let pp_with_subinstance fmt instance =
30
  pp_with_node fmt (extract_node instance)
90
let check_call_equal (i1, o1) (i2, o2) =
91
  (List.for_all2 check_type_equal i1 i2)
92
    && (List.for_all2 check_type_equal i1 i2)
93

  
94
(** Check that all the elements of list of calls are equal to one.
95
  A call is a pair of list of types, the inputs and the outputs.
96
   @param call a pair of list of types
97
   @param calls a list of pair of list of types
98
   @param return true if all the elements are equal
99
**)
100
let check_calls call calls =
101
  List.for_all (check_call_equal call) calls
102

  
103
(** Extract from a subinstance that can have polymorphic type the instantiation
104
    of all its polymorphic type instanciation for a given machine.
105
   @param machine the machine which instantiate the subinstance
106
   @param submachine the machine corresponding to the subinstance
107
   @return the correspondance between polymorphic type id and their instantiation
108
**)
109
let get_substitution machine ident submachine =
110
  (* extract the calls to submachines from the machine *)
111
  let calls = find_submachine_step_call ident machine.mstep.step_instrs in
112
  (* extract the first call  *)
113
  let call = match calls with
114
              (* assume that there is always one call to a subinstance *)
115
              | []    -> assert(false)
116
              | h::t  -> h in
117
  (* assume that all the calls to a subinstance are using the same type *)
118
  assert(check_calls call calls);
119
  (* make a list of all types from input and output vars *)
120
  let call_types = (fst call)@(snd call) in
121
  (* extract all the input and output vars from the submachine *)
122
  let machine_vars = submachine.mstep.step_inputs@submachine.mstep.step_outputs in
123
  (* keep only the type of vars *)
124
  let machine_types = List.map (function x-> x.var_type) machine_vars in
125
  (* assume that there is the same numer of input and output in the submachine
126
      and the call *)
127
  assert (List.length machine_types = List.length call_types);
128
  (* Unify the two lists of types *)
129
  let substituion = List.fold_left unification [] (List.combine machine_types call_types) in
130
  (* Assume that our substitution match all the possible
131
       polymorphic type of the node *)
132
  let polymorphic_types = find_all_polymorphic_type submachine in
133
  assert (List.length polymorphic_types = List.length substituion);
134
  assert (List.for_all (function x->List.mem_assoc x substituion) polymorphic_types);
135
  substituion
31 136

  
32 137
(** Print the declaration of a state element of a subinstance of a machine.
138
   @param machine the machine
33 139
   @param fmt the formater to print on
34
   @param instance the instance
140
   @param substitution correspondance between polymorphic type id and their instantiation
141
   @param ident the identifier of the subinstance
142
   @param submachine the submachine of the subinstance
35 143
**)
36
let pp_machine_subinstance_state_decl fmt instance =
37
  pp_node_state_decl (fst instance) fmt (extract_node instance)
144
let pp_machine_subinstance_state_decl fmt (substitution, ident, submachine) =
145
  pp_node_state_decl substitution ident fmt submachine
38 146

  
39 147
(** Print the state record for a machine.
40 148
   @param fmt the formater to print on
41
   @param machine the machine
149
   @param var_list list of all state var
150
   @param typed_submachines list of pairs of instantiated types and machine
42 151
**)
43
let pp_state_record_definition fmt (var_list, instances) =
152
let pp_state_record_definition fmt (var_list, typed_submachines) =
44 153
  fprintf fmt "@,  @[<v>record@,  @[<v>%a%t%a%t@]@,end record@]"
45
    (Utils.fprintf_list ~sep:";@;" pp_machine_subinstance_state_decl) instances
46
    (Utils.pp_final_char_if_non_empty ";@," instances)
47
    (Utils.fprintf_list ~sep:";@;" (pp_machine_var_decl NoMode)) var_list
154
    (Utils.fprintf_list ~sep:";@;" pp_machine_subinstance_state_decl)
155
    typed_submachines
156
    (Utils.pp_final_char_if_non_empty ";@," typed_submachines)
157
    (Utils.fprintf_list ~sep:";@;" (pp_machine_var_decl NoMode))
158
    var_list
48 159
    (Utils.pp_final_char_if_non_empty ";" var_list)
49 160

  
161
(** Print the declaration for polymorphic types.
162
   @param fmt the formater to print on
163
   @param polymorphic_types all the types to print
164
**)
165
let pp_generic fmt polymorphic_types =
166
  let pp_polymorphic_types =
167
    List.map (fun id fmt -> pp_polymorphic_type fmt id) polymorphic_types in
168
  if polymorphic_types != [] then
169
      fprintf fmt "generic@,  @[<v>%a;@]@,"
170
        (Utils.fprintf_list ~sep:";@," pp_private_limited_type_decl)
171
        pp_polymorphic_types
172
  else
173
    fprintf fmt ""
174

  
175
(** Extract from a machine list the one corresponding to the given instance.
176
   @param machines list of all machines
177
   @param instance instance of a machine
178
   @return the machine corresponding to hte given instance
179
**)
180
let get_machine machines instance =
181
    let id = (extract_node instance).node_id in
182
    List.find  (function m -> m.mname.node_id=id) machines
183

  
184
(** Print instanciation of a generic type in a new statement.
185
   @param fmt the formater to print on
186
   @param id id of the polymorphic type
187
   @param typ the new type
188
**)
189
let pp_generic_instanciation fmt (id, typ) =
190
  fprintf fmt "%a => %a" pp_polymorphic_type id pp_type typ
191

  
192
(** Print a new statement instantiating a generic package.
193
   @param fmt the formater to print on
194
   @param substitutions the instanciation substitution
195
   @param ident the name of the instance, useless in this function
196
   @param submachine the submachine to instanciate
197
**)
198
let pp_new_package fmt (substitutions, ident, submachine)=
199
  fprintf fmt "package %a is new %a @[<v>(%a)@]"
200
    (pp_package_name_with_polymorphic substitutions) submachine
201
    pp_package_name submachine
202
    (Utils.fprintf_list ~sep:",@," pp_generic_instanciation) substitutions
203

  
204

  
50 205
(** Print the package declaration(ads) of a machine.
51 206
   @param fmt the formater to print on
52 207
   @param m the machine
53 208
**)
54
let pp_file fmt m =
55
  (* Take apart the arrow instance from the instance list and transform them
56
     into simple boolean variable *)
57
  let extract (instances, arrows) instance =
58
    let (name, (node, static)) = instance in
59
    if String.equal (node_name node) Arrow.arrow_id then
60
      (instances, (dummy_var_decl name Type_predef.type_bool)::arrows)
61
    else
62
      (instance::instances, arrows) in
63
  let instances, arrows = List.fold_left extract ([], []) m.minstances in
64
  (* Add the boolean variable reated for arrow instance to the list of all variable *)
65
  let var_list = arrows@m.mmemory in
66
  let pp_record fmt = pp_state_record_definition fmt (var_list, instances) in
67
  fprintf fmt "@[<v>%a%t@,%a@,  @[<v>@,%a;@,@,%t;@,@,%t;@,@,private@,@,%a;@,@]@,%a;@.@]"
209
let pp_file machines fmt m =
210
  let submachines = List.map (get_machine machines) m.minstances in
211
  let names = List.map fst m.minstances in
212
  let var_list = m.mmemory in
213
  let typed_submachines = List.map2
214
    (fun instance submachine ->
215
      let ident = (fst instance) in
216
      get_substitution m ident submachine, ident, submachine)
217
    m.minstances submachines in
218
  let pp_record fmt =
219
    pp_state_record_definition fmt (var_list, typed_submachines) in
220
  let typed_submachines_filtered =
221
    List.filter (function (l, _, _) -> l != []) typed_submachines in
222
  let polymorphic_types = find_all_polymorphic_type m in
223
  fprintf fmt "@[<v>%a%t%a%a@,  @[<v>@,%a;@,@,%t;@,@,%t;@,@,private@,@,%a%t%a;@,@]@,%a;@.@]"
68 224
    
69 225
    (* Include all the subinstance*)
70
    (Utils.fprintf_list ~sep:";@," pp_with_subinstance) instances
71
    (Utils.pp_final_char_if_non_empty ";@," instances)
226
    (Utils.fprintf_list ~sep:";@," pp_with_machine) submachines
227
    (Utils.pp_final_char_if_non_empty ";@,@," submachines)
228
    
229
    pp_generic polymorphic_types
72 230
    
73 231
    (*Begin the package*)
74 232
    (pp_begin_package false) m
......
82 240
    (*Declare the step procedure*)
83 241
    (pp_step_prototype m)
84 242
    
243
    (*Instantiate the polymorphic type that need to be instantiate*)
244
    (Utils.fprintf_list ~sep:";@," pp_new_package) typed_submachines_filtered
245
    (Utils.pp_final_char_if_non_empty ";@,@," typed_submachines_filtered)
246
    
85 247
    (*Define the state type*)
86 248
    pp_type_decl (pp_state_type, pp_record)
87 249
    
src/backends/Ada/ada_backend_common.ml
31 31
  in
32 32
  fprintf fmt "%s%s" prefix name
33 33

  
34
(** Encapsulate a pretty print function to lower case its result when applied
35
   @param pp the pretty print function
36
   @param fmt the formatter
37
   @param arg the argument of the pp function
38
**)
39
let pp_lowercase pp fmt =
40
  let str = asprintf "%t" pp in
41
  fprintf fmt "%s" (String. lowercase_ascii str)
42

  
43
(** Print a filename by lowercasing the base and appending an extension.
44
   @param extension the extension to append to the package name
45
   @param fmt the formatter
46
   @param pp_name the file base name printer
47
**)
48
let pp_filename extension fmt pp_name =
49
  fprintf fmt "%t.%s"
50
    (pp_lowercase pp_name)
51
    extension
52

  
34 53

  
35 54
(* Package pretty print functions *)
36 55

  
37
(** Print the name of a package associated to a machine.
56
(** Print the name of the arrow package.
57
   @param fmt the formater to print on
58
**)
59
let pp_arrow_package_name fmt = fprintf fmt "Arrow"
60

  
61
(** Print the name of a package associated to a node.
38 62
   @param fmt the formater to print on
39 63
   @param machine the machine
40 64
**)
41
let pp_package_name fmt node =
42
    fprintf fmt "%a" pp_clean_ada_identifier node.node_id
65
let pp_package_name fmt machine =
66
  if String.equal Arrow.arrow_id machine.mname.node_id then
67
      fprintf fmt "%t" pp_arrow_package_name
68
  else
69
      fprintf fmt "%a" pp_clean_ada_identifier machine.mname.node_id
43 70

  
44 71
(** Print the ada package introduction sentence it can be used for body and
45 72
declaration. Boolean parameter body should be true if it is a body delcaration.
......
50 77
let pp_begin_package body fmt machine =
51 78
  fprintf fmt "package %s%a is"
52 79
    (if body then "body " else "")
53
    pp_package_name machine.mname
80
    pp_package_name machine
54 81

  
55 82
(** Print the ada package conclusion sentence.
56 83
   @param fmt the formater to print on
57 84
   @param machine the machine
58 85
**)
59 86
let pp_end_package fmt machine =
60
  fprintf fmt "end %a" pp_package_name machine.mname
87
  fprintf fmt "end %a" pp_package_name machine
61 88

  
62 89
(** Print the access of an item from an other package.
63 90
   @param fmt the formater to print on
......
69 96

  
70 97
(** Print the name of the main procedure.
71 98
   @param fmt the formater to print on
72
   @param main_machine the machine associated to the main node
73 99
**)
74
let pp_main_procedure_name main_machine fmt =
100
let pp_main_procedure_name fmt =
75 101
  fprintf fmt "main"
76 102

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

  
84 103
(** Extract a node from an instance.
85 104
   @param instance the instance
86 105
**)
......
90 109
    | Node nd         -> nd
91 110
    | _ -> assert false (*TODO*)
92 111

  
93
(** Print a with statement to include a node.
112
(** Print a with statement to include a machine.
94 113
   @param fmt the formater to print on
95
   @param node the node
114
   @param machine the machine
96 115
**)
97
let pp_with_node fmt node =
98
  fprintf fmt "private with %a" pp_package_name node
116
let pp_with_machine fmt machine =
117
  fprintf fmt "private with %a" pp_package_name machine
99 118

  
100 119

  
101 120
(* Type pretty print functions *)
......
108 127
let pp_type_decl fmt (pp_name, pp_definition) =
109 128
  fprintf fmt "type %t is %t" pp_name pp_definition
110 129

  
111
(** Print a private type declaration
130
(** Print a limited private type declaration
112 131
   @param fmt the formater to print on
113 132
   @param pp_name a format printer which print the type name
114 133
**)
......
140 159
**)
141 160
let pp_boolean_type fmt = fprintf fmt "Boolean"
142 161

  
143
(** Print the type of a variable.
162
(** Print the type of a polymorphic type.
144 163
   @param fmt the formater to print on
145
   @param id the variable
164
   @param id the id of the polymorphic type
146 165
**)
147
let pp_var_type fmt id = 
148
  (match (Types.repr id.var_type).Types.tdesc with
149
    | Types.Tbasic Types.Basic.Tint -> pp_integer_type fmt
166
let pp_polymorphic_type fmt id =
167
  fprintf fmt "T_%i" id
168

  
169
(** Print a type.
170
   @param fmt the formater to print on
171
   @param type the type
172
**)
173
let pp_type fmt typ = 
174
  (match (Types.repr typ).Types.tdesc with
175
    | Types.Tbasic Types.Basic.Tint  -> pp_integer_type fmt
150 176
    | Types.Tbasic Types.Basic.Treal -> pp_float_type fmt
151 177
    | Types.Tbasic Types.Basic.Tbool -> pp_boolean_type fmt
152
    | _ -> eprintf "Type error : %a@." Types.print_ty id.var_type; assert false (*TODO*)
178
    | Types.Tunivar                  -> pp_polymorphic_type fmt typ.tid
179
    | _ -> eprintf "Type error : %a@." Types.print_ty typ; assert false (*TODO*)
153 180
  )
154 181

  
182
(** Print the type of a variable.
183
   @param fmt the formater to print on
184
   @param id the variable
185
**)
186
let pp_var_type fmt id = 
187
  pp_type fmt id.var_type
188

  
189
(** Extract all the inputs and outputs.
190
   @param machine the machine
191
   @return a list of all the var_decl of a macine
192
**)
193
let get_all_vars_machine m =
194
  m.mmemory@m.mstep.step_inputs@m.mstep.step_outputs@m.mstatic
195

  
196
(** Check if a type is polymorphic.
197
   @param typ the type
198
   @return true if its polymorphic
199
**)
200
let is_Tunivar typ = (Types.repr typ).tdesc == Types.Tunivar
201

  
202
(** Find all polymorphic type : Types.Tunivar in a machine.
203
   @param machine the machine
204
   @return a list of id corresponding to polymorphic type
205
**)
206
let find_all_polymorphic_type m =
207
  let vars = get_all_vars_machine m in
208
  let extract id = id.var_type.tid in
209
  let polymorphic_type_vars =
210
    List.filter (function x-> is_Tunivar x.var_type) vars in
211
  List.sort_uniq (-) (List.map extract polymorphic_type_vars)
212

  
213
(** Print a package name with polymorphic types specified.
214
   @param substitution correspondance between polymorphic type id and their instantiation
215
   @param fmt the formater to print on
216
   @param machine the machine
217
**)
218
let pp_package_name_with_polymorphic substitution fmt machine =
219
  let polymorphic_types = find_all_polymorphic_type machine in
220
  assert(List.length polymorphic_types = List.length substitution);
221
  let substituion = List.sort_uniq (fun x y -> fst x - fst y) substitution in
222
  assert(List.for_all2 (fun poly1 (poly2, _) -> poly1 = poly2)
223
            polymorphic_types substituion);
224
  let instantiated_types = snd (List.split substitution) in
225
  fprintf fmt "%a%t%a"
226
    pp_package_name machine
227
    (Utils.pp_final_char_if_non_empty "_" instantiated_types)
228
    (Utils.fprintf_list ~sep:"_" pp_type) instantiated_types
229

  
155 230

  
156 231
(* Variable pretty print functions *)
157 232

  
......
207 282
  let pp_type = function fmt -> pp_var_type fmt id in
208 283
  pp_var_decl fmt (mode, pp_name, pp_type)
209 284

  
210
(** Print variable declaration for state variable
285
(** Print variable declaration for a local state variable
211 286
   @param fmt the formater to print on
212 287
   @param mode input/output mode of the parameter
213 288
**)
......
216 291
  let pp_type = pp_state_type in
217 292
  pp_var_decl fmt (mode, pp_name, pp_type)
218 293

  
219
(** Print the declaration of a state element of node.
220
   @param instance name of the variable
294
(** Print the declaration of a state element of a machine.
295
   @param substitution correspondance between polymorphic type id and their instantiation
296
   @param name name of the variable
221 297
   @param fmt the formater to print on
222
   @param instance node
298
   @param machine the machine
223 299
**)
224
let pp_node_state_decl name fmt node =
225
  let pp_package fmt = pp_package_name fmt node in
300
let pp_node_state_decl substitution name fmt machine =
301
  let pp_package fmt = pp_package_name_with_polymorphic substitution fmt machine in
226 302
  let pp_type fmt = pp_package_access fmt (pp_package, pp_state_type) in
227 303
  let pp_name fmt = pp_clean_ada_identifier fmt name in
228 304
  pp_var_decl fmt (NoMode, pp_name, pp_type)
src/backends/Ada/ada_backend_wrapper.ml
24 24
   @param instrs list of instructions printer
25 25
**)
26 26
let pp_main_procedure_definition machine fmt (locals, instrs) =
27
    let pp_name = pp_main_procedure_name machine in
28 27
    pp_procedure_definition
29
      pp_name
30
      (pp_simple_prototype pp_name)
28
      pp_main_procedure_name
29
      (pp_simple_prototype pp_main_procedure_name)
31 30
      (fun fmt local -> fprintf fmt "%t" local)
32 31
      (fun fmt instr -> fprintf fmt "%t" instr)
33 32
      fmt
......
48 47
   @param fmt the formater to print on
49 48
   @param machine the main machine
50 49
**)
51
let pp_main_file fmt machine =
50
let pp_main_adb fmt machine =
52 51
  let stateVar = "state" in
53 52
  let step_parameters = machine.mstep.step_inputs@machine.mstep.step_outputs in
54
  let pp_local_state_var_decl fmt = pp_node_state_decl stateVar fmt machine.mname in
53
  let pp_local_state_var_decl fmt = pp_node_state_decl [] stateVar fmt machine in
55 54
  let apply_pp_var_decl var fmt = pp_machine_var_decl NoMode fmt var in
56 55
  let locals = List.map apply_pp_var_decl step_parameters in
57 56
  let locals = pp_local_state_var_decl::locals in
58 57
  let pp_reset fmt =
59 58
    fprintf fmt "%a.reset(%s)"
60
      pp_package_name machine.mname
59
      pp_package_name machine
61 60
      stateVar in
62 61
  let pp_loop fmt =
63 62
    fprintf fmt "while true loop@,  %a.step(@[%s,@ %a@]);@,end loop"
64
      pp_package_name machine.mname
63
      pp_package_name machine
65 64
      stateVar
66 65
      (Utils.fprintf_list ~sep:",@ " pp_var_name) step_parameters
67 66
      in
68 67
  let instrs = [pp_reset; pp_loop] in
69 68
  fprintf fmt "@[<v>%a;@,@,%a;@]"
70
    pp_with_node machine.mname
69
    pp_with_machine machine
71 70
    (pp_main_procedure_definition machine) (locals, instrs)
72 71

  
72

  
73
(** Print the arrow ads file.
74
   @param fmt the formater to print on
75
**)
76
let pp_arrow_ads fmt =
77
  fprintf fmt "COUCOU"
78

  
79
(** Print the arrow adb file.
80
   @param fmt the formater to print on
81
**)
82
let pp_arrow_adb fmt =
83
  fprintf fmt "COUCOU"
84

  
73 85
(** Print the gpr project file.
74 86
   @param fmt the formater to print on
75 87
   @param machine the main machine
76 88
**)
77 89
let pp_project_file fmt machine =
78 90
    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
91
      pp_package_name machine
92
      (pp_filename "adb") pp_main_procedure_name
93
      pp_package_name machine
82 94

  
83 95
end
src/compiler_stages.ml
266 266
    begin
267 267
      Log.report ~level:1 (fun fmt -> fprintf fmt ".. Ada code generation@.");
268 268
      Ada_backend.translate_to_ada
269
	basename prog machine_code dependencies
269
	basename prog (Machine_code_common.arrow_machine::machine_code) dependencies
270 270
    end
271 271
  | "horn" ->
272 272
     begin

Also available in: Unified diff