Project

General

Profile

Revision 15003796 src/main_lustre_compiler.ml

View differences:

src/main_lustre_compiler.ml
204 204
      Access.check_prog prog;
205 205
    end;
206 206

  
207
  (* Computation of node equation scheduling. It also breaks dependency cycles
208
     and warns about unused input or memory variables *)
209
  Log.report ~level:1 (fun fmt -> fprintf fmt ".. scheduling@,");
210
  let prog, node_schs = Scheduling.schedule_prog prog in
211
  Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_warning_unused node_schs);
212
  Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_schedule node_schs);
213
  Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_fanin_table node_schs);
214
  Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Printers.pp_prog prog);
207
  (* Apply transformation according to annotations: for the moment, linearization only *)
208
  let prog = 
209
    List.map (
210
      fun top -> 
211
	match top.top_decl_desc with
212
	| Node nd -> 
213
	  let nd = 
214
	    List.fold_left ( 
215
     	      fun nd annots ->
216
		List.fold_left (
217
		  fun nd (keyl, value) ->
218
		    match keyl, value with
219
	  	    | ["linearize"], _ ->  (* This option is activated only for lustre output *)
220
		      if !Options.output = "lustre" then
221
			Linearize.node nd value
222
		      else 
223
			nd
224
	  	    | _ -> nd (* do nothing *)
225
		) nd annots.annots
226
	    ) nd nd.node_annot
227
	  in
228
	  { top with top_decl_desc = Node nd }
229
	| _ -> top
230
    ) prog
231
  in
232

  
215 233

  
216 234
 (* Optimization of prog:
217 235
    - Unfold consts
......
226 244
    else
227 245
      prog
228 246
  in
247

  
248

  
249
  let machine_code =
250
    if !Options.output = "lustre" then 
251
      None
252
    else begin
253

  
254
  (* Computation of node equation scheduling. It also breaks dependency cycles
255
     and warns about unused input or memory variables *)
256
  Log.report ~level:1 (fun fmt -> fprintf fmt ".. scheduling@,");
257
  let prog, node_schs = Scheduling.schedule_prog prog in
258
  Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_warning_unused node_schs);
259
  Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_schedule node_schs);
260
  Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_fanin_table node_schs);
261
  Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Printers.pp_prog prog);
262
      
229 263
  (* DFS with modular code generation *)
230 264
  Log.report ~level:1 (fun fmt -> fprintf fmt ".. machines generation@,");
231 265
  let machine_code = Machine_code.translate_prog prog node_schs in
......
271 305
  (Utils.fprintf_list ~sep:"@ " Machine_code.pp_machine)
272 306
  machine_code);
273 307

  
308
  Some machine_code 
309
    end
310
  in
311
  
274 312
  (* Printing code *)
275 313
  let basename    =  Filename.basename basename in
276 314
  let destname = !Options.dest_dir ^ "/" ^ basename in
277
  let _ = match !Options.output with
278
    | "C" ->
315
  let _ = match !Options.output, machine_code with
316
    | "C", Some machine_code ->
279 317
      begin
280 318
	  let alloc_header_file = destname ^ "_alloc.h" in (* Could be changed *)
281 319
	  let source_lib_file = destname ^ ".c" in (* Could be changed *)
......
286 324
	    alloc_header_file source_lib_file source_main_file makefile_file
287 325
	    basename prog machine_code dependencies
288 326
	end
289
    | "java" ->
327
    | "java", Some machine_code ->
290 328
      begin
291 329
	failwith "Sorry, but not yet supported !"
292 330
    (*let source_file = basename ^ ".java" in
......
296 334
      Log.report ~level:1 (fun fmt -> fprintf fmt ".. java code generation@,@?");
297 335
      Java_backend.translate_to_java source_fmt basename normalized_prog machine_code;*)
298 336
      end
299
    | "horn" ->
337
    | "horn", Some machine_code ->
300 338
       begin
301 339
	let source_file = destname ^ ".smt2" in (* Could be changed *)
302 340
	let source_out = open_out source_file in
......
312 350
	Horn_backend.traces_file fmt basename prog machine_code;
313 351
	)
314 352
      end
315
    | "lustre" ->
353
    | "lustre", None ->
316 354
      begin
317 355
	let source_file = destname ^ ".lustrec.lus" in (* Could be changed *)
318 356
	let source_out = open_out source_file in

Also available in: Unified diff