Project

General

Profile

Revision 17abbe95

View differences:

src/basic_library.ml
35 35
  type_static (mkdim_var ()) ty
36 36

  
37 37
let type_env =
38
  List.fold_left 
39
    (fun env (op, op_type) -> TE.add_value env op op_type)
40
    TE.initial
41
    [
42
       "+", (static_op type_bin_poly_op);
43
      "uminus", (static_op type_unary_poly_op); 
44
      "-", (static_op type_bin_poly_op); 
45
      "*", (static_op type_bin_poly_op);
46
      "/", (static_op type_bin_poly_op);
47
      "mod", (static_op type_bin_int_op);
48
      "&&", (static_op type_bin_bool_op);
49
      "||", (static_op type_bin_bool_op);
50
      "xor", (static_op type_bin_bool_op);
51
      "impl", (static_op type_bin_bool_op);
52
      "<", (static_op type_bin_comp_op);
53
      "<=", (static_op type_bin_comp_op);
54
      ">", (static_op type_bin_comp_op);
55
      ">=", (static_op type_bin_comp_op);
56
      "!=", (static_op type_bin_comp_op);
57
      "=", (static_op type_bin_comp_op);
58
      "not", (static_op type_unary_bool_op)
59
]
60
 
38
  let init_env = TE.initial in
39
  let env' = TE.add_value init_env "+" (static_op type_bin_poly_op) in
40
  let env' = TE.add_value env' "uminus" (static_op type_unary_poly_op) in
41
  let env' = TE.add_value env' "-" (static_op type_bin_poly_op) in
42
  let env' = TE.add_value env' "*" (static_op type_bin_poly_op) in
43
  let env' = TE.add_value env' "/" (static_op type_bin_poly_op) in
44
  let env' = TE.add_value env' "mod" (static_op type_bin_int_op) in
45
  let env' = TE.add_value env' "&&" (static_op type_bin_bool_op) in
46
  let env' = TE.add_value env' "||" (static_op type_bin_bool_op) in
47
  let env' = TE.add_value env' "xor" (static_op type_bin_bool_op) in
48
  let env' = TE.add_value env' "impl" (static_op type_bin_bool_op) in
49
  let env' = TE.add_value env' "<" (static_op type_bin_comp_op) in
50
  let env' = TE.add_value env' "<=" (static_op type_bin_comp_op) in
51
  let env' = TE.add_value env' ">" (static_op type_bin_comp_op) in
52
  let env' = TE.add_value env' ">=" (static_op type_bin_comp_op) in
53
  let env' = TE.add_value env' "!=" (static_op type_bin_comp_op) in
54
  let env' = TE.add_value env' "=" (static_op type_bin_comp_op) in
55
  let env' = TE.add_value env' "not" (static_op type_unary_bool_op) in
56
  env'
57

  
61 58
module CE = Env
62 59

  
63 60
let clock_env =
......
88 85
module VE = Env
89 86

  
90 87
let eval_env =
91
  let defs = [ 
92
    "uminus", (function [Dint a] -> Dint (-a)           | _ -> assert false);
93
    "not", (function [Dbool b] -> Dbool (not b)         | _ -> assert false);
94
    "+", (function [Dint a; Dint b] -> Dint (a+b)       | _ -> assert false);
95
    "-", (function [Dint a; Dint b] -> Dint (a-b)       | _ -> assert false);
96
    "*", (function [Dint a; Dint b] -> Dint (a*b)       | _ -> assert false);
97
    "/", (function [Dint a; Dint b] -> Dint (a/b)       | _ -> assert false);
98
    "mod", (function [Dint a; Dint b] -> Dint (a mod b) | _ -> assert false);
99
    "&&", (function [Dbool a; Dbool b] -> Dbool (a&&b)  | _ -> assert false);
100
    "||", (function [Dbool a; Dbool b] -> Dbool (a||b)  | _ -> assert false);
101
    "xor", (function [Dbool a; Dbool b] -> Dbool (a<>b) | _ -> assert false);
102
    "impl", (function [Dbool a; Dbool b] -> Dbool (a<=b)| _ -> assert false);
103
    "<", (function [Dint a; Dint b] -> Dbool (a<b)      | _ -> assert false);
104
    ">", (function [Dint a; Dint b] -> Dbool (a>b)      | _ -> assert false);
105
    "<=", (function [Dint a; Dint b] -> Dbool (a<=b)    | _ -> assert false);
106
    ">=", (function [Dint a; Dint b] -> Dbool (a>=b)    | _ -> assert false);
107
    "!=", (function [a; b] -> Dbool (a<>b)              | _ -> assert false);
108
    "=", (function [a; b] -> Dbool (a=b)                | _ -> assert false);
109
  ]
110
  in
111
  List.fold_left 
112
    (fun env (op, op_eval) -> VE.add_value env op op_eval)
113
    VE.initial
114
    defs
