Project

General

Profile

Revision 217837e2 src/compiler_stages.ml

View differences:

src/compiler_stages.ml
15 15
   compiled header *)
16 16
let compile_source_to_header prog computed_types_env computed_clocks_env dirname basename extension =
17 17
  let destname = !Options.dest_dir ^ "/" ^ basename in
18
  let lusic_ext = extension ^ "c" in
18
  let lusic_ext = ".lusic" in
19 19
  let header_name = destname ^ lusic_ext in
20 20
  begin
21
    if not (Sys.file_exists header_name) then
21
    if (* Generating the lusic file *)
22
      extension = ".lusi" (* because input is a lusi *)
23
      || (extension = ".lus" &&
24
            not (Sys.file_exists header_name))
25
           (* or because it is a lus but not lusic exists *)
26
      || (let lusic = Lusic.read_lusic destname lusic_ext in
27
          not lusic.Lusic.from_lusi)
28
         (* or the lusic exists but is not generated from a lusi, hence it
29
            has te be regenerated *)
30
    then
22 31
      begin
23 32
	Log.report ~level:1 (fun fmt -> fprintf fmt ".. generating compiled header file %s@," header_name);
24
	Lusic.write_lusic false (Lusic.extract_header dirname basename prog) destname lusic_ext;
25
	if !Options.output = "C" then Lusic.print_lusic_to_h destname lusic_ext
33
	Lusic.write_lusic
34
          (extension = ".lusi") (* is it a lusi file ? *)
35
          (if extension = ".lusi" then prog else Lusic.extract_header dirname basename prog)
36
          destname
37
          lusic_ext;
38
        let _ =
39
          match !Options.output with
40
          | "C" -> C_backend_lusic.print_lusic_to_h destname lusic_ext
41
          | _ -> ()
42
        in
43
        ()
44
      end
45
    else (* Lusic exists and is usable. Checking compatibility *)
46
      begin
47
	Log.report ~level:1 (fun fmt -> fprintf fmt ".. loading compiled header file %s@," header_name);
48
        let lusic = Lusic.read_lusic destname lusic_ext in
49
        Lusic.check_obsolete lusic destname;
50
	let header = lusic.Lusic.contents in
51
	let (declared_types_env, declared_clocks_env) = Modules.get_envs_from_top_decls header in
52
	check_compatibility
53
	  (prog, computed_types_env, computed_clocks_env)
54
	  (header, declared_types_env, declared_clocks_env)
26 55
      end
27
    else
28
      let lusic = Lusic.read_lusic destname lusic_ext in
29
      if not lusic.Lusic.from_lusi then
30
	begin
31
	  Log.report ~level:1 (fun fmt -> fprintf fmt ".. generating compiled header file %s@," header_name);
32
       	  Lusic.write_lusic false (Lusic.extract_header dirname basename prog) destname lusic_ext;
33
	  (*List.iter (fun top_decl -> Format.eprintf "lusic: %a@." Printers.pp_decl top_decl) lusic.Lusic.contents;*)
34
	  if !Options.output = "C" then Lusic.print_lusic_to_h destname lusic_ext
35
	end
36
      else
37
	begin
38
	  Log.report ~level:1 (fun fmt -> fprintf fmt ".. loading compiled header file %s@," header_name);
39
	  Lusic.check_obsolete lusic destname;
40
	  let header = lusic.Lusic.contents in
41
	  let (declared_types_env, declared_clocks_env) = Modules.get_envs_from_top_decls header in
42
	  check_compatibility
43
	    (prog, computed_types_env, computed_clocks_env)
44
	    (header, declared_types_env, declared_clocks_env)
45
	end
46 56
  end
47 57

  
48 58

  
49 59
(* From prog to prog *)
50
let stage1 params prog dirname basename =
60
let stage1 params prog dirname basename extension =
51 61
  (* Updating parent node information for variables *)
52 62
  Compiler_common.update_vdecl_parents_prog prog;
53 63

  
......
56 66
  Log.report ~level:4 (fun fmt -> fprintf fmt ".. after automata expansion:@,  @[<v 2>@,%a@]@ " Printers.pp_prog prog);
