Project

General

Profile

Revision 54ae8ac7

View differences:

AUTHORS
1
Pierre-Loïc Garoche - ONERA
2
Xavier Thirioux - ENSEEIHT/INPT
_oasis
7 7
Plugins:     DevFiles (0.2)
8 8
# , Custom (0.2)
9 9
PreBuildCommand: ./svn_version.sh $(prefix)
10
PostInstallCommand: mkdir -p $(prefix)/include/lustrec; cp -rf include/*.[ch] $(prefix)/include/lustrec; cp -rf include/*.java $(prefix)/include/lustrec
10
PostInstallCommand: mkdir -p $(prefix)/include/lustrec; cp -rf include/* $(prefix)/include/lustrec
11 11

  
12 12
Executable lustrec
13 13
  Path:       src
setup.ml
1 1
(* setup.ml generated for the first time by OASIS v0.2.0 *)
2 2

  
3 3
(* OASIS_START *)
4
(* DO NOT EDIT (digest: 199ddf56e2399fc7ababf7124443bcc9) *)
4
(* DO NOT EDIT (digest: 243f7ef4ca5fa7182acbe98e77d9c7f4) *)
5 5
(*
6 6
   Regenerated by OASIS v0.3.0
7 7
   Visit http://oasis.forge.ocamlcore.org for more information and
......
5791 5791
                              "$(prefix)/include/lustrec;";
5792 5792
                              "cp";
5793 5793
                              "-rf";
5794
                              "include/*.[ch]";
5795
                              "$(prefix)/include/lustrec;";
5796
                              "cp";
5797
                              "-rf";
5798
                              "include/*.java";
5794
                              "include/*";
5799 5795
                              "$(prefix)/include/lustrec"
5800 5796
                           ])))
5801 5797
                 ];
......
5875 5871
          };
5876 5872
     oasis_fn = Some "_oasis";
5877 5873
     oasis_version = "0.3.0";
5878
     oasis_digest = Some "^\201\165\144\189\n\251D\168\165\229o\014u\145\241";
5874
     oasis_digest = Some "wX\249B\007\151\134\1970p\217\138\017\214\244\241";
5879 5875
     oasis_exec = None;
5880 5876
     oasis_setup_args = [];
5881 5877
     setup_update = false;
......
5883 5879

  
5884 5880
let setup () = BaseSetup.setup setup_t;;
5885 5881

  
5886
# 5887 "setup.ml"
5882
# 5883 "setup.ml"
5887 5883
(* OASIS_STOP *)
5888 5884
let () = setup ();;
src/c_backend.ml
357 357
    (Utils.pp_final_char_if_non_empty ", " static)
358 358
    self inst
359 359

  
360
let rec pp_conditional (m: machine_t) self fmt c tl el =
360
let has_c_prototype funname dependencies =
361
  let imported_node_opt = (* We select the last imported node with the name funname.
362
			       The order of evaluation of dependencies should be
363
			       compatible with overloading. (Not checked yet) *) 
364
      List.fold_left
365
	(fun res (_, _, decls) -> 
366
	  match res with
367
	  | Some _ -> res
368
	  | None -> 
369
	    let matched = fun t -> match t.top_decl_desc with 
370
	      | ImportedNode nd -> nd.nodei_id = funname 
371
	      | _ -> false
372
	    in
373
	    if List.exists matched decls then (
374
	      match (List.find matched decls).top_decl_desc with
375
	      | ImportedNode nd -> Some nd
376
	      | _ -> assert false
377
	    )
378
	    else
379
	      None
380
	) None dependencies in
381
    match imported_node_opt with
382
    | None -> false
383
    | Some nd -> (match nd.nodei_prototype with Some "C" -> true | _ -> false)
384

  
385
let rec pp_conditional dependencies (m: machine_t) self fmt c tl el =
361 386
  fprintf fmt "@[<v 2>if (%a) {%t%a@]@,@[<v 2>} else {%t%a@]@,}"
362 387
    (pp_c_val self (pp_c_var_read m)) c
363 388
    (Utils.pp_newline_if_non_empty tl)
364
    (Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) tl
389
    (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) tl
365 390
    (Utils.pp_newline_if_non_empty el)
366
    (Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) el
391
    (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) el
367 392

  
368
and pp_machine_instr (m: machine_t) self fmt instr =
393
and pp_machine_instr dependencies (m: machine_t) self fmt instr =
369 394
  match instr with 
370 395
  | MReset i ->
371 396
    pp_machine_reset m self fmt i
......
378 403
      m self (pp_c_var_read m) fmt
379 404
      i.var_type (StateVar i) v
380 405
  | MStep ([i0], i, vl) when Basic_library.is_internal_fun i  ->
381
    pp_machine_instr m self fmt (MLocalAssign (i0, Fun (i, vl)))
406
    pp_machine_instr dependencies m self fmt (MLocalAssign (i0, Fun (i, vl)))
407
  | MStep ([i0], i, vl) when has_c_prototype i dependencies -> 
408
    fprintf fmt "%a = %s(%a);" 
409
      (pp_c_val self (pp_c_var_read m)) (LocalVar i0) 
410
      i
411
      (Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) vl
382 412
  | MStep (il, i, vl) ->
383 413
    pp_instance_call m self fmt i vl il
384 414
  | MBranch (g,hl) ->
......
387 417
	 (* may disappear if we optimize code by replacing last branch test with default *)
388 418
      let tl = try List.assoc tag_true  hl with Not_found -> [] in
389 419
      let el = try List.assoc tag_false hl with Not_found -> [] in
390
      pp_conditional m self fmt g tl el
420
      pp_conditional dependencies m self fmt g tl el
391 421
    else (* enum type case *)
392 422
      fprintf fmt "@[<v 2>switch(%a) {@,%a@,}@]"
393 423
	(pp_c_val self (pp_c_var_read m)) g
394
	(Utils.fprintf_list ~sep:"@," (pp_machine_branch m self)) hl
424
	(Utils.fprintf_list ~sep:"@," (pp_machine_branch dependencies m self)) hl
395 425

  
396
and pp_machine_branch m self fmt (t, h) =
397
  fprintf fmt "@[<v 2>case %a:@,%a@,break;@]" pp_c_tag t (Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) h
426
and pp_machine_branch dependencies m self fmt (t, h) =
427
  fprintf fmt "@[<v 2>case %a:@,%a@,break;@]" pp_c_tag t (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) h
398 428

  
399 429

  
400 430
(**************************************************************************)
......
528 558
let print_import_standard fmt =
529 559
  fprintf fmt "#include \"%s/include/lustrec/arrow.h\"@.@." Version.prefix
530 560

  
531
let print_import_prototype fmt decl =
532
  match decl.top_decl_desc with
533
  | Open m -> fprintf fmt "#include \"%s.h\"@," m
534
  | _ -> () (* We don't do anything here *)
561
let print_import_prototype fmt (s, _, _) =
562
  fprintf fmt "#include \"%s.h\"@," s
535 563
    
536 564
let pp_registers_struct fmt m =
537 565
  if m.mmemory <> []
......
699 727
    (Utils.fprintf_list ~sep:"" print_alloc_array) array_mem
700 728
    (Utils.fprintf_list ~sep:"" print_alloc_instance) m.minstances
701 729

  
702
let print_stateless_code fmt m =
730
let print_stateless_code dependencies fmt m =
703 731
  let self = "__ERROR__" in
704 732
  if not (!Options.ansi && is_generic_node { top_decl_desc = Node m.mname; top_decl_loc = Location.dummy_loc })
705 733
  then
......
712 740
      (* check assertions *)
713 741
      (pp_c_checks self) m
714 742
      (* instrs *)
715
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) m.mstep.step_instrs
743
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.mstep.step_instrs
716 744
      (Utils.pp_newline_if_non_empty m.mstep.step_instrs)
717 745
      (fun fmt -> fprintf fmt "return;")
718 746
  else
......
727 755
      (* check assertions *)
728 756
      (pp_c_checks self) m
729 757
      (* instrs *)
730
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) m.mstep.step_instrs
758
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.mstep.step_instrs
731 759
      (Utils.pp_newline_if_non_empty m.mstep.step_instrs)
732 760
      (fun fmt -> fprintf fmt "return;")
733 761

  
734
let print_step_code fmt m self =
762
let print_reset_code dependencies fmt m self =
763
  fprintf fmt "@[<v 2>%a {@,%a%treturn;@]@,}@.@."
764
    (print_reset_prototype self) (m.mname.node_id, m.mstatic)
765
    (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.minit
766
    (Utils.pp_newline_if_non_empty m.minit)
767

  
768
let print_step_code dependencies fmt m self =
735 769
  if not (!Options.ansi && is_generic_node { top_decl_desc = Node m.mname; top_decl_loc = Location.dummy_loc })
736 770
  then
737 771
    (* C99 code *)
......
747 781
      (* check assertions *)
748 782
      (pp_c_checks self) m
749 783
      (* instrs *)
750
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) m.mstep.step_instrs
784
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.mstep.step_instrs
751 785
      (Utils.pp_newline_if_non_empty m.mstep.step_instrs)
752 786
      (fun fmt -> fprintf fmt "return;")
753 787
  else
......
762 796
      (* check assertions *)
763 797
      (pp_c_checks self) m
764 798
      (* instrs *)
765
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) m.mstep.step_instrs
799
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.mstep.step_instrs
766 800
      (Utils.pp_newline_if_non_empty m.mstep.step_instrs)
767 801
      (fun fmt -> fprintf fmt "return;")
768 802

  
769
let print_machine fmt m =
803
let print_machine dependencies fmt m =
770 804
  if fst (get_stateless_status m) then
771 805
    begin
772 806
      (* Step function *)
773
      print_stateless_code fmt m
807
      print_stateless_code dependencies fmt m
774 808
    end
775 809
  else
776 810
    begin
......
783 817
	);
784 818
      let self = mk_self m in
785 819
      (* Reset function *)
786
      fprintf fmt "@[<v 2>%a {@,%a%treturn;@]@,}@.@."
787
	(print_reset_prototype self) (m.mname.node_id, m.mstatic)
788
	(Utils.fprintf_list ~sep:"@," (pp_machine_instr m self)) m.minit
789
	(Utils.pp_newline_if_non_empty m.minit);
820
      print_reset_code dependencies fmt m self;
790 821
      (* Step function *)
791
      print_step_code fmt m self
822
      print_step_code dependencies fmt m self
792 823
    end
793 824

  
794 825
(********************************************************************************************)
......
906 937
	(pp_c_type_decl filename cpt_type var) def
907 938
    | _        -> ()) type_table
908 939

  
940

  
941
let header_has_code header =
942
  List.exists 
943
    (fun top -> 
944
      match top.top_decl_desc with
945
      | Consts _ -> true 
946
      | ImportedNode nd -> nd.nodei_in_lib = None
947
      | _ -> false
948
    )
949
    header
950

  
951
let header_libs header =
952
  List.fold_left (fun accu top ->
953
    match top.top_decl_desc with
954
      | ImportedNode nd -> (match nd.nodei_in_lib with 
955
	| None -> accu 
956
	| Some lib -> Utils.list_union [lib] accu)
957
      | _ -> accu 
958
  ) [] header 
959
    
909 960
let print_makefile basename nodename dependencies fmt =
961
  let compiled_dependencies = 
962
    List.filter (fun (_, _, header) -> header_has_code header) dependencies
963
  in
964
  let lib_dependencies = 
965
    List.fold_left 
966
      (fun accu (_, _, header) -> Utils.list_union (header_libs header) accu) [] dependencies 
967
  in
910 968
  fprintf fmt "GCC=gcc@.";
911 969
  fprintf fmt "LUSTREC=%s@." Sys.executable_name;
912 970
  fprintf fmt "LUSTREC_BASE=%s@." (Filename.dirname (Filename.dirname Sys.executable_name));
......
916 974
  fprintf fmt "\t${GCC} -I${INC} -I. -c %s.c@." basename;    
917 975
  List.iter (fun s -> (* Format.eprintf "Adding dependency: %s@." s;  *)
918 976
    fprintf fmt "\t${GCC} -I${INC} -c %s@." s)
919
    (("${INC}/io_frontend.c")::(List.map (fun s -> s ^ ".c") dependencies));    
920
(*  fprintf fmt "\t${GCC} -I${INC} -c ${INC}/StdLibrary.c@."; *)
921
(*  fprintf fmt "\t${GCC} -o %s_%s io_frontend.o StdLibrary.o -lm %s.o@." basename nodename basename*)
922
  fprintf fmt "\t${GCC} -o %s_%s io_frontend.o %a -lm %s.o@." basename nodename 
923
    (Utils.fprintf_list ~sep:" " (fun fmt s -> Format.fprintf fmt "%s.o" s)) dependencies basename;
977
    (("${INC}/io_frontend.c"):: (* IO functions when a main function is computed *)
978
	(List.map 
979
	   (fun (s, local, _) -> 
980
	     (if local then s else Version.prefix ^ "/include/lustrec/" ^ s) ^ ".c")
981
	   compiled_dependencies));    
982
  fprintf fmt "\t${GCC} -o %s_%s io_frontend.o %a %s.o %a@." basename nodename 
983
    (Utils.fprintf_list ~sep:" " (fun fmt (s, _, _) -> Format.fprintf fmt "%s.o" s)) compiled_dependencies 
984
    basename
985
    (Utils.fprintf_list ~sep:" " (fun fmt lib -> fprintf fmt "-l%s" lib)) lib_dependencies
986
    ;
924 987
 fprintf fmt "@.";
925 988
 fprintf fmt "clean:@.";
926 989
 fprintf fmt "\t\\rm -f *.o %s_%s@." basename nodename
......
985 1048
  (* Print the prototype of imported nodes *)
986 1049
  fprintf source_fmt "/* Imported nodes declarations */@.";