88
  let init_env = VE.initial in
89
  let env' = VE.add_value init_env "uminus" (fun [Dint a] -> Dint (-a)) in
90
  let env' = VE.add_value env' "not" (fun [Dbool b] -> Dbool (not b)) in
91
  let env' = VE.add_value env' "+" (fun [Dint a; Dint b] -> Dint (a+b)) in
92
  let env' = VE.add_value env' "-" (fun [Dint a; Dint b] -> Dint (a-b)) in
93
  let env' = VE.add_value env' "*" (fun [Dint a; Dint b] -> Dint (a*b)) in
94
  let env' = VE.add_value env' "/" (fun [Dint a; Dint b] -> Dint (a/b)) in
95
  let env' = VE.add_value env' "mod" (fun [Dint a; Dint b] -> Dint (a mod b)) in
96
  let env' = VE.add_value env' "&&" (fun [Dbool a; Dbool b] -> Dbool (a&&b)) in
97
  let env' = VE.add_value env' "||" (fun [Dbool a; Dbool b] -> Dbool (a||b)) in
98
  let env' = VE.add_value env' "xor" (fun [Dbool a; Dbool b] -> Dbool (a<>b)) in
99
  let env' = VE.add_value env' "impl" (fun [Dbool a; Dbool b] -> Dbool (a<=b)) in
100
  let env' = VE.add_value env' "<" (fun [Dint a; Dint b] -> Dbool (a<b)) in
101
  let env' = VE.add_value env' ">" (fun [Dint a; Dint b] -> Dbool (a>b)) in
102
  let env' = VE.add_value env' "<=" (fun [Dint a; Dint b] -> Dbool (a<=b)) in
103
  let env' = VE.add_value env' ">=" (fun [Dint a; Dint b] -> Dbool (a>=b)) in
104
  let env' = VE.add_value env' "!=" (fun [a; b] -> Dbool (a<>b)) in
105
  let env' = VE.add_value env' "=" (fun [a; b] -> Dbool (a=b)) in
106
  env'
115 107

  
116 108
let internal_funs = ["+";"-";"*";"/";"mod";"&&";"||";"xor";"impl";"<";">";"<=";">=";"!=";"=";"uminus";"not"]
117 109

  
src/c_backend.ml
432 432
(*                         Header Printing functions                                        *)
433 433
(********************************************************************************************)
434 434

  
435
(* Removed because of "open" constructs. No more extern functions *)
436
(*
437 435
let print_prototype fmt decl =
438 436
  match decl.top_decl_desc with
439 437
    | ImportedFun m -> (
......
457 455
      )
458 456
    )
459 457
    | _ -> () (* We don't do anything here *)
460
      *)
461 458

  
462
let print_prototype fmt decl =
463
  match decl.top_decl_desc with
464
  | Open m -> fprintf fmt "#include \"%s.h\"@," m
465
  | _ -> () (* We don't do anything here *)
466
    
467 459
let pp_registers_struct fmt m =
468 460
  if m.mmemory <> []
469 461
  then
......
770 762
	(pp_c_type_decl cpt_type var) def
771 763
    | _        -> ()) type_table
772 764

  
773
let print_makefile basename nodename fmt =
774
  fprintf fmt "GCC=gcc@.";
775
  fprintf fmt "INC=/usr/local/include/lustrec@.";
776
  fprintf fmt "@.";
777
  fprintf fmt "main:@.";
778
  fprintf fmt "\t${GCC} -I${INC} -I. -c %s.c@." basename;    
779
  fprintf fmt "\t${GCC} -I${INC} -c ${INC}/io_frontend.c@.";    
780
  fprintf fmt "\t${GCC} -I${INC} -c ${INC}/StdLibrary.c@.";
781
  fprintf fmt "\t${GCC} -o %s_%s io_frontend.o StdLibrary.o -lm %s.o@." basename nodename basename
782

  
783 765
(********************************************************************************************)
784 766
(*                         Translation function                                             *)
785 767
(********************************************************************************************)
786 768
    
787
let translate_to_c header_fmt source_fmt makefile_fmt spec_fmt_opt basename prog machines =
769
let translate_to_c header_fmt source_fmt spec_fmt_opt basename prog machines =
788 770
  (* Generating H file *)
789 771

  
790 772
  (* Include once: start *)
......
813 795
  (* Generating C file *)
814 796
  
815 797
  (* If a main node is identified, generate a main function for it *)
816
  let main_include, main_print, main_makefile =
798
  let main_include, main_print =
817 799
    match !Options.main_node with
818
      | "" -> (fun _ -> ()), (fun _ -> ()), (fun _ -> ())
800
      | "" -> (fun _ -> ()), (fun _ -> ())
