Project

General

Profile

« Previous | Next » 

Revision ca7ff3f7

Added by LĂ©lio Brun 8 months ago

reformatting

View differences:

src/backends/Java/java_backend.ml
15 15
open Corelang
16 16
open Machine_code
17 17

  
18

  
19 18
(********************************************************************************************)
20
(*                     Basic      Printing functions                                        *)
19
(* Basic Printing functions *)
21 20
(********************************************************************************************)
22 21

  
23
let pp_final_char_if_non_empty c l =
24
  (fun fmt -> match l with [] -> () | _ -> fprintf fmt "%s" c)
22
let pp_final_char_if_non_empty c l fmt =
23
  match l with [] -> () | _ -> fprintf fmt "%s" c
25 24

  
26
let pp_newline_if_non_empty l =
27
  (fun fmt -> match l with [] -> () | _ -> fprintf fmt "@,")
25
let pp_newline_if_non_empty l fmt =
26
  match l with [] -> () | _ -> fprintf fmt "@,"
28 27

  
29
let pp_dimension fmt d =
30
  Printers.pp_expr fmt (expr_of_dimension d)
28
let pp_dimension fmt d = Printers.pp_expr fmt (expr_of_dimension d)
31 29

  
32
let pp_type fmt t = 
30
let pp_type fmt t =
33 31
  match (Types.repr t).Types.tdesc with
34
    | Types.Tbool -> pp_print_string fmt "boolean" 
35
    | Types.Treal -> pp_print_string fmt "double" 
36
    | _ -> Types.print_ty fmt t
32
  | Types.Tbool ->
33
    pp_print_string fmt "boolean"
34
  | Types.Treal ->
35
    pp_print_string fmt "double"
36
  | _ ->
37
    Types.print_ty fmt t
37 38

  
38 39
let pp_var fmt id = fprintf fmt "%a %s" pp_type id.var_type id.var_id
39 40

  
40
let pp_tag fmt t =
41
 pp_print_string fmt t
41
let pp_tag fmt t = pp_print_string fmt t
42 42

  
43 43
let rec pp_const fmt c =
44 44
  match c with
45
    | Const_int i -> pp_print_int fmt i
46
    | Const_real r -> pp_print_string fmt r
47
    | Const_float r -> pp_print_float fmt r
48
    | Const_tag t -> pp_tag fmt t
49
    | Const_array ca -> Format.fprintf fmt "{%a}" (Utils.fprintf_list ~sep:"," pp_const) ca
45
  | Const_int i ->
46
    pp_print_int fmt i
47
  | Const_real r ->
48
    pp_print_string fmt r
49
  | Const_float r ->
50
    pp_print_float fmt r
51
  | Const_tag t ->
52
    pp_tag fmt t
53
  | Const_array ca ->
54
    Format.fprintf fmt "{%a}" (Utils.fprintf_list ~sep:"," pp_const) ca
50 55

  
51 56
let rec pp_val m fmt v =
52 57
  match v with
53
    | Cst c -> pp_const fmt c
54
    | Var v ->
55
       if is_state_vars m.memories v then
56
         fprintf fmt "%s" v
57
       else
58
         if List.exists (fun o -> o.var_id = v) m.mstep.step_outputs then
59
	   fprintf fmt "*%s" v
60
         else
61
	   pp_print_string fmt v
62
    | Fun (n, vl) -> if Basic_library.is_internal_fun n then
63
	Basic_library.pp_java n (pp_val m) fmt vl
64
      else
65
	fprintf fmt "%s (%a)" n (Utils.fprintf_list ~sep:", " (pp_val m)) vl
58
  | Cst c ->
59
    pp_const fmt c
60
  | Var v ->
61
    if is_state_vars m.memories v then fprintf fmt "%s" v
62
    else if List.exists (fun o -> o.var_id = v) m.mstep.step_outputs then
63
      fprintf fmt "*%s" v
64
    else pp_print_string fmt v
65
  | Fun (n, vl) ->
66
    if Basic_library.is_internal_fun n then
67
      Basic_library.pp_java n (pp_val m) fmt vl