987 1050
  fprintf source_fmt "@[<v>";
988
  List.iter (print_import_prototype source_fmt) prog;
1051
  List.iter (print_import_prototype source_fmt) dependencies;
989 1052
  fprintf source_fmt "@]@.";
990 1053
  (* Print consts *)
991 1054
  fprintf source_fmt "/* Global constants (definitions) */@.";
992 1055
  List.iter (fun c -> print_const_def source_fmt c) (get_consts prog);
993 1056
  pp_print_newline source_fmt ();
994 1057
  (* Print nodes one by one (in the previous order) *)
995
  List.iter (print_machine source_fmt) machines;
1058
  List.iter (print_machine dependencies source_fmt) machines;
996 1059
  main_print source_fmt;
997 1060

  
998 1061
  (* Generating Makefile *)
src/corelang.ml
118 118
     nodei_outputs: var_decl list;
119 119
     nodei_stateless: bool;
120 120
     nodei_spec: LustreSpec.node_annot option;
121
     nodei_prototype: string option;
122
     nodei_in_lib: string option;
121 123
    }
122 124

  
123 125
type const_desc = 
......
128 130
    }
129 131

  
130 132
type top_decl_desc =
131
  | Node of node_desc
132
  | Consts of const_desc list
133
  | ImportedNode of imported_node_desc