819 801
      | main_node -> ( 
820 802
	let main_node_opt = 
821 803
	  List.fold_left 
......
826 808
	  None machines
827 809
      in 
828 810
      match main_node_opt with
829
	| None -> eprintf "Unable to find a main node named %s@.@?" main_node; (fun _ -> ()), (fun _ -> ()), (fun _ -> ())
830
	| Some m -> print_main_header, print_main_fun machines m, print_makefile basename !Options.main_node
811
	| None -> eprintf "Unable to find a main node named %s@.@?" main_node; (fun _ -> ()), (fun _ -> ())
812
	| Some m -> print_main_header, print_main_fun machines m
831 813
    )
832 814
  in
833 815
  main_include source_fmt;
......
847 829
  pp_print_newline source_fmt ();
848 830
  (* Print nodes one by one (in the previous order) *)
849 831
  List.iter (print_machine source_fmt) machines;
850
  main_print source_fmt;
832
  main_print source_fmt
833
  
834

  
835

  
851 836

  
852
  (* Generating Makefile *)
853
  main_makefile makefile_fmt    
854 837

  
855 838
(* Local Variables: *)
856 839
(* compile-command:"make -C .." *)
src/clock_calculus.ml
769 769
    clock_function env decl.top_decl_loc fcn
770 770
  | Consts clist ->
771 771
    clock_top_consts env clist
772
  | Open _ ->
772
  | Include _ ->
773 773
    env
774 774

  
775 775
let clock_prog env decls =
776
  List.fold_left (fun e decl -> clock_top_decl e decl) env decls
776
  ignore(List.fold_left (fun e decl -> clock_top_decl e decl) env decls)
777

  
777 778

  
778
let check_env_compat declared computed =
779
  Env.iter declared (fun k decl_clock_k -> 
780
    let computed_c = Env.lookup_value computed k in
781
    try_unify decl_clock_k computed_c Location.dummy_loc
782
  ) 
783 779
(* Local Variables: *)
784 780
(* compile-command:"make -C .." *)
785 781
(* End: *)
src/corelang.ml
136 136
  | Consts of const_desc list
137 137
  | ImportedNode of imported_node_desc
138 138
  | ImportedFun of imported_fun_desc
139
  | Open of string
139
  | Include of string
140 140

  
141 141
type top_decl =
142 142
    {top_decl_desc: top_decl_desc;
......
493 493
    fun consts decl ->
494 494
      match decl.top_decl_desc with
495 495
	| Consts clist -> clist@consts
496
	| Node _ | ImportedNode _ | ImportedFun _ | Open _ -> consts  
496
	| Node _ | ImportedNode _ | ImportedFun _ | Include _ -> consts  
497 497
  ) [] prog
498 498

  
499 499

  
......
502 502
    fun nodes decl ->
503 503
      match decl.top_decl_desc with
504 504
	| Node nd -> nd::nodes
505
	| Consts _ | ImportedNode _ | ImportedFun _ | Open _ -> nodes  
505
	| Consts _ | ImportedNode _ | ImportedFun _ | Include _ -> nodes  
506 506
  ) [] prog
507 507

  
508 508
let prog_unfold_consts prog =
......
587 587
    fprintf fmt "%s: " ind.fun_id;
588 588
    Utils.reset_names ();
589 589
    fprintf fmt "%a@ " Types.print_ty ind.fun_type
590
  | Consts _ | Open _ -> ()
590
  | Consts _ | Include _ -> ()
591 591

  
592 592
let pp_prog_type fmt tdecl_list =
593 593
  Utils.fprintf_list ~sep:"" pp_decl_type fmt tdecl_list
......
600 600
    fprintf fmt "%a@ " Clocks.print_ck nd.node_clock
601 601
  | ImportedNode ind ->
602 602
    fprintf fmt "%s: " ind.nodei_id;
603
    Utils.reset_names ();
604
    fprintf fmt "%a@ " Clocks.print_ck ind.nodei_clock
605
  | ImportedFun _ | Consts _ | Open _ -> ()
603
      Utils.reset_names ();
604
      fprintf fmt "%a@ " Clocks.print_ck ind.nodei_clock
605
      | ImportedFun _ | Consts _ | Include _ -> ()
606 606

  
607 607
let pp_prog_clock fmt prog =
608 608
  Utils.fprintf_list ~sep:"" pp_decl_clock fmt prog
src/corelang.mli
133 133
  | ImportedFun of imported_fun_desc
134 134
  (* | SensorDecl of sensor_desc *)
135 135
  (* | ActuatorDecl of actuator_desc *)
136
  | Open of string
136
  | Include of string