68
    else fprintf fmt "%s (%a)" n (Utils.fprintf_list ~sep:", " (pp_val m)) vl
66 69

  
67 70
let pp_add_val m fmt i =
68
  if List.exists (fun o -> o.var_id = i) m.mstep.step_outputs
69
  then
71
  if List.exists (fun o -> o.var_id = i) m.mstep.step_outputs then
70 72
    fprintf fmt "%s" i
71
  else
72
    fprintf fmt "&%s" i
73
  else fprintf fmt "&%s" i
73 74

  
74 75
(********************************************************************************************)
75
(*                    Instruction Printing functions                                        *)
76
(* Instruction Printing functions *)
76 77
(********************************************************************************************)
77 78
let get_output_of_machine machines i =
78
  try 
79
  try
79 80
    let m = List.find (fun m -> m.mname.node_id = i) machines in
80 81
    m.mstep.step_outputs
81 82
  with Not_found -> assert false
82 83

  
83 84
let rec pp_machine_instr m machines instance_out_list fmt instr =
84 85
  match instr with
85
    | MReset i -> (
86
      match List.assoc i m.minstances with
87
	| "_arrow" -> fprintf fmt "%s = true;" i
88
	| _ -> fprintf fmt "%s.reset();" i
89
    )
90
    | MLocalAssign (i,v) -> (
91
      fprintf fmt "%s = %a;" 
92
	i (pp_val m) v
93
    )
94
    | MStateAssign (i,v) ->
95
      fprintf fmt "%s = %a;" i (pp_val m) v
96
    | MStep ([i0], i, vl) when Basic_library.is_internal_fun i ->
97
      fprintf fmt "%s = %a;" i0 (Basic_library.pp_java i (pp_val m)) vl    
98
    | MStep ([i0], i, [init; step]) when ((List.assoc i m.minstances) = "_arrow") -> (
99
      fprintf fmt "@[<v 2>if (%s) {@,%s = false;@,%s = %a;@]@,@[<v 2>} else {@,%s = %a;@]@,};@,"
100
	    i i i0 (pp_val m) init i0 (pp_val m) step
101
    )
102
    | MStep (il, i, vl) -> (
103
      let out = 
104
	try
105
	  List.assoc i instance_out_list 
106
	with Not_found -> (eprintf "impossible to find instance %s in the list@.@?" i; 
107
			   assert false) 
108
      in 
109
	  fprintf fmt "%s = %s.step (%a);@,"
110
    	    out i
111
     	    (Utils.fprintf_list ~sep:", " (pp_val m)) vl;
112
	  Utils.fprintf_list ~sep:"@," 
113
	    (fun fmt (o, oname) -> fprintf fmt "%s = %s.%s;" o out oname) fmt 
114
	    (List.map2 
115
	       (fun x y -> x, y.var_id) 
116
	       il 
117
	       (get_output_of_machine machines (List.assoc i m.minstances))
118
	    ) 
119
    ) 
120
      	
121
    | MBranch (g,hl) ->
122
      Format.fprintf fmt "@[<v 2>switch(%a) {@,%a@,}@]"
123
	(pp_val m) g
124
	(Utils.fprintf_list ~sep:"@," (pp_machine_branch m machines instance_out_list)) hl
86
  | MReset i -> (
87
    match List.assoc i m.minstances with
88
    | "_arrow" ->
89
      fprintf fmt "%s = true;" i
90
    | _ ->
91
      fprintf fmt "%s.reset();" i)
92
  | MLocalAssign (i, v) ->
93
    fprintf fmt "%s = %a;" i (pp_val m) v
94
  | MStateAssign (i, v) ->
95
    fprintf fmt "%s = %a;" i (pp_val m) v
96
  | MStep ([ i0 ], i, vl) when Basic_library.is_internal_fun i ->
97
    fprintf fmt "%s = %a;" i0 (Basic_library.pp_java i (pp_val m)) vl
98
  | MStep ([ i0 ], i, [ init; step ]) when List.assoc i m.minstances = "_arrow"
99
    ->
100
    fprintf fmt
101
      "@[<v 2>if (%s) {@,\
102
       %s = false;@,\