134
  | Open of string
133
| Node of node_desc
134
| Consts of const_desc list
135
| ImportedNode of imported_node_desc
136
| Open of bool * string (* the boolean set to true denotes a local 
137
			   lusi vs a lusi installed at system level *)
135 138

  
136 139
type top_decl =
137 140
    {top_decl_desc: top_decl_desc;
......
753 756
	nodei_inputs = vdecls_of_typ_ck cpt tin;
754 757
	nodei_outputs = vdecls_of_typ_ck cpt tout;
755 758
	nodei_stateless = Types.get_static_value ty <> None;
756
	nodei_spec = spec})
759
	nodei_spec = spec;
760
	nodei_prototype = None;
761
       	nodei_in_lib = None;
762
       })
757 763

  
758 764
let add_internal_funs () =
759 765
  List.iter
src/corelang.mli
114 114
     nodei_inputs: var_decl list;
115 115
     nodei_outputs: var_decl list;
116 116
     nodei_stateless: bool;
117
     nodei_spec: LustreSpec.node_annot option;}
117
     nodei_spec: LustreSpec.node_annot option;
118
     nodei_prototype: string option;
119
     nodei_in_lib: string option;
120
}
118 121
(*
119 122
type imported_fun_desc =
120 123
    {fun_id: ident;
......
144 147
  (* | ImportedFun of imported_fun_desc *)
145 148
  (* | SensorDecl of sensor_desc *)
146 149
  (* | ActuatorDecl of actuator_desc *)
147
  | Open of string
150
  | Open of bool * string
148 151

  
149 152
type top_decl =
150 153
    {top_decl_desc: top_decl_desc;
src/lexer_lustre.mll
72 72
  "div", DIV;
73 73
  "const", CONST;
74 74
  "assert", ASSERT;
75
  "in", IN;
76
  "prototype", PROTOTYPE;
75 77
]
76 78

  
77 79

  
src/log.ml
25 25

  
26 26
let report ~level:level p =
27 27
if !Options.verbose_level >= level then
28
  Format.eprintf "%t@?" p
28
  Format.eprintf "%t" p
29 29

  
30 30
(* Local Variables: *)
31 31
(* compile-command:"make -C .." *)
src/main_lustre_compiler.ml
31 31
let extensions = [".ec"; ".lus"; ".lusi"]
32 32

  
33 33
let check_stateless_decls decls =
34
  report ~level:1 (fun fmt -> fprintf fmt ".. checking stateless/stateful status@,@?");
34
  report ~level:1 (fun fmt -> fprintf fmt ".. checking stateless/stateful status@ ");
35 35
  try
36 36
    Stateless.check_prog decls
37 37
  with (Stateless.Error (loc, err)) as exc ->
38
    Format.eprintf "Stateless status error at loc %a: %a@]@."
38
    Format.eprintf "Stateless status error at loc %a: %a@."
39 39
      Location.pp_loc loc
40 40
      Stateless.pp_error err;
41 41
    raise exc
42 42

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

  
76 76
(* Loading Lusi file and filling type tables with parsed
......
80 80
  let lexbuf = Lexing.from_channel (open_in filename) in
81 81
  Location.init lexbuf filename;
82 82
  (* Parsing *)
83
  report ~level:1 (fun fmt -> fprintf fmt "@[<v>.. parsing header file %s@,@?" filename);
84
  try
85
    Parse.header own Parser_lustre.header Lexer_lustre.token lexbuf
86
  with
87
  | (Lexer_lustre.Error err) | (Parse.Syntax_err err) as exc -> 
88
    Parse.report_error err;
89
    raise exc
90
  | Corelang.Error (loc, err) as exc ->
91
     Format.eprintf "Parsing error at loc %a: %a@]@."
92
       Location.pp_loc loc
83
  report ~level:1 (fun fmt -> fprintf fmt ".. parsing header file %s@ " filename);
84
    try
85
      Parse.header own Parser_lustre.header Lexer_lustre.token lexbuf
86
    with
87
    | (Lexer_lustre.Error err) | (Parse.Syntax_err err) as exc -> 
88
      Parse.report_error err;
89
      raise exc
90
    | Corelang.Error (loc, err) as exc -> (
91
      Format.eprintf "Parsing error at loc %a: %a@."
92
	Location.pp_loc loc
93 93
       Corelang.pp_error err;
94
     raise exc
94
      raise exc
95
    )
96

  
95 97

  
96 98
let check_lusi header =
97 99
  let new_tenv = type_decls Basic_library.type_env header in   (* Typing *)
98 100
  let new_cenv = clock_decls Basic_library.clock_env header in   (* Clock calculus *)
99 101
  header, new_tenv, new_cenv
102

  
100 103
    
101 104
let rec compile basename extension =
102 105
  (* Loading the input file *)
......
106 109
  Location.init lexbuf source_name;
107 110
  (* Parsing *)
108 111
  report ~level:1 
109
    (fun fmt -> fprintf fmt "@[<v>.. parsing file %s@,@?" source_name);
112
    (fun fmt -> fprintf fmt "@[<v>.. parsing file %s@," source_name);
110 113
  let prog =
111 114
    try
112 115
      Parse.prog Parser_lustre.prog Lexer_lustre.token lexbuf
......
115 118
      Parse.report_error err;
116 119
      raise exc
117 120
    | Corelang.Error (loc, err) as exc ->
118
      Format.eprintf "Parsing error at loc %a: %a@]@."
121
      Format.eprintf "Parsing error at loc %a: %a@."
119 122
	Location.pp_loc loc
120 123
	Corelang.pp_error err;
121 124
      raise exc
122 125
  in
123 126
  (* Extracting dependencies *)
124
  report ~level:1 (fun fmt -> fprintf fmt ".. extracting dependencies@,@?");
127
  report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>.. extracting dependencies@,");
125 128
  let dependencies = 
126 129
    List.fold_right 
127 130
      (fun d accu -> match d.Corelang.top_decl_desc with 
128
      | Corelang.Open s -> s::accu 
131
      | Corelang.Open (local, s) -> (s, local)::accu 
129 132
      | _ -> accu) 
130 133
      prog [] 
131 134
  in
132
  let type_env, clock_env =
133
    List.fold_left (fun (type_env, clock_env) s -> 
135
  let dependencies, type_env, clock_env =
136
    List.fold_left (fun (compilation_dep, type_env, clock_env) (s, local) -> 
134 137
      try
135
	let basename = s ^ ".lusi" in 
136
	report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>Library %s@ " s);
137
	let _, lusi_type_env, lusi_clock_env = check_lusi (load_lusi false basename) in 
138
	report ~level:1 (fun fmt -> fprintf fmt "@]@,@?");
138
	let basename = (if local then s else Version.prefix ^ "/include/lustrec/" ^ s ) ^ ".lusi" in 
139
	report ~level:1 (fun fmt -> fprintf fmt "@[<v 0>Library %s@," basename);
140
	let comp_dep, lusi_type_env, lusi_clock_env = check_lusi (load_lusi false basename) in 
141
	report ~level:1 (fun fmt -> fprintf fmt "@]@ ");
142
	(s, local, comp_dep)::compilation_dep,
139 143
	Env.overwrite type_env lusi_type_env,
140 144
	Env.overwrite clock_env lusi_clock_env      
141 145
      with Sys_error msg -> (
142 146
	Format.eprintf "Failure: impossible to load library %s.@.%s@." s msg;
143 147
	exit 1
144 148
      )
145
    )  (Basic_library.type_env, Basic_library.clock_env) dependencies
149
    )  ([], Basic_library.type_env, Basic_library.clock_env) dependencies
146 150
  in
151
  report ~level:1 (fun fmt -> fprintf fmt "@]@ ");
147 152
  
148 153
  (* Unfold consts *)
149 154
  (*let prog = Corelang.prog_unfold_consts prog in*)
......
216 221
      report ~level:1 
217 222
	(fun fmt -> 
218 223
	  fprintf fmt 
219
	    ".. generating lustre interface file %s@,@?" lusi_name);
224
	    ".. generating lustre interface file %s@," lusi_name);
220 225
      let lusi_out = open_out lusi_name in
221 226
      let lusi_fmt = formatter_of_out_channel lusi_out in
222 227
      Typing.uneval_prog_generics prog;
......
224 229
      Printers.pp_lusi_header lusi_fmt source_name prog
225 230
    )
226 231
    | (Types.Error (loc,err)) as exc ->
227
      Format.eprintf "Type mismatch between computed type and declared type in lustre interface file: %a@]@."
232
      Format.eprintf "Type mismatch between computed type and declared type in lustre interface file: %a@."
228 233
	Types.pp_error err;
229 234
      raise exc
230 235
    | Clocks.Error (loc, err) as exc ->
231
      Format.eprintf "Clock mismatch between computed clock and declared clock in lustre interface file: %a@]@."
236
      Format.eprintf "Clock mismatch between computed clock and declared clock in lustre interface file: %a@."
232 237
	Clocks.pp_error err;
233 238
      raise exc
234 239
    | Stateless.Error (loc, err) as exc ->
235
      Format.eprintf "Stateless status mismatch between defined status and declared status in lustre interface file: %a@]@."
240
      Format.eprintf "Stateless status mismatch between defined status and declared status in lustre interface file: %a@."
236 241
	Stateless.pp_error err;
237 242
      raise exc
238 243
  in
......
243 248
  (*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;*)
244 249

  
245 250
  (* Normalization phase *)
246
  report ~level:1 (fun fmt -> fprintf fmt ".. normalization@,@?");
251
  report ~level:1 (fun fmt -> fprintf fmt ".. normalization@,");
247 252
  let normalized_prog = Normalization.normalize_prog prog in
248
  report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@,@?" Printers.pp_prog normalized_prog);
253
  report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Printers.pp_prog normalized_prog);