137 137

  
138 138
type top_decl =
139 139
    {top_decl_desc: top_decl_desc;
src/env.ml
36 36
let exists_value env ident =
37 37
  IMap.mem ident env
38 38

  
39
let iter env f = IMap.iter f env
40
 
41 39
let overwrite x y =
42 40
  IMap.merge (
43 41
    fun k _old _new -> match _new with
src/lexer_lustre.mll
72 72
  "pre", PRE;
73 73
  "div", DIV;
74 74
  "const", CONST;
75
  "open", OPEN;
75
  "include", INCLUDE;
76 76
  "assert", ASSERT;
77 77
]
78 78

  
src/main_lustre_compiler.ml
30 30

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

  
33
let type_decls env decls =  
34
  report ~level:1 (fun fmt -> fprintf fmt ".. typing@,@?");
35
  let new_env = 
36
    begin
37
      try
38
	Typing.type_prog env decls
39
    (*Typing.uneval_prog_generics prog*)
40
      with (Types.Error (loc,err)) as exc ->
41
	Format.eprintf "Typing error at loc %a: %a@]@."
42
	  Location.pp_loc loc
43
	  Types.pp_error err;
44
	raise exc
45
    end 
46
  in
47
  if !Options.print_types then
48
    report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@,@?" Corelang.pp_prog_type decls);
49
  new_env
50
      
51
let clock_decls env decls = 
52
  report ~level:1 (fun fmt -> fprintf fmt ".. clock calculus@,@?");
53
  let new_env =
54
    begin
55
      try
56
	Clock_calculus.clock_prog env decls
57
      with (Clocks.Error (loc,err)) as exc ->
58
	Location.print loc;
59
	eprintf "Clock calculus error at loc %a: %a@]@." Location.pp_loc loc Clocks.pp_error err;
60
	raise exc
61
    end
62
  in
63
  if !Options.print_clocks then
64
    report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@,@?" Corelang.pp_prog_clock decls);
65
  new_env
66

  
67
(* Loading Lusi file and filing type tables with parsed
68
   functions/nodes *)
69
let load_lusi filename =
70
  Location.input_name := filename;
71
  let lexbuf = Lexing.from_channel (open_in filename) in
72
  Location.init lexbuf filename;
73
  (* Parsing *)
74
  report ~level:1 (fun fmt -> fprintf fmt "@[<v>.. parsing header file %s@,@?" filename);
75
  let header = 
76
    try
77
      Parse.prog Parser_lustre.header Lexer_lustre.token lexbuf
78
    with (Lexer_lustre.Error err) | (Parse.Syntax_err err) as exc -> 
79
      Parse.report_error err;
80
      raise exc
81
  in
82
  let new_tenv = type_decls Basic_library.type_env header in   (* Typing *)
83
  let new_cenv: Clocks.clock_expr Utils.IMap.t = clock_decls Basic_library.clock_env header in   (* Clock calculus *)
84
  header, new_tenv, new_cenv
85
  
86
    
87 33
let rec compile basename extension =
88
  (* Loading the input file *)
89 34
  let source_name = basename^extension in
90 35
  Location.input_name := source_name;
91 36
  let lexbuf = Lexing.from_channel (open_in source_name) in
92 37
  Location.init lexbuf source_name;
93 38
  (* Parsing *)
94
  report ~level:1 
95
    (fun fmt -> fprintf fmt "@[<v>.. parsing file %s@,@?" source_name);
39
  report ~level:1 (fun fmt -> fprintf fmt "@[<v>.. parsing file %s@,@?" source_name);
96 40
  let prog =
97 41
    try
98 42
      Parse.prog Parser_lustre.prog Lexer_lustre.token lexbuf
......
100 44
      Parse.report_error err;
101 45
      raise exc
102 46
  in
103
  (* Extracting dependencies *)
104
  report ~level:1 (fun fmt -> fprintf fmt ".. extracting dependencies@,@?");
105
  let dependencies = 
47
  (* Extract includes *)
48
  report ~level:1 (fun fmt -> fprintf fmt ".. extracting includes@,@?");
49
  let includes = 
106 50
    List.fold_right 
107
      (fun d accu -> match d.Corelang.top_decl_desc with 
108
      | Corelang.Open s -> s::accu 
109
      | _ -> accu) 
51
      (fun d accu -> match d.Corelang.top_decl_desc with | Corelang.Include s -> s::accu | _ -> accu) 
110 52
      prog [] 
111 53
  in
112
  let type_env, clock_env =
113
    List.fold_left (fun (type_env, clock_env) s -> 
114
      try
115
	let basename = s ^ ".lusi" in 
116
	report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>Library %s@ " s);
117
	let _, lusi_type_env, lusi_clock_env = load_lusi basename in 
118
	report ~level:1 (fun fmt -> fprintf fmt "@]@,@?");
119
	Env.overwrite type_env lusi_type_env,
120
	Env.overwrite clock_env lusi_clock_env      
121
      with Sys_error msg -> (
122
	Format.eprintf "Failure: impossible to load library %s.@.%s@." s msg;
123
	exit 1
124
      )
125
    )  (Basic_library.type_env, Basic_library.clock_env) dependencies
126
  in
127
  
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;
128 60
  (* Unfold consts *)
129 61
  (*let prog = Corelang.prog_unfold_consts prog in*)
130 62

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

  
134 66
  (* Typing *)
135
  let computed_types_env = type_decls type_env prog in
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);
136 80
  
