Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / main_lustre_compiler.ml @ 22fe1c93

History | View | Annotate | Download (7.46 KB)

1
(* ----------------------------------------------------------------------------
2
 * SchedMCore - A MultiCore Scheduling Framework
3
 * Copyright (C) 2009-2013, ONERA, Toulouse, FRANCE - LIFL, Lille, FRANCE
4
 * Copyright (C) 2012-2013, INPT, Toulouse, FRANCE
5
 *
6
 * This file is part of Prelude
7
 *
8
 * Prelude is free software; you can redistribute it and/or
9
 * modify it under the terms of the GNU Lesser General Public License
10
 * as published by the Free Software Foundation ; either version 2 of
11
 * the License, or (at your option) any later version.
12
 *
13
 * Prelude is distributed in the hope that it will be useful, but
14
 * WITHOUT ANY WARRANTY ; without even the implied warranty of
15
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16
 * Lesser General Public License for more details.
17
 *
18
 * You should have received a copy of the GNU Lesser General Public
19
 * License along with this program ; if not, write to the Free Software
20
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
21
 * USA
22
 *---------------------------------------------------------------------------- *)
23

    
24
(* This module is used for the lustre to C compiler *)
25

    
26
open Format
27
open Log
28

    
29
let usage = "Usage: lustrec [options] <source-file>"
30

    
31
let extensions = [".ec";".lus"]
32

    
33
let rec compile basename extension =
34
  let source_name = basename^extension in
35
  Location.input_name := source_name;
36
  let lexbuf = Lexing.from_channel (open_in source_name) in
37
  Location.init lexbuf source_name;
38
  (* Parsing *)
39
  report ~level:1 (fun fmt -> fprintf fmt "@[<v>.. parsing file %s@,@?" source_name);
40
  let prog =
41
    try
42
      Parse.prog Parser_lustre.prog Lexer_lustre.token lexbuf
43
    with (Lexer_lustre.Error err) | (Parse.Syntax_err err) as exc -> 
44
      Parse.report_error err;
45
      raise exc
46
  in
47
  (* Extract includes *)
48
  report ~level:1 (fun fmt -> fprintf fmt ".. extracting includes@,@?");
49
  let includes = 
50
    List.fold_right 
51
      (fun d accu -> match d.Corelang.top_decl_desc with | Corelang.Include s -> s::accu | _ -> accu) 
52
      prog [] 
53
  in
54
  List.iter (fun s -> let basename = Filename.chop_suffix s ".lus" in 
55
		      report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>@ ");
56
		      compile basename ".lus";
57
		      report ~level:1 (fun fmt -> fprintf fmt "@]@,@?")
58

    
59
  ) includes;
60
  (* Unfold consts *)
61
  (*let prog = Corelang.prog_unfold_consts prog in*)
62

    
63
  (* Sorting nodes *)
64
  let prog = SortProg.sort prog in
65

    
66
  (* Typing *)
67
  report ~level:1 (fun fmt -> fprintf fmt ".. typing@,@?");
68
  begin
69
    try
70
      Typing.type_prog Basic_library.type_env prog
71
      (*Typing.uneval_prog_generics prog*)
72
    with (Types.Error (loc,err)) as exc ->
73
      Format.eprintf "Typing error at loc %a: %a@]@."
74
      Location.pp_loc loc
75
      Types.pp_error err;
76
      raise exc
77
  end;
78
  if !Options.print_types then
79
    report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@,@?" Corelang.pp_prog_type prog);
80
  
81
  (* Clock calculus *)
82
  report ~level:1 (fun fmt -> fprintf fmt ".. clock calculus@,@?");
83
  begin
84
    try
85
      Clock_calculus.clock_prog Basic_library.clock_env prog
86
    with (Clocks.Error (loc,err)) as exc ->
87
      Location.print loc;
88
      eprintf "Clock calculus error at loc %a: %a@]@." Location.pp_loc loc Clocks.pp_error err;
89
      raise exc
90
  end;
91
  if !Options.print_clocks then
92
    report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@,@?" Corelang.pp_prog_clock prog);
93

    
94
  (* Delay calculus *)
95
(*
96
  if(!Options.delay_calculus)
97
  then
98
    begin
99
      report ~level:1 (fun fmt -> fprintf fmt ".. initialisation analysis@?");
100
      try
101
	Delay_calculus.delay_prog Basic_library.delay_env prog
102
      with (Delay.Error (loc,err)) as exc ->
103
	Location.print loc;
104
	eprintf "%a" Delay.pp_error err;
105
	Utils.track_exception ();
106
	raise exc
107
    end;
108
*)
109
  (*
110
    eprintf "Causality analysis@.@?";
111
  (* Causality analysis *)
112
    begin
113
    try
114
    Causality.check_causal_prog prog
115
    with (Causality.Cycle v) as exc ->
116
    Causality.pp_error err_formatter v;
117
    raise exc
118
    end;
119
  *)