249 254
  (* Checking array accesses *)
250 255
  if !Options.check then
251 256
    begin
252
      report ~level:1 (fun fmt -> fprintf fmt ".. array access checks@,@?");
257
      report ~level:1 (fun fmt -> fprintf fmt ".. array access checks@,");
253 258
      Access.check_prog normalized_prog;
254 259
    end;
255 260

  
256 261
  (* DFS with modular code generation *)
257
  report ~level:1 (fun fmt -> fprintf fmt ".. machines generation@,@?");
262
  report ~level:1 (fun fmt -> fprintf fmt ".. machines generation@,");
258 263
  let machine_code = Machine_code.translate_prog normalized_prog in
259
  report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@,@?"
264
  report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@,"
260 265
    (Utils.fprintf_list ~sep:"@ " Machine_code.pp_machine)
261 266
    machine_code);
262 267
  
263 268
  (* Creating destination directory if needed *)
264 269
  if not (Sys.file_exists !Options.dest_dir) then (
265
    report ~level:1 (fun fmt -> fprintf fmt ".. creating destination directory@,@?");
270
    report ~level:1 (fun fmt -> fprintf fmt ".. creating destination directory@,");
266 271
    Unix.mkdir !Options.dest_dir (Unix.stat ".").Unix.st_perm
267 272
  );