137 81
  (* Clock calculus *)
138
  let computed_clocks_env = clock_decls clock_env prog in
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);
139 93

  
140 94
  (* Delay calculus *)
141
  (*
142
    if(!Options.delay_calculus)
143
    then
95
(*
96
  if(!Options.delay_calculus)
97
  then
144 98
    begin
145
    report ~level:1 (fun fmt -> fprintf fmt ".. initialisation analysis@?");
146
    try
147
    Delay_calculus.delay_prog Basic_library.delay_env prog
148
    with (Delay.Error (loc,err)) as exc ->
149
    Location.print loc;
150
    eprintf "%a" Delay.pp_error err;
151
    Utils.track_exception ();
152
    raise exc
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
153 107
    end;
154
  *)
108
*)
155 109
  (*
156 110
    eprintf "Causality analysis@.@?";
157
    (* Causality analysis *)
111
  (* Causality analysis *)
158 112
    begin
159 113
    try
160 114
    Causality.check_causal_prog prog
......
185 139
  let machine_code = Machine_code.translate_prog normalized_prog in
186 140
  report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@,@?"
187 141
    (Utils.fprintf_list ~sep:"@ " Machine_code.pp_machine)
188
    machine_code);
189 142

  
190
  (* Checking the existence of a lusi (Lustre Interface file) *)
191
  let lusi_name = basename ^ ".lusi" in
192
  let _ = 
193
    try 
194
      let _ = open_in lusi_name in
195
      let _, declared_types_env, declared_clocks_env = load_lusi lusi_name in
196
      (* checking type compatibilty with computed types*)
197
      Typing.check_env_compat declared_types_env computed_types_env;
198
      (* checking clocks compatibilty with computed clocks*)
199
      Clock_calculus.check_env_compat declared_clocks_env computed_clocks_env;
200
      
201
    with Sys_error _ -> ( 
202
      (* Printing lusi file is necessary *)
203
      report ~level:1 
204
	(fun fmt -> 
205
	  fprintf fmt 
206
	    ".. generating lustre interface file %s@,@?" lusi_name);
207
      let lusi_out = open_out lusi_name in
208
      let lusi_fmt = formatter_of_out_channel lusi_out in
209
      Printers.pp_lusi_header lusi_fmt source_name normalized_prog
210
    )
211
    | (Types.Error (loc,err)) as exc ->
212
      Format.eprintf "Type mismatch between computed type and declared type in lustre interface file: %a@]@."
213
	Types.pp_error err;
214
      raise exc
215
  in
143
    machine_code);
216 144

  
217 145
  (* Printing code *)
218 146
  let basename    = Filename.basename basename in
219 147
  if !Options.java then
220 148
    failwith "Sorry, but not yet supported !"
221 149
    (*let source_file = basename ^ ".java" in
222
      report ~level:1 (fun fmt -> fprintf fmt ".. opening file %s@,@?" source_file);
223
      let source_out = open_out source_file in
224
      let source_fmt = formatter_of_out_channel source_out in
225
      report ~level:1 (fun fmt -> fprintf fmt ".. java code generation@,@?");
226
      Java_backend.translate_to_java source_fmt basename normalized_prog machine_code;*)
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;*)
227 155
  else begin
228 156
    let header_file = basename ^ ".h" in (* Could be changed *)
229 157
    let source_file = basename ^ ".c" in (* Could be changed *)
230
    let makefile_file = basename ^ ".makefile" in (* Could be changed *)
231 158
    let spec_file_opt = if !Options.c_spec then 