120
  (* Computes and stores generic calls for each node,
121
     only useful for ANSI C90 compliant generic node compilation *)
122
  if !Options.ansi then Causality.NodeDep.compute_generic_calls prog;
123
  (*Hashtbl.iter (fun id td -> match td.Corelang.top_decl_desc with Corelang.Node nd -> Format.eprintf "%s calls %a" id Causality.NodeDep.pp_generic_calls nd | _ -> ()) Corelang.node_table;*)
124

    
125
  (* Normalization phase *)
126
  report ~level:1 (fun fmt -> fprintf fmt ".. normalization@,@?");
127
  let normalized_prog = Normalization.normalize_prog prog in
128
  Typing.uneval_prog_generics normalized_prog;
129
  report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@,@?" Printers.pp_prog normalized_prog);
130
  (* Checking array accesses *)
131
  if !Options.check then
132
    begin
133
      report ~level:1 (fun fmt -> fprintf fmt ".. array access checks@,@?");
134
      Access.check_prog normalized_prog;
135
    end;
136

    
137
  (* DFS with modular code generation *)
138
  report ~level:1 (fun fmt -> fprintf fmt ".. machines generation@,@?");
139
  let machine_code = Machine_code.translate_prog normalized_prog in
140
  report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@,@?"
141
    (Utils.fprintf_list ~sep:"@ " Machine_code.pp_machine)
142

    
143
    machine_code);
144

    
145
  (* Printing code *)
146
  let basename    = Filename.basename basename in
147
  if !Options.java then
148
    failwith "Sorry, but not yet supported !"
149
    (*let source_file = basename ^ ".java" in
150
    report ~level:1 (fun fmt -> fprintf fmt ".. opening file %s@,@?" source_file);
151
    let source_out = open_out source_file in
152
    let source_fmt = formatter_of_out_channel source_out in
153
    report ~level:1 (fun fmt -> fprintf fmt ".. java code generation@,@?");
154
    Java_backend.translate_to_java source_fmt basename normalized_prog machine_code;*)
155
  else begin
156
    let header_file = basename ^ ".h" in (* Could be changed *)
157
    let source_file = basename ^ ".c" in (* Could be changed *)
158
    let spec_file_opt = if !Options.c_spec then 
159
	(
160
	  let spec_file = basename ^ "_spec.c" in
161
	  report ~level:1 (fun fmt -> fprintf fmt ".. opening files %s, %s and %s@,@?" header_file source_file spec_file);
162
	  Some spec_file 
163
	) else (
164
	  report ~level:1 (fun fmt -> fprintf fmt ".. opening files %s and %s@,@?" header_file source_file);
165
	  None 
166
	 )
167
    in 
168
    let header_out = open_out header_file in
169
    let header_fmt = formatter_of_out_channel header_out in
170
    let source_out = open_out source_file in
171
    let source_fmt = formatter_of_out_channel source_out in
172
    let spec_fmt_opt = match spec_file_opt with
173
	None -> None
174
      | Some f -> Some (formatter_of_out_channel (open_out f))
175
    in
176
    report ~level:1 (fun fmt -> fprintf fmt ".. C code generation@,@?");
177
    C_backend.translate_to_c header_fmt source_fmt spec_fmt_opt basename normalized_prog machine_code;
178
  end;
179
  report ~level:1 (fun fmt -> fprintf fmt ".. done !@ @]@.");
180
  (* We stop the process here *)
181
  exit 0
182
  
183
let anonymous filename =
184
  let ok_ext, ext = List.fold_left (fun (ok, ext) ext' -> if not ok && Filename.check_suffix filename ext' then true, ext' else ok, ext) (false, "") extensions in
185
  if ok_ext then
186
    let basename = Filename.chop_suffix filename ext in
187
    compile basename ext
188
  else
189
    raise (Arg.Bad ("Can only compile *.lus or *.ec files"))
190

    
191
let _ =
192
  Corelang.add_internal_funs ();
193
  try
194
    Printexc.record_backtrace true;
195
    Arg.parse Options.options anonymous usage
196
  with
197
  | Parse.Syntax_err _ | Lexer_lustre.Error _ 
198
  | Types.Error (_,_) | Clocks.Error (_,_)
199
  | Corelang.Error _ (*| Task_set.Error _*) 
200
  | Causality.Cycle _ -> exit 1
201
  | exc -> (Utils.track_exception (); raise exc)
202

    
203
(* Local Variables: *)
204
(* compile-command:"make -C .." *)
205
(* End: *)