268 273
  if (Unix.stat !Options.dest_dir).Unix.st_kind <> Unix.S_DIR then (
......
281 286
	  let spec_file_opt = if !Options.c_spec then 
282 287
	      (
283 288
		let spec_file = basename ^ "_spec.c" in
284
		report ~level:1 (fun fmt -> fprintf fmt ".. opening files %s, %s and %s@,@?" header_file source_file spec_file);
289
		report ~level:1 (fun fmt -> fprintf fmt ".. opening files %s, %s and %s@," header_file source_file spec_file);
285 290
		Some spec_file 
286 291
	      ) else (
287
		report ~level:1 (fun fmt -> fprintf fmt ".. opening files %s and %s@,@?" header_file source_file);
292
		report ~level:1 (fun fmt -> fprintf fmt ".. opening files %s and %s@," header_file source_file);
288 293
		None 
289 294
	       )
290 295
	  in 
......
298 303
	      None -> None
299 304
	    | Some f -> Some (formatter_of_out_channel (open_out f))
300 305
	  in
301
	  report ~level:1 (fun fmt -> fprintf fmt ".. C code generation@,@?");
306
	  report ~level:1 (fun fmt -> fprintf fmt ".. C code generation@,");
302 307
	  C_backend.translate_to_c header_fmt source_fmt makefile_fmt spec_fmt_opt basename normalized_prog machine_code dependencies
303 308
	end
304 309
    | "java" ->
src/parser_lustre.mly
90 90
%token MULT DIV MOD
91 91
%token MINUS PLUS UMINUS
92 92
%token PRE ARROW
93

  
93
%token PROTOTYPE IN
94 94
%token EOF
95 95

  
96 96
%nonassoc COMMA
......
131 131
| open_lusi open_list { $1 :: $2 }
132 132

  
133 133
open_lusi:
134
  OPEN QUOTE IDENT QUOTE { mktop_decl (Open $3) }
134
| OPEN QUOTE IDENT QUOTE { mktop_decl (Open (true, $3))}
135
| OPEN LT IDENT GT { mktop_decl (Open (false, $3)) }
135 136

  
136 137
top_decl_list:
137 138
  top_decl {[$1]}
......
147 148
| NODE { false }
148 149

  
149 150
top_decl_header:
150
  nodespec_list state_annot IDENT LPAR vdecl_list SCOL_opt RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR SCOL
151
| CONST cdecl_list { fun _ -> mktop_decl (Consts (List.rev $2)) }
152
| nodespec_list state_annot IDENT LPAR vdecl_list SCOL_opt RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR  prototype_opt in_lib_opt SCOL
151 153
    {let nd = mktop_decl (ImportedNode
152 154
                            {nodei_id = $3;
153 155
                             nodei_type = Types.new_var ();
......
155 157
                             nodei_inputs = List.rev $5;
156 158
                             nodei_outputs = List.rev $10;
157 159
			     nodei_stateless = $2;
158
			     nodei_spec = $1})
160
			     nodei_spec = $1;
161
			     nodei_prototype = $13;
162
			     nodei_in_lib = $14;})