232 159
	(
233 160
	  let spec_file = basename ^ "_spec.c" in
......
242 169
    let header_fmt = formatter_of_out_channel header_out in
243 170
    let source_out = open_out source_file in
244 171
    let source_fmt = formatter_of_out_channel source_out in
245
    let makefile_out = open_out makefile_file in
246
    let makefile_fmt = formatter_of_out_channel makefile_out in
247 172
    let spec_fmt_opt = match spec_file_opt with
248 173
	None -> None
249 174
      | Some f -> Some (formatter_of_out_channel (open_out f))
250 175
    in
251 176
    report ~level:1 (fun fmt -> fprintf fmt ".. C code generation@,@?");
252
    C_backend.translate_to_c header_fmt source_fmt makefile_fmt spec_fmt_opt basename normalized_prog machine_code;
177
    C_backend.translate_to_c header_fmt source_fmt spec_fmt_opt basename normalized_prog machine_code;
253 178
  end;
254 179
  report ~level:1 (fun fmt -> fprintf fmt ".. done !@ @]@.");
255 180
  (* We stop the process here *)
src/normalization.ml
308 308
  match decl.top_decl_desc with
309 309
  | Node nd ->
310 310
    {decl with top_decl_desc = Node (normalize_node nd)}
311
  | Open _ | ImportedNode _ | ImportedFun _ | Consts _ -> decl
311
  | Include _ | ImportedNode _ | ImportedFun _ | Consts _ -> decl
312 312
  
313 313
let normalize_prog decls = 
314 314
  List.map normalize_decl decls
src/parser_lustre.mly
48 48
%token <string> REAL
49 49
%token <float> FLOAT
50 50
%token AUTOMATON STATE UNTIL UNLESS RESTART RESUME LAST
51
%token STATELESS ASSERT OPEN QUOTE FUNCTION
51
%token STATELESS ASSERT INCLUDE QUOTE FUNCTION
52 52
%token <string> IDENT
53 53
%token <LustreSpec.expr_annot> ANNOT
54 54
%token <LustreSpec.node_annot> NODESPEC
......
91 91

  
92 92
%start prog
93 93
%type <Corelang.top_decl list> prog
94
%start header
95
%type <Corelang.top_decl list> header
96 94

  
97 95
%%
98 96

  
99 97
prog:
100 98
    typ_def_list top_decl_list EOF {$1;(List.rev $2)}
101 99

  
102
header:
103
    typ_def_list top_decl_header_list EOF {$1;(List.rev $2)}
104

  
105 100
top_decl_list:
106 101
  top_decl {[$1]}
107 102
| top_decl_list top_decl {$2::$1}
108 103

  
104
top_decl:
105
| CONST cdecl_list { mktop_decl (Consts (List.rev $2)) }
109 106

  
110
top_decl_header_list:
111
  top_decl_header {[$1]}
112
| top_decl_header_list top_decl_header {$2::$1}
107
| NODE IDENT LPAR vdecl_list RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR SCOL_opt locals LET eq_list TEL 
108
    {let eqs, asserts, annots = $14 in
109
     let nd = mktop_decl (Node
110
                            {node_id = $2;
111
                             node_type = Types.new_var ();
112
                             node_clock = Clocks.new_var true;
113
                             node_inputs = List.rev $4;
114
                             node_outputs = List.rev $8;
115
                             node_locals = List.rev $12;
116
			     node_gencalls = [];
117
			     node_checks = [];
118
			     node_asserts = asserts; 
119
                             node_eqs = eqs;
120
			     node_spec = None;
121
			     node_annot = match annots with [] -> None | _ -> Some annots})
122
    in
123
    Hashtbl.add node_table $2 nd; nd}
113 124

  
125
| nodespec_list NODE IDENT LPAR vdecl_list RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR SCOL_opt locals LET eq_list TEL 
126
    {let eqs, asserts, annots = $15 in
127
     let nd = mktop_decl (Node
128
                            {node_id = $3;
129
                             node_type = Types.new_var ();
130
                             node_clock = Clocks.new_var true;
131
                             node_inputs = List.rev $5;
132
                             node_outputs = List.rev $9;
133
                             node_locals = List.rev $13;
134
			     node_gencalls = [];
135
			     node_checks = [];
136
			     node_asserts = asserts; 
137
                             node_eqs = eqs;
138
			     node_spec = Some $1;
139
			     node_annot = match annots with [] -> None | _ -> Some annots})
140
    in
141
    Hashtbl.add node_table $3 nd; nd}
114 142

  
115
top_decl_header:
116
| NODE IDENT LPAR vdecl_list SCOL_opt RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR stateless_opt SCOL
143
| IMPORTED NODE IDENT LPAR vdecl_list RPAR RETURNS LPAR vdecl_list RPAR stateless_opt SCOL
117 144
    {let nd = mktop_decl (ImportedNode
118
                            {nodei_id = $2;
145
                            {nodei_id = $3;
119 146
                             nodei_type = Types.new_var ();
120 147
                             nodei_clock = Clocks.new_var true;
121
                             nodei_inputs = List.rev $4;
148
                             nodei_inputs = List.rev $5;
122 149
                             nodei_outputs = List.rev $9;
123
			     nodei_stateless = $12;
150
			     nodei_stateless = $11;
124 151
			     nodei_spec = None})
125 152
    in
126
    Hashtbl.add node_table $2 nd; nd}
153
    Hashtbl.add node_table $3 nd; nd}
127 154

  
128
| nodespec_list NODE IDENT LPAR vdecl_list SCOL_opt RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR stateless_opt SCOL
155
| nodespec_list IMPORTED NODE IDENT LPAR vdecl_list RPAR RETURNS LPAR vdecl_list RPAR stateless_opt SCOL
129 156
    {let nd = mktop_decl (ImportedNode
130
                            {nodei_id = $3;
157
                            {nodei_id = $4;
131 158
                             nodei_type = Types.new_var ();
132 159
                             nodei_clock = Clocks.new_var true;
133
                             nodei_inputs = List.rev $5;
160
                             nodei_inputs = List.rev $6;
134 161
                             nodei_outputs = List.rev $10;
135
			     nodei_stateless = $13;
162
			     nodei_stateless = $12;
136 163
			     nodei_spec = Some $1})
137 164
    in
138
    Hashtbl.add node_table $3 nd; nd}
165
    Hashtbl.add node_table $4 nd; nd}
139 166

  
140
| FUNCTION IDENT LPAR vdecl_list SCOL_opt RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR SCOL
167
| FUNCTION IDENT LPAR vdecl_list RPAR RETURNS LPAR vdecl_list RPAR SCOL
141 168
    {let nd = mktop_decl (ImportedNode
142 169
                            {nodei_id = $2;
143 170
                             nodei_type = Types.new_var ();
144 171
			     nodei_clock = Clocks.new_var true;
145 172
                             nodei_inputs = List.rev $4;
146
                             nodei_outputs = List.rev $9;
173
                             nodei_outputs = List.rev $8;
147 174
			     nodei_stateless = true;
148 175
			     nodei_spec = None})
149 176
     in
150 177
     Hashtbl.add node_table $2 nd; nd}
151 178

  
152
| nodespec_list FUNCTION IDENT LPAR vdecl_list SCOL_opt RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR SCOL
179
| nodespec_list FUNCTION IDENT LPAR vdecl_list RPAR RETURNS LPAR vdecl_list RPAR SCOL
153 180
    {let nd = mktop_decl (ImportedNode
154 181
                            {nodei_id = $3;
155 182
                             nodei_type = Types.new_var ();
156 183
			     nodei_clock = Clocks.new_var true;
157 184
                             nodei_inputs = List.rev $5;
158
                             nodei_outputs = List.rev $10;
185
                             nodei_outputs = List.rev $9;
159 186
			     nodei_stateless = true;
160 187
			     nodei_spec = Some $1})
161 188
     in
162 189
    Hashtbl.add node_table $3 nd; nd}
163 190

  
164
top_decl:
165
| CONST cdecl_list { mktop_decl (Consts (List.rev $2)) }
166

  
167
| NODE IDENT LPAR vdecl_list SCOL_opt RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR SCOL_opt locals LET eq_list TEL 
168
    {let eqs, asserts, annots = $15 in
169
     let nd = mktop_decl (Node
170
                            {node_id = $2;
171
                             node_type = Types.new_var ();
172
                             node_clock = Clocks.new_var true;
173
                             node_inputs = List.rev $4;
174
                             node_outputs = List.rev $9;
175
                             node_locals = List.rev $13;
176
			     node_gencalls = [];
177
			     node_checks = [];
178
			     node_asserts = asserts; 
179
                             node_eqs = eqs;
180
			     node_spec = None;
181
			     node_annot = match annots with [] -> None | _ -> Some annots})
182
    in
183
    Hashtbl.add node_table $2 nd; nd}
184

  
185
| nodespec_list NODE IDENT LPAR vdecl_list SCOL_opt RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR SCOL_opt locals LET eq_list TEL 
186
    {let eqs, asserts, annots = $16 in
187
     let nd = mktop_decl (Node
188
                            {node_id = $3;
189
                             node_type = Types.new_var ();
190
                             node_clock = Clocks.new_var true;
191
                             node_inputs = List.rev $5;
192
                             node_outputs = List.rev $10;
193
                             node_locals = List.rev $14;
194
			     node_gencalls = [];
195
			     node_checks = [];
196
			     node_asserts = asserts; 
197
                             node_eqs = eqs;
198
			     node_spec = Some $1;
199
			     node_annot = match annots with [] -> None | _ -> Some annots})
200
    in
201
    Hashtbl.add node_table $3 nd; nd}
202

  
203
| OPEN QUOTE IDENT QUOTE { mktop_decl (Open $3) }
191
| INCLUDE QUOTE IDENT QUOTE { mktop_decl (Include $3) }
204 192

  
205 193
nodespec_list:
206 194
NODESPEC { $1 }
src/printers.ml
185 185
      (fprintf_list ~sep:"@ " (fun fmt cdecl ->
186 186
	fprintf fmt "%s = %a;"
187 187
	  cdecl.const_id pp_const cdecl.const_value)) clist)