103
       %s = %a;@]@,\
104
       @[<v 2>} else {@,\
105
       %s = %a;@]@,\
106
       };@,"
107
      i i i0 (pp_val m) init i0 (pp_val m) step
108
  | MStep (il, i, vl) ->
109
    let out =
110
      try List.assoc i instance_out_list
111
      with Not_found ->
112
        eprintf "impossible to find instance %s in the list@.@?" i;
113
        assert false
114
    in
115
    fprintf fmt "%s = %s.step (%a);@," out i
116
      (Utils.fprintf_list ~sep:", " (pp_val m))
117
      vl;
118
    Utils.fprintf_list ~sep:"@,"
119
      (fun fmt (o, oname) -> fprintf fmt "%s = %s.%s;" o out oname)
120
      fmt
121
      (List.map2
122
         (fun x y -> x, y.var_id)
123
         il
124
         (get_output_of_machine machines (List.assoc i m.minstances)))
125
  | MBranch (g, hl) ->
126
    Format.fprintf fmt "@[<v 2>switch(%a) {@,%a@,}@]" (pp_val m) g
127
      (Utils.fprintf_list ~sep:"@,"
128
         (pp_machine_branch m machines instance_out_list))
129
      hl
125 130

  
126 131
and pp_machine_branch m machines instance_out_list fmt (t, h) =
127
  Format.fprintf fmt "@[<v 2>case %a:@,%a@,break;@]" pp_tag t (Utils.fprintf_list ~sep:"@," (pp_machine_instr m machines instance_out_list)) h
132
  Format.fprintf fmt "@[<v 2>case %a:@,%a@,break;@]" pp_tag t
133
    (Utils.fprintf_list ~sep:"@,"
134
       (pp_machine_instr m machines instance_out_list))
135
    h
128 136

  
129 137
(********************************************************************************************)
130
(*                         Java file Printing functions                                        *)
138
(* Java file Printing functions *)
131 139
(********************************************************************************************)
132 140

  
133
let get_class_name n = match n with "_arrow" -> "boolean" | _ -> String.capitalize n
141
let get_class_name n =
142
  match n with "_arrow" -> "boolean" | _ -> String.capitalize n
134 143

  
135
let pp_local_fields visibility = 
136
  fprintf_list ~sep:"@," (fun fmt v -> fprintf fmt "%s %a;" visibility pp_var v) 
144
let pp_local_fields visibility =
145
  fprintf_list ~sep:"@," (fun fmt v -> fprintf fmt "%s %a;" visibility pp_var v)
137 146

  
138
let pp_local_field_instances = 
139
  fprintf_list ~sep:"@," 
140
    (fun fmt (node_inst, node_type) -> fprintf fmt "protected %s %s;" 
141
      (get_class_name node_type) 
142
      node_inst
143
    ) 
147
let pp_local_field_instances =
148
  fprintf_list ~sep:"@," (fun fmt (node_inst, node_type) ->
149
      fprintf fmt "protected %s %s;" (get_class_name node_type) node_inst)
144 150

  
145 151
let pp_output_constructor fmt outputs =
146 152
  fprintf fmt "@[<v 2>public Output(%a) {@,%a@]@,}"
147
    (fprintf_list ~sep:"; " pp_var) outputs
148
    (fprintf_list ~sep:"@," (fun fmt v -> fprintf fmt "this.%s = %s;" v.var_id v.var_id)) outputs
153
    (fprintf_list ~sep:"; " pp_var)
154
    outputs
155
    (fprintf_list ~sep:"@," (fun fmt v ->
156
         fprintf fmt "this.%s = %s;" v.var_id v.var_id))
157
    outputs
149 158

  
150
let pp_output_class fmt step = 
159
let pp_output_class fmt step =
151 160
  fprintf fmt "@[<v 2>public class Output {@,%a@,@,%a@]@,}@,"
152
    (pp_local_fields "public") step.step_outputs
153
    pp_output_constructor step.step_outputs
154

  
155
let pp_constructor fmt (name, instances) = 
156
  fprintf fmt "@[<v 2>public %s () {@,%a@]@,}@,"