159 163
    in
160 164
    (fun own -> add_node own ("node " ^ $3) node_table $3 nd; nd) }
161 165

  
166
prototype_opt:
167
 { None }
168
| PROTOTYPE IDENT { Some $2}
169

  
170
in_lib_opt:
171
{ None }
172
| IN IDENT {Some $2} 
173

  
162 174
top_decl:
163 175
| CONST cdecl_list { mktop_decl (Consts (List.rev $2)) }
164 176
| nodespec_list state_annot IDENT LPAR vdecl_list SCOL_opt RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR SCOL_opt locals LET eq_list TEL 
src/printers.ml
255 255
    pp_node_args ind.nodei_outputs
256 256
    (fun fmt -> if ind.nodei_stateless then Format.fprintf fmt "stateless") 
257 257

  
258
let pp_const_list fmt clist = 
259
  fprintf_list ~sep:"@ " (fun fmt cdecl ->
260
    fprintf fmt "%s = %a;"
261
      cdecl.const_id pp_const cdecl.const_value) fmt clist
262

  
258 263
let pp_decl fmt decl =
259 264
  match decl.top_decl_desc with
260 265
  | Node nd -> fprintf fmt "%a@ " pp_node nd
261 266
  | ImportedNode ind ->
262 267
    fprintf fmt "imported %a;@ " pp_imported_node ind