188
  | Open s -> fprintf fmt "open \"%s\"" s
188
  | Include s -> fprintf fmt "include %s" s
189 189

  
190 190

  
191 191
let pp_prog fmt prog = 
......
200 200
    fprintf fmt "const %a@ " 
201 201
      (fprintf_list ~sep:"@ " (fun fmt cdecl ->
202 202
	pp_print_string fmt cdecl.const_id)) clist)
203
  | Open s -> fprintf fmt "open \"%s\"" s
203
  | Include s -> fprintf fmt "include %s" s
204

  
204 205

  
205
let pp_lusi fmt decl = 
206
  match decl.top_decl_desc with
207
  | Node nd ->  
208
    fprintf fmt 
209
      "@[<v>node %s (%a) returns (%a);@ @]@ "
210
      nd.node_id
211
      pp_node_args nd.node_inputs
212
      pp_node_args nd.node_outputs
213
  | ImportedNode _ | ImportedFun _ | Consts _ | Open _ -> ()
214 206

  
215 207
let pp_econst fmt c = 
216 208
  match c with
......
295 287
  ) fmt spec.behaviors;
296 288
  fprintf fmt "@]@ */@.";
297 289
  ()
298

  
299

  
300
let pp_lusi_header fmt filename prog =
301
  fprintf fmt "(* Generated Lustre Interface file from %s *)@." filename;