157
    (String.capitalize name)
158
    (
159
      fprintf_list ~sep:"@," 
160
	(fun fmt (node_inst, node_type) -> 
161
	  match node_type with
162
	      "_arrow" -> fprintf fmt "%s = true;" node_inst
163
	    | _ -> fprintf fmt "%s = new %s();" node_inst (get_class_name node_type) 
164
	) 
165
    ) 
161
    (pp_local_fields "public") step.step_outputs pp_output_constructor
162
    step.step_outputs
163

  
164
let pp_constructor fmt (name, instances) =
165
  fprintf fmt "@[<v 2>public %s () {@,%a@]@,}@," (String.capitalize name)
166
    (fprintf_list ~sep:"@," (fun fmt (node_inst, node_type) ->
167
         match node_type with
168
         | "_arrow" ->
169
           fprintf fmt "%s = true;" node_inst
170
         | _ ->
171
           fprintf fmt "%s = new %s();" node_inst (get_class_name node_type)))
166 172
    instances
167 173

  
168
let pp_reset machines fmt m = 
174
let pp_reset machines fmt m =
169 175
  fprintf fmt "@[<v 2>public void reset () {@,%a@]@,}@,"
170
    (fprintf_list ~sep:"@," (pp_machine_instr m machines [])) m.minit
176
    (fprintf_list ~sep:"@," (pp_machine_instr m machines []))
177
    m.minit
171 178

  
172
let pp_step machines fmt m : unit = 
173
  let out_assoc_list = 
179
let pp_step machines fmt m : unit =
180
  let out_assoc_list =
174 181
    List.map (fun (node_inst, _) -> node_inst, "out_" ^ node_inst) m.minstances
175 182
  in
176
  fprintf fmt 
177
    "@[<v 2>public Output step (%a) {@,%a%t@,%a%a%t@,%a@,%t@]@,}@,"
178
    (Utils.fprintf_list ~sep:",@ " pp_var) m.mstep.step_inputs
183
  fprintf fmt "@[<v 2>public Output step (%a) {@,%a%t@,%a%a%t@,%a@,%t@]@,}@,"
184
    (Utils.fprintf_list ~sep:",@ " pp_var)
185
    m.mstep.step_inputs
179 186
    (* locals *)
180
    (Utils.fprintf_list ~sep:";@," pp_var) m.mstep.step_locals
181
    (pp_final_char_if_non_empty ";" m.mstep.step_locals) 
187
    (Utils.fprintf_list ~sep:";@," pp_var)
188
    m.mstep.step_locals
189
    (pp_final_char_if_non_empty ";" m.mstep.step_locals)
182 190
    (* declare out variables of subnode instances + out of this node *)
183
    (fprintf_list ~sep:"" 
184
       (fun fmt (ninst, ntype) -> fprintf fmt "%s.Output out_%s;@," (get_class_name ntype) ninst )) 
185
    (List.filter (fun (_,ntyp) -> not (ntyp = "_arrow")) m.minstances)
186
    (fprintf_list ~sep:";@," pp_var) m.mstep.step_outputs
187
    (pp_final_char_if_non_empty ";" m.mstep.step_outputs) 
191
    (fprintf_list ~sep:"" (fun fmt (ninst, ntype) ->
192
         fprintf fmt "%s.Output out_%s;@," (get_class_name ntype) ninst))
193
    (List.filter (fun (_, ntyp) -> not (ntyp = "_arrow")) m.minstances)
194
    (fprintf_list ~sep:";@," pp_var)
195
    m.mstep.step_outputs
196
    (pp_final_char_if_non_empty ";" m.mstep.step_outputs)
188 197
    (* instructions *)
189
    (fprintf_list ~sep:"@," (pp_machine_instr m machines out_assoc_list)) m.mstep.step_instrs     
198
    (fprintf_list ~sep:"@," (pp_machine_instr m machines out_assoc_list))
199
    m.mstep.step_instrs
190 200
    (* create out object and return it *)
