Revision ca7ff3f7
Added by Lélio Brun over 1 year ago
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
reformatting