57 67

  
58 68
  (* Importing source *)
59
  let prog, dependencies, (typ_env, clk_env) = Modules.load ~is_header:false prog in
60

  
69
  let prog, dependencies, (typ_env, clk_env) = Modules.load ~is_header:(extension = ".lusi") prog in
70
  
61 71
  (* Registering types and clocks for future checks *)
62 72
  Global.type_env := Env.overwrite !Global.type_env typ_env;
63 73
  Global.clock_env := Env.overwrite !Global.clock_env clk_env;
......
135 145
  create_dest_dir ();
136 146

  
137 147
  (* Compatibility with Lusi *)
138
  (* Checking the existence of a lusi (Lustre Interface file) *)
139
  let extension = ".lusi" in
140
  compile_source_to_header prog !Global.type_env !Global.clock_env dirname basename extension;
141

  
148
  (* If compiling a lusi, generate the lusic. If this is a lus file, Check the existence of a lusi (Lustre Interface file) *)
149
  compile_source_to_header
150
    prog !Global.type_env !Global.clock_env dirname basename extension;
151
 
152
    
142 153
  Typing.uneval_prog_generics prog;
143 154
  Clock_calculus.uneval_prog_generics prog;
144 155

  
......
246 257

  
247 258

  
248 259
(* printing code *)
249
let stage3 prog machine_code dependencies basename =
260
let stage3 prog machine_code dependencies basename extension =
250 261
  let basename    =  Filename.basename basename in
251
  match !Options.output with
252
    "C" -> 
262
  match !Options.output, extension with
263
    "C", ".lus" -> 
264
     begin
265
       Log.report ~level:1 (fun fmt -> fprintf fmt ".. C code generation@,");
266
       C_backend.translate_to_c
267
	 (* alloc_header_file source_lib_file source_main_file makefile_file *)
268
	 basename prog machine_code dependencies
269
     end
270
  |  "C", _ -> 
253 271
      begin
254
	Log.report ~level:1 (fun fmt -> fprintf fmt ".. C code generation@,");
255
	C_backend.translate_to_c
256
	  (* alloc_header_file source_lib_file source_main_file makefile_file *)
257
	  basename prog machine_code dependencies
272
      	Log.report ~level:1 (fun fmt -> fprintf fmt ".. no C code generation for lusi@,");
258 273
      end
259
  | "java" ->
274
  | "java", _ ->
260 275
     begin
261 276
       (Format.eprintf "internal error: sorry, but not yet supported !"; assert false)
262 277
     (*let source_file = basename ^ ".java" in
......
266 281
       Log.report ~level:1 (fun fmt -> fprintf fmt ".. java code generation@,@?");
267 282
       Java_backend.translate_to_java source_fmt basename normalized_prog machine_code;*)
268 283
     end
269
  | "horn" ->
284
  | "horn", _ ->
270 285
     begin
271 286
       let destname = !Options.dest_dir ^ "/" ^ basename in
272 287
       let source_file = destname ^ ".smt2" in (* Could be changed *)
......
283 298
	 Horn_backend_traces.traces_file fmt basename prog machine_code;
284 299
       )
285 300
     end
286
  | "lustre" ->
301
  | "lustre", _ ->
287 302
     begin
288 303
       let destname = !Options.dest_dir ^ "/" ^ basename in
289
       let source_file = destname ^ ".lustrec.lus" in (* Could be changed *)
304
       let source_file = destname ^ ".lustrec" ^ extension  in (* Could be changed *)
305
       Log.report ~level:1 (fun fmt -> fprintf fmt ".. exporting processed file as %s@," source_file);
290 306
       let source_out = open_out source_file in
291 307
       let fmt = formatter_of_out_channel source_out in
292 308
       Printers.pp_prog fmt prog;
......
294 310
       (*	Lustre_backend.translate fmt basename normalized_prog machine_code *)
295 311
       ()
296 312
     end
297
  | "emf" ->
313
  | "emf", _ ->
298 314
     begin
299 315
       let destname = !Options.dest_dir ^ "/" ^ basename in
300 316
       let source_file = destname ^ ".emf" in (* Could be changed *)

Also available in: Unified diff