191
    (fun fmt -> fprintf fmt "return new Output(%a);" 
192
      (fprintf_list ~sep:"," (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_outputs 
193
    )
194
  
195

  
201
      (fun fmt ->
202
      fprintf fmt "return new Output(%a);"
203
        (fprintf_list ~sep:"," (fun fmt v -> pp_print_string fmt v.var_id))
204
        m.mstep.step_outputs)
196 205

  
197 206
let print_machine machines fmt m =
198
  if m.mname.node_id = "_arrow" then () else ( (* We don't print arrow function *)
207
  if m.mname.node_id = "_arrow" then ()
208
  else
209
    (* We don't print arrow function *)
199 210
    fprintf fmt "@[<v 2>class %s {@,%a%t%a%t%t%a@,%a@,%a@,%a@]@,}@.@.@."
200
      (String.capitalize m.mname.node_id) (* class name *)
201
      (pp_local_fields "protected") m.mmemory                      (* fields *)
202
      (pp_newline_if_non_empty m.mmemory)            
203
      pp_local_field_instances m.minstances          (* object fields *)
204
      (pp_newline_if_non_empty m.minstances)         
205
      (pp_newline_if_non_empty m.minstances)         
206
      pp_output_class m.mstep                        (* class for output of step method *)
207
      pp_constructor (m.mname.node_id, m.minstances) (* constructor to instanciate object fields *)
208
      (pp_reset machines) m                               (* reset method *)
209
      (pp_step machines) m             (* step method *)
210

  
211
  )
211
      (String.capitalize m.mname.node_id)
212
      (* class name *)
213
      (pp_local_fields "protected")
214
      m.mmemory
215
      (* fields *)
216
      (pp_newline_if_non_empty m.mmemory)
217
      pp_local_field_instances m.minstances
218
      (* object fields *)
219
      (pp_newline_if_non_empty m.minstances)
220
      (pp_newline_if_non_empty m.minstances)
221
      pp_output_class m.mstep
222
      (* class for output of step method *)
223
      pp_constructor
224
      (m.mname.node_id, m.minstances)
225
      (* constructor to instanciate object fields *)
226
      (pp_reset machines)
227
      m
228
      (* reset method *)
229
      (pp_step machines)
230
      m
231
(* step method *)
212 232

  
213 233
(********************************************************************************************)
214
(*                         Main related functions                                           *)
234
(* Main related functions *)
215 235
(********************************************************************************************)
216 236

  
217 237
(* let print_get_input fmt v = *)
......
226 246
(*     match o.var_type.Types.tdesc with *)
227 247
(*     | Types.Tint -> fprintf fmt "_put_int(\"%s\", %s)" o.var_id o.var_id *)
228 248
(*     | Types.Tbool -> fprintf fmt "_put_bool(\"%s\", %s)" o.var_id o.var_id *)
229
(*     | Types.Treal -> fprintf fmt "_put_double(\"%s\", %s)" o.var_id o.var_id *)
249
(* | Types.Treal -> fprintf fmt "_put_double(\"%s\", %s)" o.var_id o.var_id *)
230 250
(*     | _ -> assert false *)
231 251
(*   in *)
232 252
(*   List.iter (fprintf fmt "@ %a;" po) ol *)
233 253

  
234
let read_input fmt typ = match typ.Types.tdesc with
235
  | Types.Treal -> fprintf fmt "StdIn.readDouble()"
236
  | Types.Tint ->  fprintf fmt "StdIn.readInt()"
237
  | Types.Tbool ->  fprintf fmt "StdIn.readBoolean()"
238
  | _ -> assert false
254
let read_input fmt typ =
255
  match typ.Types.tdesc with
256
  | Types.Treal ->
257
    fprintf fmt "StdIn.readDouble()"
258
  | Types.Tint ->
259
    fprintf fmt "StdIn.readInt()"
260
  | Types.Tbool ->
261
    fprintf fmt "StdIn.readBoolean()"
262
  | _ ->
263
    assert false
239 264

  
240 265
let print_main_fun basename machines m fmt =
241 266
  let m_class = String.capitalize m.mname.node_id in
242 267
  fprintf fmt "@[<v 2>class %s {@,@,@[<v 2>%s {@,%t@,%t@]@,}@,@]@,}@."
243 268
    (String.capitalize basename)
244 269
    "public static void main (String[] args)"
245
    (fun fmt -> fprintf fmt "%s main_node = new %s();"  m_class m_class)
246
    (fun fmt -> fprintf fmt "@[<v 2>while (true) {@,%a@,%t@,%a@]@,}@,"  
247
      (fprintf_list ~sep:"@," 
248
	 (fun fmt v -> fprintf fmt "System.out.println(\"%s?\");@,%a = %a;" 
249
	   v.var_id pp_var v read_input v.var_type))
250
      m.mstep.step_inputs
251
      (fun fmt -> fprintf fmt "%s.Output out = main_node.step(%a);" 
252
	m_class  
253
	(fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs
254
      )
255
      (fprintf_list ~sep:"@," (fun fmt v -> fprintf fmt "System.out.println(\"%s = \" + out.%s);" v.var_id v.var_id))
256
      m.mstep.step_outputs
257
    )
258
    
259
    
270
    (fun fmt -> fprintf fmt "%s main_node = new %s();" m_class m_class)
271
    (fun fmt ->
272
      fprintf fmt "@[<v 2>while (true) {@,%a@,%t@,%a@]@,}@,"
273
        (fprintf_list ~sep:"@," (fun fmt v ->
274
             fprintf fmt "System.out.println(\"%s?\");@,%a = %a;" v.var_id
275
               pp_var v read_input v.var_type))
276
        m.mstep.step_inputs
277
        (fun fmt ->
278
          fprintf fmt "%s.Output out = main_node.step(%a);" m_class
279
            (fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id))
280
            m.mstep.step_inputs)
281
        (fprintf_list ~sep:"@," (fun fmt v ->
282
             fprintf fmt "System.out.println(\"%s = \" + out.%s);" v.var_id
283
               v.var_id))
284
        m.mstep.step_outputs)
285

  
260 286
(* let print_main_fun machines m fmt = *)
261 287
(*   let mname = m.mname.node_id in *)
262 288
(*   let main_mem = *)
......
266 292
(*   fprintf fmt "@[<v 2>int main (int argc, char *argv[]) {@ "; *)
267 293
(*   fprintf fmt "/* Declaration of inputs/outputs variables */@ "; *)
268 294
(*   List.iter  *)
269
(*     (fun v -> fprintf fmt "%a %s = %a;@ " pp_c_type v.var_type v.var_id pp_c_initialize v.var_type *)
295
(* (fun v -> fprintf fmt "%a %s = %a;@ " pp_c_type v.var_type v.var_id
296
   pp_c_initialize v.var_type *)
270 297
(*     ) m.mstep.step_inputs; *)
271 298
(*   List.iter  *)
272
(*     (fun v -> fprintf fmt "%a %s = %a;@ " pp_c_type v.var_type v.var_id pp_c_initialize v.var_type *)
299
(* (fun v -> fprintf fmt "%a %s = %a;@ " pp_c_type v.var_type v.var_id
300
   pp_c_initialize v.var_type *)
273 301
(*     ) m.mstep.step_outputs; *)
274 302
(*   fprintf fmt "@ /* Main memory allocation */@ "; *)
275 303
(*   if (!Options.static_mem && !Options.main_node <> "") *)
276 304
(*   then (fprintf fmt "%a(main_mem);@ " pp_machine_static_alloc_name mname) *)
277
(*   else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname pp_machine_alloc_name mname); *)
305
(* else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname
306
   pp_machine_alloc_name mname); *)
278 307
(*   fprintf fmt "@ /* Initialize the main memory */@ "; *)
279 308
(*   fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem; *)
280 309
(*   fprintf fmt "@ ISATTY = isatty(0);@ "; *)
......
290 319
(*     | [] -> ( *)
291 320
(*       fprintf fmt "%a(%a%t%s);@ "  *)
292 321
(* 	pp_machine_step_name mname *)
293
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs *)
322
(* (Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id))
323
   m.mstep.step_inputs *)
294 324
(* 	(pp_final_char_if_non_empty ", " m.mstep.step_inputs) *)
295 325
(* 	main_mem *)
296 326
(*     ) *)
......
298 328
(*       fprintf fmt "%s = %a(%a%t%a, %s);%a" *)
299 329
(* 	o.var_id *)
300 330
(* 	pp_machine_step_name mname *)
301
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs *)
302
(* 	(pp_final_char_if_non_empty ", " m.mstep.step_inputs) *)
303
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> fprintf fmt "&%s" v.var_id)) m.mstep.step_outputs *)
331
(* (Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id))
332
   m.mstep.step_inputs *)