263
  | Consts clist -> (
264
    fprintf fmt "const %a@ " 
265
      (fprintf_list ~sep:"@ " (fun fmt cdecl ->
266
	fprintf fmt "%s = %a;"
267
	  cdecl.const_id pp_const cdecl.const_value)) clist)
268
  | Open s -> fprintf fmt "open \"%s\"" s
268
  | Consts clist -> (fprintf fmt "const %a@ " pp_const_list clist)
269
  | Open (local, s) -> if local then fprintf fmt "open \"%s\"" s else fprintf fmt "open <%s>" s
269 270

  
270 271

  
271 272
let pp_prog fmt prog = 
......
275 276
  match decl.top_decl_desc with
276 277
  | Node nd -> fprintf fmt "node %s@ " nd.node_id
277 278
  | ImportedNode ind -> fprintf fmt "imported node %s" ind.nodei_id
278
  | Consts clist -> (
279
    fprintf fmt "const %a@ " 
280
      (fprintf_list ~sep:"@ " (fun fmt cdecl ->
281
	pp_print_string fmt cdecl.const_id)) clist)
282
  | Open s -> fprintf fmt "open \"%s\"" s
279
  | Consts clist -> (fprintf fmt "const %a@ " pp_const_list clist)
280
    | Open (local, s) -> if local then fprintf fmt "open \"%s\"" s else fprintf fmt "open <%s>" s
283 281

  
284 282
let pp_lusi fmt decl = 
285 283
  match decl.top_decl_desc with
......
290 288
      nd.node_id
291 289
      pp_node_args nd.node_inputs
292 290
      pp_node_args nd.node_outputs
293
  | ImportedNode _ | Consts _ | Open _ -> ()
291
| Consts clist -> (fprintf fmt "const %a@ " pp_const_list clist)
292
| ImportedNode _ | Open _ -> ()
294 293

  
295 294

  
296 295

  
src/typing.ml
423 423
  let tins, touts = split_arrow tfun in
424 424
  let tins = type_list_of_type tins in
425 425
  let args = expr_list_of_expr args in
426
  List.iter2 (type_subtyping_arg env in_main const) args tins;
426
  if List.length args <> List.length tins then
427
    raise (Error (loc, WrongArity (List.length args, List.length tins)))
428
  else
429
    List.iter2 (type_subtyping_arg env in_main const) args tins;
427 430
  touts
428 431

  
429 432
(** [type_expr env in_main expr] types expression [expr] in environment

Also available in: Unified diff