1
|
(********************************************************************)
|
2
|
(* *)
|
3
|
(* The LustreC compiler toolset / The LustreC Development Team *)
|
4
|
(* Copyright 2012 - -- ONERA - CNRS - INPT *)
|
5
|
(* *)
|
6
|
(* LustreC is free software, distributed WITHOUT ANY WARRANTY *)
|
7
|
(* under the terms of the GNU Lesser General Public License *)
|
8
|
(* version 2.1. *)
|
9
|
(* *)
|
10
|
(********************************************************************)
|
11
|
|
12
|
open Format
|
13
|
open Utils
|
14
|
open LustreSpec
|
15
|
open Corelang
|
16
|
open Machine_code
|
17
|
|
18
|
(********************************************************************************************)
|
19
|
(* Basic Printing functions *)
|
20
|
(********************************************************************************************)
|
21
|
|
22
|
let pp_final_char_if_non_empty c l fmt =
|
23
|
match l with [] -> () | _ -> fprintf fmt "%s" c
|
24
|
|
25
|
let pp_newline_if_non_empty l fmt =
|
26
|
match l with [] -> () | _ -> fprintf fmt "@,"
|
27
|
|
28
|
let pp_dimension fmt d = Printers.pp_expr fmt (expr_of_dimension d)
|
29
|
|
30
|
let pp_type fmt t =
|
31
|
match (Types.repr t).Types.tdesc with
|
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
|
38
|
|
39
|
let pp_var fmt id = fprintf fmt "%a %s" pp_type id.var_type id.var_id
|
40
|
|
41
|
let pp_tag fmt t = pp_print_string fmt t
|
42
|
|
43
|
let rec pp_const fmt c =
|
44
|
match c with
|
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
|
55
|
|
56
|
let rec pp_val m fmt v =
|
57
|
match v with
|
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
|
69
|
|
70
|
let pp_add_val m fmt i =
|
71
|
if List.exists (fun o -> o.var_id = i) m.mstep.step_outputs then
|
72
|
fprintf fmt "%s" i
|
73
|
else fprintf fmt "&%s" i
|
74
|
|
75
|
(********************************************************************************************)
|
76
|
(* Instruction Printing functions *)
|
77
|
(********************************************************************************************)
|
78
|
let get_output_of_machine machines i =
|
79
|
try
|
80
|
let m = List.find (fun m -> m.mname.node_id = i) machines in
|
81
|
m.mstep.step_outputs
|
82
|
with Not_found -> assert false
|
83
|
|
84
|
let rec pp_machine_instr m machines instance_out_list fmt instr =
|
85
|
match instr with
|
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
|
130
|
|
131
|
and pp_machine_branch m machines instance_out_list fmt (t, 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
|
136
|
|
137
|
(********************************************************************************************)
|
138
|
(* Java file Printing functions *)
|
139
|
(********************************************************************************************)
|
140
|
|
141
|
let get_class_name n =
|
142
|
match n with "_arrow" -> "boolean" | _ -> String.capitalize n
|
143
|
|
144
|
let pp_local_fields visibility =
|
145
|
fprintf_list ~sep:"@," (fun fmt v -> fprintf fmt "%s %a;" visibility pp_var v)
|
146
|
|
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)
|
150
|
|
151
|
let pp_output_constructor fmt outputs =
|
152
|
fprintf fmt "@[<v 2>public Output(%a) {@,%a@]@,}"
|
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
|
158
|
|
159
|
let pp_output_class fmt step =
|
160
|
fprintf fmt "@[<v 2>public class Output {@,%a@,@,%a@]@,}@,"
|
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)))
|
172
|
instances
|
173
|
|
174
|
let pp_reset machines fmt m =
|
175
|
fprintf fmt "@[<v 2>public void reset () {@,%a@]@,}@,"
|
176
|
(fprintf_list ~sep:"@," (pp_machine_instr m machines []))
|
177
|
m.minit
|
178
|
|
179
|
let pp_step machines fmt m : unit =
|
180
|
let out_assoc_list =
|
181
|
List.map (fun (node_inst, _) -> node_inst, "out_" ^ node_inst) m.minstances
|
182
|
in
|
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
|
186
|
(* locals *)
|
187
|
(Utils.fprintf_list ~sep:";@," pp_var)
|
188
|
m.mstep.step_locals
|
189
|
(pp_final_char_if_non_empty ";" m.mstep.step_locals)
|
190
|
(* declare out variables of subnode instances + out of this node *)
|
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)
|
197
|
(* instructions *)
|
198
|
(fprintf_list ~sep:"@," (pp_machine_instr m machines out_assoc_list))
|
199
|
m.mstep.step_instrs
|
200
|
(* create out object and return it *)
|
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)
|
205
|
|
206
|
let print_machine machines fmt m =
|
207
|
if m.mname.node_id = "_arrow" then ()
|
208
|
else
|
209
|
(* We don't print arrow function *)
|
210
|
fprintf fmt "@[<v 2>class %s {@,%a%t%a%t%t%a@,%a@,%a@,%a@]@,}@.@.@."
|
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 *)
|
232
|
|
233
|
(********************************************************************************************)
|
234
|
(* Main related functions *)
|
235
|
(********************************************************************************************)
|
236
|
|
237
|
(* let print_get_input fmt v = *)
|
238
|
(* match v.var_type.Types.tdesc with *)
|
239
|
(* | Types.Tint -> fprintf fmt "_get_int(\"%s\")" v.var_id *)
|
240
|
(* | Types.Tbool -> fprintf fmt "_get_bool(\"%s\")" v.var_id *)
|
241
|
(* | Types.Treal -> fprintf fmt "_get_double(\"%s\")" v.var_id *)
|
242
|
(* | _ -> assert false *)
|
243
|
|
244
|
(* let print_put_outputs fmt ol = *)
|
245
|
(* let po fmt o = *)
|
246
|
(* match o.var_type.Types.tdesc with *)
|
247
|
(* | Types.Tint -> fprintf fmt "_put_int(\"%s\", %s)" o.var_id o.var_id *)
|
248
|
(* | Types.Tbool -> fprintf fmt "_put_bool(\"%s\", %s)" o.var_id o.var_id *)
|
249
|
(* | Types.Treal -> fprintf fmt "_put_double(\"%s\", %s)" o.var_id o.var_id *)
|
250
|
(* | _ -> assert false *)
|
251
|
(* in *)
|
252
|
(* List.iter (fprintf fmt "@ %a;" po) ol *)
|
253
|
|
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
|
264
|
|
265
|
let print_main_fun basename machines m fmt =
|
266
|
let m_class = String.capitalize m.mname.node_id in
|
267
|
fprintf fmt "@[<v 2>class %s {@,@,@[<v 2>%s {@,%t@,%t@]@,}@,@]@,}@."
|
268
|
(String.capitalize basename)
|
269
|
"public static void main (String[] args)"
|
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
|
|
286
|
(* let print_main_fun machines m fmt = *)
|
287
|
(* let mname = m.mname.node_id in *)
|
288
|
(* let main_mem = *)
|
289
|
(* if (!Options.static_mem && !Options.main_node <> "") *)
|
290
|
(* then "&main_mem" *)
|
291
|
(* else "main_mem" in *)
|
292
|
(* fprintf fmt "@[<v 2>int main (int argc, char *argv[]) {@ "; *)
|
293
|
(* fprintf fmt "/* Declaration of inputs/outputs variables */@ "; *)
|
294
|
(* List.iter *)
|
295
|
(* (fun v -> fprintf fmt "%a %s = %a;@ " pp_c_type v.var_type v.var_id
|
296
|
pp_c_initialize v.var_type *)
|
297
|
(* ) m.mstep.step_inputs; *)
|
298
|
(* List.iter *)
|
299
|
(* (fun v -> fprintf fmt "%a %s = %a;@ " pp_c_type v.var_type v.var_id
|
300
|
pp_c_initialize v.var_type *)
|
301
|
(* ) m.mstep.step_outputs; *)
|
302
|
(* fprintf fmt "@ /* Main memory allocation */@ "; *)
|
303
|
(* if (!Options.static_mem && !Options.main_node <> "") *)
|
304
|
(* then (fprintf fmt "%a(main_mem);@ " pp_machine_static_alloc_name mname) *)
|
305
|
(* else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname
|
306
|
pp_machine_alloc_name mname); *)
|
307
|
(* fprintf fmt "@ /* Initialize the main memory */@ "; *)
|
308
|
(* fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem; *)
|
309
|
(* fprintf fmt "@ ISATTY = isatty(0);@ "; *)
|
310
|
(* fprintf fmt "@ /* Infinite loop */@ "; *)
|
311
|
(* fprintf fmt "@[<v 2>while(1){@ "; *)
|
312
|
(* fprintf fmt "fflush(stdout);@ "; *)
|
313
|
(* List.iter *)
|
314
|
(* (fun v -> fprintf fmt "%s = %a;@ " *)
|
315
|
(* v.var_id *)
|
316
|
(* print_get_input v *)
|
317
|
(* ) m.mstep.step_inputs; *)
|
318
|
(* (match m.mstep.step_outputs with *)
|
319
|
(* | [] -> ( *)
|
320
|
(* fprintf fmt "%a(%a%t%s);@ " *)
|
321
|
(* pp_machine_step_name mname *)
|
322
|
(* (Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id))
|
323
|
m.mstep.step_inputs *)
|
324
|
(* (pp_final_char_if_non_empty ", " m.mstep.step_inputs) *)
|
325
|
(* main_mem *)
|
326
|
(* ) *)
|
327
|
(* | [o] -> ( *)
|
328
|
(* fprintf fmt "%s = %a(%a%t%a, %s);%a" *)
|
329
|
(* o.var_id *)
|
330
|
(* pp_machine_step_name mname *)
|
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 *)
|
336
|
(* main_mem *)
|
337
|
(* print_put_outputs [o]) *)
|
338
|
(* | _ -> ( *)
|
339
|
(* fprintf fmt "%a(%a%t%a, %s);%a" *)
|
340
|
(* pp_machine_step_name mname *)
|
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 *)
|
346
|
(* main_mem *)
|
347
|
(* print_put_outputs m.mstep.step_outputs) *)
|
348
|
(* ); *)
|
349
|
(* fprintf fmt "@]@ }@ "; *)
|
350
|
(* fprintf fmt "return 1;"; *)
|
351
|
(* fprintf fmt "@]@ }@." *)
|
352
|
|
353
|
(* let print_main_header fmt = *)
|
354
|
(* fprintf fmt "#include <stdio.h>@.#include <unistd.h>@.#include
|
355
|
\"io_frontend.h\"@." *)
|
356
|
|
357
|
(********************************************************************************************)
|
358
|
(* Translation function *)
|
359
|
(********************************************************************************************)
|
360
|
|
361
|
let translate_to_java source_fmt basename prog machines =
|
362
|
(* If a main node is identified, generate a main function for it *)
|
363
|
let main_print =
|
364
|
match !Options.main_node with
|
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)
|
384
|
in
|
385
|
|
386
|
(* Print nodes one by one (in the previous order) *)
|
387
|
List.iter ((print_machine machines) source_fmt) machines;
|
388
|
main_print source_fmt
|
389
|
|
390
|
(* Local Variables: *)
|
391
|
(* compile-command:"make -C .." *)
|
392
|
(* End: *)
|