333
(* (pp_final_char_if_non_empty ", " m.mstep.step_inputs) *)
334
(* (Utils.fprintf_list ~sep:", " (fun fmt v -> fprintf fmt "&%s" v.var_id))
335
   m.mstep.step_outputs *)
304 336
(* 	main_mem *)
305 337
(* 	print_put_outputs [o]) *)
306 338
(*     | _ -> ( *)
307 339
(*       fprintf fmt "%a(%a%t%a, %s);%a" *)
308 340
(* 	pp_machine_step_name mname *)
309
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs *)
310
(* 	(pp_final_char_if_non_empty ", " m.mstep.step_inputs) *)
311
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> fprintf fmt "&%s" v.var_id)) m.mstep.step_outputs *)
341
(* (Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id))
342
   m.mstep.step_inputs *)
343
(* (pp_final_char_if_non_empty ", " m.mstep.step_inputs) *)
344
(* (Utils.fprintf_list ~sep:", " (fun fmt v -> fprintf fmt "&%s" v.var_id))
345
   m.mstep.step_outputs *)
312 346
(* 	main_mem *)
313 347
(* 	print_put_outputs m.mstep.step_outputs) *)
314 348
(*   ); *)
......
317 351
(*   fprintf fmt "@]@ }@."        *)
318 352

  
319 353
(* let print_main_header fmt = *)
320
(*   fprintf fmt "#include <stdio.h>@.#include <unistd.h>@.#include \"io_frontend.h\"@." *)
321
  