302
  fprintf fmt "(* generated by Lustre-C compiler version %s, %a *)@." Version.number pp_date (Unix.gmtime (Unix.time ()));
303
  fprintf fmt "(* feel free to mask some of the nodes by removing them from this file. *)@.@.";
304
  List.iter (fprintf fmt "%a@." pp_lusi) prog    
305
  
306 290
(* Local Variables: *)
307 291
(* compile-command:"make -C .." *)
308 292
(* End: *)
src/typing.ml
331 331
    expr.expr_type <- ty;
332 332
    ty
333 333
  | Expr_appl (id, args, r) ->
334
    (* application of non internal function is not legal in a constant
335
       expression *)
334
    (* application of non internal function is not legal in a constant expression *)
336 335
    (match r with
337 336
    | None        -> ()
338
    | Some (x, l) -> 
339
      check_constant expr.expr_loc const false;
340
      let expr_x = expr_of_ident x expr.expr_loc in	
341
      let typ_l = 
342
	Type_predef.type_clock 
343
	  (type_const expr.expr_loc (Const_tag l)) in
344
      type_subtyping_arg env in_main ~sub:false const expr_x typ_l);
337
    | Some (x, l) -> check_constant expr.expr_loc const false;
338
                     let expr_x = expr_of_ident x expr.expr_loc in	
339
		     let typ_l = Type_predef.type_clock (type_const expr.expr_loc (Const_tag l)) in
340
		     type_subtyping_arg env in_main ~sub:false const expr_x typ_l);
345 341
    let touts = type_appl env in_main expr.expr_loc const id args in
346 342
    expr.expr_type <- touts;
347 343
    touts
......
587 583
      type_imported_fun env nd decl.top_decl_loc
588 584
  | Consts clist ->
589 585
      type_top_consts env clist
590
  | Open _  -> env
586
  | Include _  -> env
591 587

  
592 588
let type_prog env decls =
593 589
try
594
  List.fold_left type_top_decl env decls
590
  ignore(List.fold_left type_top_decl env decls)
595 591
with Failure _ as exc -> raise exc
596 592

  
597 593
(* Once the Lustre program is fully typed,
......
636 632
  | ImportedFun nd ->
637 633
      ()
638 634
  | Consts clist -> ()
639
  | Open _  -> ()
635
  | Include _  -> ()
640 636

  
641 637
let uneval_prog_generics prog =
642 638
 List.iter uneval_top_generics prog
643

  
644
let check_env_compat declared computed =
645
  Env.iter declared (fun k decl_type_k -> 
646
    let computed_t = Env.lookup_value computed k in
647
    try_unify decl_type_k computed_t Location.dummy_loc
648
  ) 
649

  
650 639
(* Local Variables: *)
651 640
(* compile-command:"make -C .." *)
652 641
(* End: *)
src/utils.ml
308 308
  in
309 309
  pp_list lid pp_fun "" "." "."  
310 310

  
311
let pp_date fmt tm =
312
  Format.fprintf fmt "%i/%i/%i, %i:%i:%i"
313
    (tm.Unix.tm_year + 1900)
314
    tm.Unix.tm_mon
315
    tm.Unix.tm_mday
316
    tm.Unix.tm_hour
317
    tm.Unix.tm_min
318
    tm.Unix.tm_sec
319 311

  
320 312
(* Used for uid in variables *)
321 313

  
test/test-compile.sh
1 1
#!/bin/bash
2 2

  
3 3
NOW=`date "+%y%m%d%H%M"`
4
LUSTREC="../../_build/src/lustrec"
4

  
5 5
mkdir -p build
6 6
cd build
7 7

  
......
11 11
#   echo main:$main
12 12
#   echo opts:$opts
13 13
    if [ "$main" != "" ]; then
14
	$LUSTREC -d build -verbose 0 $opts -node $main ../$file;
14
	lustrec -d build -verbose 0 $opts -node $main ../$file;
15 15
    else
16
	$LUSTREC -d build -verbose 0 $opts ../$file
16
	lustrec -d build -verbose 0 $opts ../$file
17 17
    fi
18 18
    if [ $? -ne 0 ]; then 
19 19
      rlustrec="INVALID"; 

Also available in: Unified diff