322
      
354
(* fprintf fmt "#include <stdio.h>@.#include <unistd.h>@.#include
355
   \"io_frontend.h\"@." *)
356

  
323 357
(********************************************************************************************)
324
(*                         Translation function                                             *)
358
(* Translation function *)
325 359
(********************************************************************************************)
326 360

  
327 361
let translate_to_java source_fmt basename prog machines =
328

  
329
  
330 362
  (* If a main node is identified, generate a main function for it *)
331 363
  let main_print =
332 364
    match !Options.main_node with
333
      | "" -> (fun _ -> ())
334
      | main_node -> (
335
  	let main_node_opt =
336
  	  List.fold_left
337
  	    (fun res m ->
338
  	      match res with
339
  		| Some _ -> res
340
  		| None -> if m.mname.node_id = main_node then Some m else None)
341
  	    None machines
342
	in
343
	match main_node_opt with
344
  	  | None -> eprintf "Unable to find a main node named %s@.@?" main_node; (fun _ -> ())
345
  	  | Some m -> print_main_fun basename machines m
346
      )
365
    | "" ->
366
      fun _ -> ()
367
    | main_node -> (
368
      let main_node_opt =
369
        List.fold_left
370
          (fun res m ->
371
            match res with
372
            | Some _ ->
373
              res
374
            | None ->
375
              if m.mname.node_id = main_node then Some m else None)
376
          None machines
377
      in
378
      match main_node_opt with
379
      | None ->
380
        eprintf "Unable to find a main node named %s@.@?" main_node;
381
        fun _ -> ()
382
      | Some m ->
383
        print_main_fun basename machines m)
347 384
  in
348
  
385

  
349 386
  (* Print nodes one by one (in the previous order) *)
350 387
  List.iter ((print_machine machines) source_fmt) machines;
351
  main_print source_fmt 
352

  
353

  
354

  
388
  main_print source_fmt
355 389

  
356 390
(* Local Variables: *)
357 391
(* compile-command:"make -C .." *)

Also available in: Unified diff